From Rosetta Code

This code is a small library for dealing with options file, used in Update a configuration file and Read a configuration file. It is assumed to be in a file called "options.rkt".

<lang Racket>

  1. lang racket

(provide read-options write-options define-options ENABLE)

holds the verbatim line, includes empty lines

(struct comment (contents))

can gold a string or #t for no specified value

(struct option (name [value #:mutable] [disabled? #:mutable]))

a convenient global parameter to hold the current options

(define current-options (make-parameter '()))

reads and normalizes an options file

(define (read-options file)

 (define (parse raw-line)
   (define line (string-trim raw-line))
   (match line
     [(regexp #px"^(?:(?:#.*)?)$") (comment line)] ; includes empty lines
     [(regexp #px"^(;+)?\\s*([^;\\s]+)(?:(?:\\s*=\\s*|\\s+)(\\S.*))?$"
              (list _ dis name val))
      (option (string-upcase name)
              (or (not val)
                  (let* ([val (string-split val #px"\\s*,\\s*")]
                         [val (if (null? (cdr val)) (car val) val)])
                    (or (equal? "" val) val))) ; "" same as unspecified
              (and dis #t))]
     [(regexp #px"^;") #f] ; discard these lines
     [_ (error 'read-options "invalid line in options file: ~s" line)]))
 (define (same-option? x y)
   (and (option? x) (option? y) (equal? (option-name x) (option-name y))))
 (current-options (remove-duplicates (filter-map parse (file->lines file))

(define (write-options file)

 (with-output-to-file file #:exists 'truncate
   (λ() (for ([o (current-options)])
          (if (comment? o)
            (displayln (comment-contents o))
            (let ([v (option-value o)])
              (when (option-disabled? o) (display "; "))
              (display (option-name o))
              (when (string? v) (printf " ~a" v))
a special constant that is used with `opt-set!' to just enable an option

(define ENABLE (gensym))

convert any value into #t (no specific value), #f (missing/disabled),
a string, or a list of these; #t is also for an empty list

(define (->val val)

 (define (-> x) (if (boolean? x) x (~a x)))
 (cond [(list? val) (and (pair? val) (map -> val))]
       [(eq? ENABLE val) #t]
       [else (-> val)]))
returns a value, #t for no-value-specified and #f for disabled or missing

(define (opt-ref name)

 (define NAME (string-upcase (~a name)))
 (define opt (for/or ([o (current-options)])
               (and (option? o) (equal? NAME (option-name o)) o)))
 (and opt (not (option-disabled? opt)) (option-value opt)))
use #f to disable, #t for a no-value, or a plain string; use a
special ENABLE constant to enable a previously disabled value

(define (opt-set! name val)

 (define NAME (string-upcase (~a name)))
 (define opt (for/or ([o (current-options)])
               (and (option? o) (equal? NAME (option-name o)) o)))
 (define (add-option o)
   ;; a separator line, and then the new option
   (current-options `(,@(current-options) ,(comment "") ,o)))
 (cond [(not (or opt val)) (void)] ; disable nonexistent => do nothing
       [(not opt) (add-option (option NAME (->val val) (not val)))]
       [(not val) (set-option-disabled?! opt #t)] ; preserves old value if any
       [else (set-option-disabled?! opt #f)
             (unless (eq? val ENABLE) (set-option-value! opt (->val val)))]))
make it possible to treat options as plain variables

(define-syntax-rule (define-options name ...)

 (begin (define-syntax name
          (syntax-id-rules (set!)
            [(set! _ val) (opt-set! 'name val)]
            [(_ . xs)     ((opt-ref 'name) . xs)]
            [_            (opt-ref 'name)]))