From dc74d1a8f8f5e7527cdb63b66e8e2b937e614f32 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 | 83 +++++++++++++++++++- 1 file changed, 80 insertions(+), 3 deletions(-) diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index a6aa198..ab5f9c4 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -588,9 +588,86 @@ '(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 (not (string? hash-alg)) + '() + `((hash-algorithm . ,hash-alg))) + ,@(if (not (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))))) + + (args (assq-ref data 'arguments)) + (base-args (list->vector (assq-ref args 'base))) + (target-args (list->vector (assq-ref args 'target)))) + (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 + . ((base . ,base-args) + (target . ,target-args))) + (environment-variables . ,(assq-ref data 'environment-variables))) + #:extra-headers http-headers-for-unchanging-content))) (else (render-html #:sxml (compare/derivation -- 2.30.2