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

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

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

Hi,

I implemented a basic json output for the derivation comparison page,
for my first contribution as an Outreachy applicant.

The patch for the code I've changed is attached.
I'm waiting your reviews :)

-- 
Best Regards,

Luciana Lima Brito
MSc. in Computer Science

[-- Attachment #2: controller.patch --]
[-- Type: text/x-patch, Size: 6884 bytes --]

diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index a6aa198..b7788cb 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -584,19 +584,115 @@
                       (derivation-differences-data conn
                                                    base-derivation
                                                    target-derivation)))))
-          (case (most-appropriate-mime-type
-                 '(application/json text/html)
-                 mime-types)
-            ((application/json)
-             (render-json
-              '((error . "unimplemented")) ; TODO
-              #:extra-headers http-headers-for-unchanging-content))
-            (else
-             (render-html
-              #:sxml (compare/derivation
-                      query-parameters
-                      data)
-              #:extra-headers http-headers-for-unchanging-content)))))))
+          (let ((outputs (assq-ref data 'outputs))
+                (inputs  (assq-ref data 'inputs))
+                (sources (assq-ref data 'sources))
+                (system  (assq-ref data 'system))
+                (builder (assq-ref data 'builder))
+                (args    (assq-ref data 'arguments))
+                (environment-variables (assq-ref data 'environment-variables))
+                (get-derivation-data 
+                 (lambda (items)
+                   (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"))))))
+                      ((derivation output)
+                       `(,@(if (null? derivation)
+                               '()
+                               `((derivation . ,derivation)))
+                         ,@(if (null? output)
+                               '()
+                               `((output . ,output)))))
+                      ((derivation)
+                       `(,@(if (null? derivation)
+                               '()
+                               `((derivation . ,derivation))))))
+                    (or items '())))))
+            
+            (let ((base-system (assq-ref system 'base))
+                  (target-system (assq-ref system 'target))
+                  (common-system (assq-ref system 'common))
+
+                  (base-builder (assq-ref builder 'base))
+                  (target-builder (assq-ref builder 'target))
+                  (common-builder (assq-ref builder 'common))
+
+                  (base-args (assq-ref args 'base))
+                  (target-args (assq-ref args 'target))
+                  (common-args (assq-ref args 'common)))
+
+              (let ((matched-outputs (append-map get-derivation-data
+                                                 (list (assq-ref outputs 'base)
+                                                       (assq-ref outputs 'target)
+                                                       (assq-ref outputs 'common))))
+                    (matched-inputs (append-map get-derivation-data
+                                                (list (assq-ref inputs 'base)
+                                                      (assq-ref inputs 'target))))
+                    (matched-sources (append-map get-derivation-data
+                                                 (list (assq-ref sources 'base)
+                                                       (assq-ref sources 'target)
+                                                       (assq-ref sources 'common)))))
+                (case (most-appropriate-mime-type
+                       '(application/json text/html)
+                       mime-types)
+                  ((application/json)
+                   (render-json
+                    `((revision
+                       . ((base
+                           . ((derivation . ,base-derivation)))
+                          (target
+                           . ((derivation . ,target-derivation)))))
+                      (outputs
+                       . ,((lambda (l) (cond
+                                        ((= (length l) 3) `((base . ,(first l))
+                                                            (target . ,(second l))
+                                                            (common . ,(third l))))
+                                        ((= (length l) 2) `((base . ,(first l))
+                                                            (target . ,(second l))))
+                                        (else `((common . ,(first l))))))
+                           matched-outputs))
+                      (inputs
+                       . ((base . ,(first matched-inputs))
+                          (target . ,(second matched-inputs))))
+                      (source
+                       . ((base . ,(first matched-sources))
+                          (target . ,(second matched-sources))
+                          (common . ,(third matched-sources))))                      
+                      (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
+                            query-parameters
+                            data)
+                    #:extra-headers http-headers-for-unchanging-content))))))))))
 
 (define (render-compare/package-derivations mime-types
                                             query-parameters)