Hi,

On Sun, 18 Apr 2021 17:34:13 +0100
Christopher Baines <m...@cbaines.net> wrote:
 
> I think it might be good to do something, just to narrow the scope.
> The outputs binding is valid for the whole let*, and all the code in
> it, but is only used on three lines, in one single place. Maybe there
> could be a let there that just defines outputs (maybe named
> output-groups so you can use the outputs binding for the overall
> thing).

I did it.
 
> That's a good question, I'd look at the database schema, assuming the
> type of the field is a boolean, the question is whether the field is
> nullable?

I looked on the database schema, and the "recursive" field is not
nullable, and it is a boolean, so the test I'm doing is working for
this.
 
> Hmm, I'm not sure why that is on the HTML page, but I'd generally try
> and keep most bits in the JSON, since it's not as helpful to omit bits
> if they're not that important.

I added the "common" field for inputs.
> 
> One other thing I noticed is that the alist for the args is being
> picked apart then reconstructed. Like for the inputs, outputs and
> sources, I'd map over the arguments alist and transform it to the way
> you want it to be.

This part was a bit more complicated for me to understand. You mean I
should build a function similar to outputs, inputs and sources to map
the arguments, wouldn't it be a lot just to show a vector?

-- 
Best Regards,

Luciana Lima Brito
MSc. in Computer Science
>From dc74d1a8f8f5e7527cdb63b66e8e2b937e614f32 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 | 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

Reply via email to