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
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)
