Hi,

On Sat, 17 Apr 2021 18:45:14 +0100
Christopher Baines <[email protected]> wrote:
 
> Some more things to think about:
> 
>  - Variable naming, what does the "matched" in matched outputs mean?
>    (same goes for the other "matched" things)

The name matched would refer to the match function, but I changed to
*-values. The names I wanted were "outputs", "inputs"
and "sources", but I already used them. If you have anything in mind,
please let me know.

>  - (if (null? ...), I'm unsure if all of those checks are necessary, I
>    believe some fields at least will never be "null?".

I revised it, I think now it's better.
About the "recursive" field, apparently it assumes a string value "t"
or "f", and I convert this to a boolean. Are there other values
possible?

>  - Builder and arguments grouping, I think this makes sense on the
> HTML page, as they're connected, but does it make sense in the JSON?

indeed, I separated them.

> I think you're getting close to something that's ready to merge
> though.


One last thing, I see that on the html the commom inputs are ommited.
Does this make sense for the json too?

-- 
Best Regards,

Luciana Lima Brito
MSc. in Computer Science
>From 614ea09fc6a2d96a9dc2955ae08736740d08f8f8 Mon Sep 17 00:00:00 2001
From: Luciana Brito <[email protected]>
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 | 89 +++++++++++++++++++-
 1 file changed, 86 insertions(+), 3 deletions(-)

diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index a6aa198..09caa82 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,9 +588,92 @@
                  '(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))
+                    (output-values
+                     (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)
+                      (list (assq-ref outputs 'base)
+                            (assq-ref outputs 'target)
+                            (assq-ref outputs 'common))))
+
+                    (inputs  (assq-ref data 'inputs))
+                    (input-values
+                     (map
+                      (lambda (label items)
+                        (cons label
+                              (list->vector
+                               (map 
+                                (match-lambda
+                                  ((derivation output)
+                                   `((derivation . ,derivation)
+                                     (output . ,output)
+                                     )))
+                                (or items '())))))
+                      '(base target common)
+                      (list (assq-ref inputs 'base)
+                            (assq-ref inputs 'target))))
+                    
+                    (sources (assq-ref data 'sources))
+                    (source-values
+                     (map
+                      (lambda (label items)
+                        (cons label
+                              (list->vector
+                               (map
+                                (match-lambda
+                                  ((derivation)
+                                   `((derivation . ,derivation)
+                                     )))
+                                (or items '())))))
+                      '(base target common)
+                      (list (assq-ref sources 'base)
+                            (assq-ref sources 'target)
+                            (assq-ref sources '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
+                   . ,output-values)
+                  (inputs
+                   . ,input-values)
+                  (sources                   
+                   . ,source-values)
+                  (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