From 8d91269ead953c7d087242fbce5857af89af3025 Mon Sep 17 00:00:00 2001 From: Luciana Brito Date: Sun, 11 Apr 2021 11:06:06 -0300 Subject: [PATCH] Implement basic json output for the derivation comparison page --- guix-data-service/web/compare/controller.scm | 114 ++++++++++++++++++- 1 file changed, 111 insertions(+), 3 deletions(-) diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index a6aa198..d05c177 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -588,9 +588,117 @@ '(application/json text/html) mime-types) ((application/json) - (render-json - '((error . "unimplemented")) ; TODO - #:extra-headers http-headers-for-unchanging-content)) + (let* ((outputs (assq-ref data 'outputs)) + (matched-outputs + (map + (lambda (label items) + (cons label + (map + (match-lambda + ((name path hash-alg hash recursive) + `(,@(if (null? name) + '() + `((name . ,name))) + ,@(if (null? path) + '() + `((path . ,path)) + ) + ,@(if (or (null? hash-alg) (not (string? hash-alg))) + '() + `((hash-algorithm . ,hash-alg)) + ) + ,@(if (or (null? hash) (not (string? hash))) + '() + `((hash . ,hash)) + ) + ,@(if (null? recursive) + '() + `((recursive . ,(string=? recursive "t"))))))) + (or items '())))) + '(base target common) + (list (assq-ref outputs 'base) + (assq-ref outputs 'target) + (assq-ref outputs 'common)))) + + (inputs (assq-ref data 'inputs)) + (matched-inputs + (map + (lambda (label items) + (cons label + (map + (match-lambda + ((derivation output) + `(,@(if (null? derivation) + '() + `((derivation . ,derivation))) + ,@(if (null? output) + '() + `((output . ,output)))))) + (or items '())))) + '(base target common) + (list (assq-ref inputs 'base) + (assq-ref inputs 'target)))) + + (sources (assq-ref data 'sources)) + (matched-sources + (map + (lambda (label items) + (cons label + (map + (match-lambda + ((derivation) + `(,@(if (null? derivation) + '() + `((derivation . ,derivation)))))) + (or items '())))) + '(base target common) + (list (assq-ref sources 'base) + (assq-ref sources 'target) + (assq-ref sources 'common)))) + + (system (assq-ref data 'system)) + (base-system (assq-ref system 'base)) + (target-system (assq-ref system 'target)) + (common-system (assq-ref system 'common)) + + (builder (assq-ref data 'builder)) + (base-builder (assq-ref builder 'base)) + (target-builder (assq-ref builder 'target)) + (common-builder (assq-ref builder 'common)) + + (args (assq-ref data 'arguments)) + (base-args (assq-ref args 'base)) + (target-args (assq-ref args 'target)) + (common-args (assq-ref args 'common)) + (environment-variables (assq-ref data 'environment-variables))) + + (render-json + `((base + . ((derivation . ,base-derivation))) + (target + . ((derivation . ,target-derivation))) + (outputs + . ((base . ,(list->vector (assq-ref matched-outputs 'base))) + (target . ,(list->vector (assq-ref matched-outputs 'target))) + (common . ,(list->vector (assq-ref matched-outputs 'common))))) + (inputs + . ((base . ,(list->vector (assq-ref matched-inputs 'base))) + (target . ,(list->vector (assq-ref matched-inputs 'target))))) + (sources + . ((base . ,(list->vector (assq-ref matched-sources 'base))) + (target . ,(list->vector (assq-ref matched-sources 'target))) + (common . ,(list->vector (assq-ref matched-sources 'common))))) + (system + . ((common . ,common-system))) + (builder-and-arguments + . ((builder . ,common-builder) + (arguments + . ((base . ,(list->vector + base-args)) + (target . ,(list->vector + target-args)))))) + (environment-variables . ,environment-variables)) + #:extra-headers http-headers-for-unchanging-content))) (else (render-html #:sxml (compare/derivation -- 2.30.2