Racket/Options

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
 
(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))
same-option?)))
 
(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))
(newline)))))))
 
;; 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)]))
...))