diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-05-12 21:16:24 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-05-12 21:16:24 +0100 |
| commit | b151d8bb783919729bb04f4d50f0d10859177538 (patch) | |
| tree | 1b7df2bd2678af238b1333d32939f12a367891df /guix-data-service/web/query-parameters.scm | |
| parent | 4a5f42ee5250fdf338c4ac444204e81e58f1f4b9 (diff) | |
| download | data-service-b151d8bb783919729bb04f4d50f0d10859177538.tar data-service-b151d8bb783919729bb04f4d50f0d10859177538.tar.gz | |
Add a function for making query parameters mutually exclusive
This allows building more complicated forms, where some of the query
parameters don't work together.
Diffstat (limited to 'guix-data-service/web/query-parameters.scm')
| -rw-r--r-- | guix-data-service/web/query-parameters.scm | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/guix-data-service/web/query-parameters.scm b/guix-data-service/web/query-parameters.scm index 3140238..66edb64 100644 --- a/guix-data-service/web/query-parameters.scm +++ b/guix-data-service/web/query-parameters.scm @@ -36,6 +36,7 @@ any-invalid-query-parameters? parse-query-parameters + guard-against-mutually-exclusive-query-parameters query-parameters->string parse-datetime @@ -56,6 +57,37 @@ (value invalid-query-parameter-value) (message invalid-query-parameter-message)) +(define (guard-against-mutually-exclusive-query-parameters + parsed-query-parameters + mutually-exclusive-groups) + (map (match-lambda + ((name . value) + (if (invalid-query-parameter? value) + (cons name value) + (or + (any (lambda (group) + (if (memq name group) + (let ((other-names + (filter (lambda (other-name) + (and (not (eq? name other-name)) + (memq other-name group))) + (map car parsed-query-parameters)))) + (if (not (null? other-names)) + (cons + name + (make-invalid-query-parameter + value + (string-append + "cannot be specified along with " + (string-join (map symbol->string + other-names) + ", ")))) + #f)) + #f)) + mutually-exclusive-groups) + (cons name value))))) + parsed-query-parameters)) + (define (parse-query-parameters request accepted-query-parameters) (define request-query-parameters |