On Sat, 17 Apr 2021 09:40:22 +0100
Christopher Baines <m...@cbaines.net> wrote:
> I think you're getting there, but it looks like you're close to what
> you want with matched-outputs say, and then later you pick bits out
> of that alist, generate vectors from the lists, and then rebuild the
> alist. I think you can remove all that complexity by just tweaking
> what you're doing up when you generate matched-outputs. I think this
> is true for matched-outputs, matched-inputs and matched-sources.
It's beautiful!
Now I could understand better the alist, and things make much more
sense to me. I simplified this part of getting properly the values from
matched-outputs, matched-inputs and matched-sources.
--
Best Regards,
Luciana Lima Brito
MSc. in Computer Science
>From 8d91269ead953c7d087242fbce5857af89af3025 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubr...@posteo.net>
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
