diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-11-19 17:23:04 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-12-08 13:21:23 +0100 |
| commit | 754a7660a1716998b557aedeb805ee9040afdcdf (patch) | |
| tree | 290d583946af03f1e712bb7b3f5aae0633c38db0 /gnu/services | |
| parent | a420b4f34e7449319f6ec73301ffb932845b66d6 (diff) | |
records: 'match-record' checks fields at macro-expansion time.
This allows 'match-record' to be more efficient (field offsets are
computed at compilation time) and to report unknown fields at
macro-expansion time.
* guix/records.scm (map-fields): New macro.
(define-record-type*)[rtd-identifier]: New procedure.
Define TYPE as a macro and use a separate identifier for the RTD.
(lookup-field, match-record-inner): New macros.
(match-record): Rewrite in terms of 'match-error-inner'.
* tests/records.scm ("match-record, simple")
("match-record, unknown field"): New tests.
* gnu/services/cuirass.scm (cuirass-shepherd-service): Rename 'log-file'
local variable to 'main-log-file'.
* gnu/services/getmail.scm (serialize-getmail-configuration-file): Move
after <getmail-configuration-file> definition.
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/cuirass.scm | 4 | ||||
| -rw-r--r-- | gnu/services/getmail.scm | 22 |
2 files changed, 13 insertions, 13 deletions
diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 52de5ca7c0b..d7c6ab9877a 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm | |||
| @@ -125,7 +125,7 @@ | |||
| 125 | (let ((cuirass (cuirass-configuration-cuirass config)) | 125 | (let ((cuirass (cuirass-configuration-cuirass config)) |
| 126 | (cache-directory (cuirass-configuration-cache-directory config)) | 126 | (cache-directory (cuirass-configuration-cache-directory config)) |
| 127 | (web-log-file (cuirass-configuration-web-log-file config)) | 127 | (web-log-file (cuirass-configuration-web-log-file config)) |
| 128 | (log-file (cuirass-configuration-log-file config)) | 128 | (main-log-file (cuirass-configuration-log-file config)) |
| 129 | (user (cuirass-configuration-user config)) | 129 | (user (cuirass-configuration-user config)) |
| 130 | (group (cuirass-configuration-group config)) | 130 | (group (cuirass-configuration-group config)) |
| 131 | (interval (cuirass-configuration-interval config)) | 131 | (interval (cuirass-configuration-interval config)) |
| @@ -169,7 +169,7 @@ | |||
| 169 | 169 | ||
| 170 | #:user #$user | 170 | #:user #$user |
| 171 | #:group #$group | 171 | #:group #$group |
| 172 | #:log-file #$log-file)) | 172 | #:log-file #$main-log-file)) |
| 173 | (stop #~(make-kill-destructor))) | 173 | (stop #~(make-kill-destructor))) |
| 174 | ,(shepherd-service | 174 | ,(shepherd-service |
| 175 | (documentation "Run Cuirass web interface.") | 175 | (documentation "Run Cuirass web interface.") |
diff --git a/gnu/services/getmail.scm b/gnu/services/getmail.scm index fb82d054ca7..19faea782f4 100644 --- a/gnu/services/getmail.scm +++ b/gnu/services/getmail.scm | |||
| @@ -215,17 +215,6 @@ lines.") | |||
| 215 | (parameter-alist '()) | 215 | (parameter-alist '()) |
| 216 | "Extra options to include.")) | 216 | "Extra options to include.")) |
| 217 | 217 | ||
| 218 | (define (serialize-getmail-configuration-file field-name val) | ||
| 219 | (match-record val <getmail-configuration-file> | ||
| 220 | (retriever destination options) | ||
| 221 | #~(string-append | ||
| 222 | "[retriever]\n" | ||
| 223 | #$(serialize-getmail-retriever-configuration #f retriever) | ||
| 224 | "\n[destination]\n" | ||
| 225 | #$(serialize-getmail-destination-configuration #f destination) | ||
| 226 | "\n[options]\n" | ||
| 227 | #$(serialize-getmail-options-configuration #f options)))) | ||
| 228 | |||
| 229 | (define-configuration getmail-configuration-file | 218 | (define-configuration getmail-configuration-file |
| 230 | (retriever | 219 | (retriever |
| 231 | (getmail-retriever-configuration (getmail-retriever-configuration)) | 220 | (getmail-retriever-configuration (getmail-retriever-configuration)) |
| @@ -237,6 +226,17 @@ lines.") | |||
| 237 | (getmail-options-configuration (getmail-options-configuration)) | 226 | (getmail-options-configuration (getmail-options-configuration)) |
| 238 | "Configure getmail.")) | 227 | "Configure getmail.")) |
| 239 | 228 | ||
| 229 | (define (serialize-getmail-configuration-file field-name val) | ||
| 230 | (match-record val <getmail-configuration-file> | ||
| 231 | (retriever destination options) | ||
| 232 | #~(string-append | ||
| 233 | "[retriever]\n" | ||
| 234 | #$(serialize-getmail-retriever-configuration #f retriever) | ||
| 235 | "\n[destination]\n" | ||
| 236 | #$(serialize-getmail-destination-configuration #f destination) | ||
| 237 | "\n[options]\n" | ||
| 238 | #$(serialize-getmail-options-configuration #f options)))) | ||
| 239 | |||
| 240 | (define (serialize-symbol field-name val) "") | 240 | (define (serialize-symbol field-name val) "") |
| 241 | (define (serialize-getmail-configuration field-name val) "") | 241 | (define (serialize-getmail-configuration field-name val) "") |
| 242 | 242 | ||
