Re: Outreachy - Guix Data Service: implementing basic json output for derivation comparison page

[Luciana Lima Brito <lubrito@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 773 bytes --]

On Sat, 17 Apr 2021 09:40:22 +0100
Christopher Baines <mail@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

[-- Attachment #2: 0001-Implement-basic-json-output-for-the-derivation-compa.patch --]
[-- Type: text/x-patch, Size: 6782 bytes --]

From 8d91269ead953c7d087242fbce5857af89af3025 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@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