diff options
| author | Luciana Brito <lubrito@posteo.net> | 2021-04-11 11:06:06 -0300 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-04-19 20:53:46 +0100 |
| commit | a498433643a11b20edbf5cb39ca2753663e66e09 (patch) | |
| tree | 0f5ba43e21d85bce0d8cc9ddf9f77bd5b92a733b /guix-data-service | |
| parent | c2c033b43549bfd3ce43fcba5284675cdd767b18 (diff) | |
| download | data-service-a498433643a11b20edbf5cb39ca2753663e66e09.tar data-service-a498433643a11b20edbf5cb39ca2753663e66e09.tar.gz | |
Implement basic JSON output for the derivation comparison page
Signed-off-by: Christopher Baines <mail@cbaines.net>
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/web/compare/controller.scm | 79 |
1 files changed, 76 insertions, 3 deletions
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index a6aa198..895bb40 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -588,9 +588,82 @@ '(application/json text/html) mime-types) ((application/json) - (render-json - '((error . "unimplemented")) ; TODO - #:extra-headers http-headers-for-unchanging-content)) + (let ((outputs + (map + (lambda (label items) + (cons label + (list->vector + (map + (match-lambda + ((name path hash-alg hash recursive) + `((name . ,name) + (path . ,path) + ,@(if (string? hash-alg) + `((hash-algorithm . ,hash-alg)) + '()) + ,@(if (string? hash) + `((hash . ,hash)) + '()) + (recursive . ,(string=? recursive "t"))))) + (or items '()))))) + '(base target common) + (let ((output-groups (assq-ref data 'outputs))) + (list (assq-ref output-groups 'base) + (assq-ref output-groups 'target) + (assq-ref output-groups 'common))))) + + (inputs + (map + (lambda (label items) + (cons label + (list->vector + (map + (match-lambda + ((derivation output) + `((derivation . ,derivation) + (output . ,output)))) + (or items '()))))) + '(base target common) + (let ((input-groups (assq-ref data 'inputs))) + (list (assq-ref input-groups 'base) + (assq-ref input-groups 'target) + (assq-ref input-groups 'common))))) + + (sources + (map + (lambda (label items) + (cons label + (list->vector + (map + (match-lambda + ((derivation) + `((derivation . ,derivation)))) + (or items '()))))) + '(base target common) + (let ((source-groups (assq-ref data 'sources))) + (list (assq-ref source-groups 'base) + (assq-ref source-groups 'target) + (assq-ref source-groups 'common))))) + + (arguments + (map + (match-lambda + ((label args ...) + `(,label . ,(list->vector args)))) + (assq-ref data 'arguments)))) + + (render-json + `((base . ((derivation . ,base-derivation))) + (target . ((derivation . ,target-derivation))) + (outputs . ,outputs) + (inputs . ,inputs) + (sources . ,sources) + (system . ,(assq-ref data 'system)) + (builder . ,(assq-ref data 'builder)) + (arguments . ,arguments) + (environment-variables . ,(assq-ref + data 'environment-variables))) + #:extra-headers http-headers-for-unchanging-content))) (else (render-html #:sxml (compare/derivation |