diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 0de350a4df..06bb73c9fa 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Maxim Cournoyer ;;; Copyright © 2021 Andrew Tropin +;;; Copyright © 2022 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -162,9 +163,21 @@ does not have a default value" field kind))) (define-syntax-rule (define-maybe/no-serialization stem) (define-maybe stem (no-serialization))) +(define (analyse-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))))) + (define (define-configuration-helper serialize? serializer-prefix syn) (syntax-case syn () - ((_ stem (field (field-type def ...) doc custom-serializer ...) ...) + ((_ stem (field field-type+def doc custom-serializer ...) ...) + ;; TODO: fix indentation, maybe with-syntax*? + (with-syntax ((((field-type def ...) ...) + (map analyse-field-type+def #'(field-type+def ...)))) (with-syntax (((field-getter ...) (map (lambda (field) (id #'stem #'stem #'- field)) @@ -233,7 +246,7 @@ does not have a default value" field kind))) (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) (validate-configuration conf #,(id #'stem #'stem #'-fields)) - conf))))))) + conf)))))))) (define no-serialization ;syntactic keyword for 'define-configuration' '(no serialization)) @@ -241,26 +254,26 @@ does not have a default value" field kind))) (define-syntax define-configuration (lambda (s) (syntax-case s (no-serialization prefix) - ((_ stem (field (field-type def ...) doc custom-serializer ...) ... + ((_ stem (field field-type+def doc custom-serializer ...) ... (no-serialization)) (define-configuration-helper - #f #f #'(_ stem (field (field-type def ...) doc custom-serializer ...) + #f #f #'(_ stem (field field-type+def doc custom-serializer ...) ...))) - ((_ 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 ...) + #t #'serializer-prefix #'(_ stem (field field-type+def doc custom-serializer ...) ...))) - ((_ 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 ...) + #t #f #'(_ stem (field field-type+def doc custom-serializer ...) ...)))))) (define-syntax-rule (define-configuration/no-serialization - stem (field (field-type def ...) + stem (field field-type+def doc custom-serializer ...) ...) - (define-configuration stem (field (field-type def ...) + (define-configuration stem (field field-type+def doc custom-serializer ...) ... (no-serialization)))