aboutsummaryrefslogtreecommitdiff
path: root/etc
ModeNameSize
d---------completion92logplain
d---------git36logplain
-rw-r--r--guix-daemon.cil.in8789logplainabout
-rw-r--r--guix-daemon.conf.in339logplainabout
-rw-r--r--guix-daemon.service.in683logplainabout
-rwxr-xr-xguix-install.sh12141logplainabout
-rw-r--r--guix-publish.conf.in343logplainabout
-rw-r--r--guix-publish.service.in596logplainabout
-rwxr-xr-xindent-code.el.in3312logplainabout
d---------snippets74logplain
generated by cgit
; Only serialize fields whose value isn't '%unset-marker%. (tfilter-maybe-value config) (tmap (lambda (field) ((configuration-field-serializer field) (configuration-field-name field) ((configuration-field-getter field) config)))))) (define (serialize-configuration config fields) "Return a G-expression that contains the values corresponding to the FIELDS of CONFIG, a record that has been generated by `define-configuration'. The G-expression can then be serialized to disk by using something like `mixed-text-file'." #~(string-append #$@(list-transduce (base-transducer config) rcons fields))) (define-syntax-rule (id ctx parts ...) "Assemble PARTS into a raw (unhygienic) identifier." (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) (define (define-maybe-helper serialize? prefix syn) (syntax-case syn () ((_ stem) (with-syntax ((stem? (id #'stem #'stem #'?)) (maybe-stem? (id #'stem #'maybe- #'stem #'?)) (serialize-stem (if prefix (id #'stem prefix #'serialize- #'stem) (id #'stem #'serialize- #'stem))) (serialize-maybe-stem (if prefix (id #'stem prefix #'serialize-maybe- #'stem) (id #'stem #'serialize-maybe- #'stem)))) #`(begin (define (maybe-stem? val) (or (not (maybe-value-set? val)) (stem? val))) #,@(if serialize? (list #'(define (serialize-maybe-stem field-name val) (if (stem? val) (serialize-stem field-name val) ""))) '())))))) (define-syntax define-maybe (lambda (x) (syntax-case x (no-serialization prefix) ((_ stem (no-serialization)) (define-maybe-helper #f #f #'(_ stem))) ((_ stem (prefix serializer-prefix)) (define-maybe-helper #t #'serializer-prefix #'(_ stem))) ((_ stem) (define-maybe-helper #t #f #'(_ stem)))))) (define-syntax-rule (define-maybe/no-serialization stem) (define-maybe stem (no-serialization))) (define (normalize-field-type+def s) (syntax-case s () ((field-type def) (identifier? #'field-type) (values #'(field-type def))) ((field-type) (identifier? #'field-type) (values #'(field-type %unset-value))) (field-type (identifier? #'field-type) (values #'(field-type %unset-value))))) (define (define-configuration-helper serialize? serializer-prefix syn) (define (normalize-extra-args s) "Extract and normalize arguments following @var{doc}." (let loop ((s s) (sanitizer* #f) (serializer* #f)) (syntax-case s (sanitizer serializer empty-serializer) (((sanitizer proc) tail ...) (if sanitizer* (syntax-violation 'sanitizer "duplicate entry" #'proc) (loop #'(tail ...) #'proc serializer*))) (((serializer proc) tail ...) (if serializer* (syntax-violation 'serializer "duplicate or conflicting entry" #'proc) (loop #'(tail ...) sanitizer* #'proc))) ((empty-serializer tail ...) (if serializer* (syntax-violation 'empty-serializer "duplicate or conflicting entry" #f) (loop #'(tail ...) sanitizer* #'empty-serializer))) (() ; stop condition (values (list sanitizer* serializer*))) ((proc) ; TODO: deprecated, to be removed. (not (or sanitizer* serializer*)) (begin (warning #f (G_ "specifying serializers after documentation is \ deprecated, use (serializer ~a) instead~%") (syntax->datum #'proc)) (values (list #f #'proc))))))) (syntax-case syn () ((_ stem (field field-type+def doc extra-args ...) ...) (with-syntax ((((field-type def) ...) (map normalize-field-type+def #'(field-type+def ...))) (((sanitizer* serializer*) ...) (map normalize-extra-args #'((extra-args ...) ...)))) (with-syntax (((field-getter ...) (map (lambda (field) (id #'stem #'stem #'- field)) #'(field ...))) ((field-predicate ...) (map (lambda (type) (id #'stem type #'?)) #'(field-type ...))) ((field-default ...) (map (match-lambda ((field-type default-value) default-value)) #'((field-type def) ...))) ((field-sanitizer ...) #'(sanitizer* ...)) ((field-serializer ...) (map (lambda (type proc) (and serialize? (or proc (if serializer-prefix (id #'stem serializer-prefix #'serialize- type) (id #'stem #'serialize- type))))) #'(field-type ...) #'(serializer* ...)))) (define (default-field-sanitizer name pred) ;; Define a macro for use as a record field sanitizer, where NAME ;; is the name of the field and PRED is the predicate that tells ;; whether a value is valid for this field. #`(define-syntax #,(id #'stem #'validate- #'stem #'- name) (lambda (s) ;; Make sure the given VALUE, for field NAME, passes PRED. (syntax-case s () ((_ value) (with-syntax ((name #'#,name) (pred #'#,pred) (loc (datum->syntax #'value (syntax-source #'value)))) #'(if (pred value) value (configuration-field-error (and=> 'loc source-properties->location) 'name value)))))))) #`(begin ;; Define field validation macros. #,@(filter-map (lambda (name pred sanitizer) (if sanitizer #f (default-field-sanitizer name pred))) #'(field ...) #'(field-predicate ...) #'(field-sanitizer ...)) (define-record-type* #,(id #'stem #'< #'stem #'>) stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?) #,@(map (lambda (name getter def sanitizer) #`(#,name #,getter (default #,def) (sanitize #,(or sanitizer (id #'stem #'validate- #'stem #'- name))))) #'(field ...) #'(field-getter ...) #'(field-default ...) #'(field-sanitizer ...)) (%location #,(id #'stem #'stem #'-source-location) (default (and=> (current-source-location) source-properties->location)) (innate))) (define #,(id #'stem #'stem #'-fields) (list (configuration-field (name 'field) (type 'field-type) (getter field-getter) (predicate field-predicate) (sanitizer (or field-sanitizer (id #'stem #'validate- #'stem #'- #'field))) (serializer field-serializer) (default-value-thunk (lambda () (if (maybe-value-set? (syntax->datum field-default)) field-default (configuration-missing-default-value '#,(id #'stem #'% #'stem) 'field)))) (documentation doc)) ...)))))))) (define no-serialization ;syntactic keyword for 'define-configuration' '(no serialization)) (define-syntax define-configuration (lambda (s) (syntax-case s (no-serialization prefix) ((_ stem (field field-type+def doc custom-serializer ...) ... (no-serialization)) (define-configuration-helper #f #f #'(_ stem (field field-type+def doc custom-serializer ...) ...))) ((_ stem (field field-type+def doc custom-serializer ...) ... (prefix serializer-prefix)) (define-configuration-helper #t #'serializer-prefix #'(_ stem (field field-type+def doc custom-serializer ...) ...))) ((_ stem (field field-type+def doc custom-serializer ...) ...) (define-configuration-helper #t #f #'(_ stem (field field-type+def doc custom-serializer ...) ...)))))) (define-syntax-rule (define-configuration/no-serialization stem (field field-type+def doc custom-serializer ...) ...) (define-configuration stem (field field-type+def doc custom-serializer ...) ... (no-serialization))) (define (empty-serializer field-name val) "") (define serialize-package empty-serializer) ;; Ideally this should be an implementation detail, but we export it ;; to provide a simpler API that enables unsetting a configuration ;; field that has a maybe type, but also a default value. We give it ;; a value that sticks out to the reader when something goes wrong. ;; ;; An example use-case would be something like a network application ;; that uses a default port, but the field can explicitly be unset to ;; request a random port at startup. (define %unset-value '%unset-marker%) (define (maybe-value-set? value) "Predicate to check whether a 'maybe' value was explicitly provided." (not (eq? %unset-value value))) ;; Ideally there should be a compiler macro for this predicate, that expands ;; to a conditional that only instantiates the default value when needed. (define* (maybe-value value #:optional (default #f)) "Returns VALUE, unless it is the unset value, in which case it returns DEFAULT." (if (maybe-value-set? value) value default)) ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) (define (str x) (object->string x)) (define (package->symbol package) "Return the first symbol name of a package that matches PACKAGE, else #f." (let* ((module (file-name->module-name (location-file (package-location package)))) (symbols (filter-map identity (module-map (lambda (symbol var) (and (equal? package (variable-ref var)) symbol)) (resolve-module module))))) (if (null? symbols) #f (first symbols)))) (define (generate configuration-name) (match (assq-ref documentation configuration-name) ((fields . sub-documentation) `((deftp (% (category "Data Type") (name ,(str configuration-name))) (para "Available " (code ,(str configuration-name)) " fields are:") (table (% (formatter (asis))) ,@(map (lambda (f) (let ((field-name (configuration-field-name f)) (field-type (configuration-field-type f)) (field-docs (cdr (texi-fragment->stexi (configuration-field-documentation f)))) (default (catch #t (configuration-field-default-value-thunk f) (lambda _ '%invalid)))) (define (show-default? val) (or (string? val) (number? val) (boolean? val) (package? val) (and (symbol? val) (not (eq? val '%invalid))) (and (list? val) (and-map show-default? val)))) (define (show-default val) (cond ((package? val) (symbol->string (package->symbol val))) (((list-of package?) val) (format #f "(~{~a~^ ~})" (map package->symbol val))) (else (str val)))) `(entry (% (heading (code ,(str field-name)) ,@(if (show-default? default) `(" (default: " (code ,(show-default default)) ")") '()) " (type: " ,(str field-type) ")")) (para ,@field-docs) ,@(append-map generate (or (assq-ref sub-documentation field-name) '()))))) fields))))))) (stexi->texi `(*fragment* . ,(generate documentation-name)))) (define (configuration->documentation configuration-symbol) "Take CONFIGURATION-SYMBOL, the symbol corresponding to the name used when defining a configuration record with DEFINE-CONFIGURATION, and output the Texinfo documentation of its fields." ;; This is helper for a simple, straight-forward application of ;; GENERATE-DOCUMENTATION. (let ((fields-getter (module-ref (current-module) (symbol-append configuration-symbol '-fields)))) (display (generate-documentation `((,configuration-symbol ,fields-getter)) configuration-symbol)))) (define* (filter-configuration-fields configuration-fields fields #:optional negate?) "Retrieve the fields listed in FIELDS from CONFIGURATION-FIELDS. If NEGATE? is @code{#t}, retrieve all fields except FIELDS." (filter (lambda (field) (let ((member? (member (configuration-field-name field) fields))) (if (not negate?) member? (not member?)))) configuration-fields)) (define* (interpose ls #:optional (delimiter "\n") (grammar 'infix)) "Same as @code{string-join}, but without join and string, returns a DELIMITER interposed LS. Support 'infix and 'suffix GRAMMAR values." (when (not (member grammar '(infix suffix))) (raise (formatted-message (G_ "The GRAMMAR value must be 'infix or 'suffix, but ~a provided.") grammar))) (fold-right (lambda (e acc) (cons e (if (and (null? acc) (eq? grammar 'infix)) acc (cons delimiter acc)))) '() ls)) ;;; ;;; Commonly used predicates ;;; (define (list-of pred?) "Return a procedure that takes a list and check if all the elements of the list result in @code{#t} when applying PRED? on them." (lambda (x) (if (list? x) (every pred? x) #f))) (define list-of-packages? (list-of package?)) (define list-of-strings? (list-of string?)) (define list-of-symbols? (list-of symbol?)) ;;; ;;; Special serializers ;;; (define alist? (list-of pair?)) (define serialize-file-like empty-serializer) (define (text-config? config) (list-of file-like?)) (define (serialize-text-config field-name val) #~(string-append #$@(interpose (map (lambda (e) #~(begin (use-modules (ice-9 rdelim)) (with-fluids ((%default-port-encoding "UTF-8")) (with-input-from-file #$e read-string)))) val) "\n" 'suffix))) (define ((generic-serialize-alist-entry serialize-field) entry) "Apply the SERIALIZE-FIELD procedure on the field and value of ENTRY." (match entry ((field . val) (serialize-field field val)))) (define (generic-serialize-alist combine serialize-field fields) "Generate a configuration from an association list FIELDS. SERIALIZE-FIELD is a procedure that takes two arguments, it will be applied on the fields and values of FIELDS using the @code{generic-serialize-alist-entry} procedure. COMBINE is a procedure that takes one or more arguments and combines all the alist entries into one value, @code{string-append} or @code{append} are usually good candidates for this." (apply combine (map (generic-serialize-alist-entry serialize-field) fields)))
generated by cgit