[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Implement basic JSON output for the derivation co
From: |
Christopher Baines |
Subject: |
branch master updated: Implement basic JSON output for the derivation comparison page |
Date: |
Mon, 19 Apr 2021 15:54:00 -0400 |
This is an automated email from the git hooks/post-receive script.
cbaines pushed a commit to branch master
in repository data-service.
The following commit(s) were added to refs/heads/master by this push:
new a498433 Implement basic JSON output for the derivation comparison page
a498433 is described below
commit a498433643a11b20edbf5cb39ca2753663e66e09
Author: Luciana Brito <lubrito@posteo.net>
AuthorDate: Sun Apr 11 11:06:06 2021 -0300
Implement basic JSON output for the derivation comparison page
Signed-off-by: Christopher Baines <mail@cbaines.net>
---
guix-data-service/web/compare/controller.scm | 79 ++++++++++++++++++++++++++--
1 file changed, 76 insertions(+), 3 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm
b/guix-data-service/web/compare/controller.scm
index a6aa198..895bb40 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,9 +588,82 @@
'(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 (string? hash-alg)
+ `((hash-algorithm . ,hash-alg))
+ '())
+ ,@(if (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)))))
+
+ (arguments
+ (map
+ (match-lambda
+ ((label args ...)
+ `(,label . ,(list->vector args))))
+ (assq-ref data 'arguments))))
+
+ (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 . ,arguments)
+ (environment-variables . ,(assq-ref
+ data 'environment-variables)))
+ #:extra-headers http-headers-for-unchanging-content)))
(else
(render-html
#:sxml (compare/derivation
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: Implement basic JSON output for the derivation comparison page,
Christopher Baines <=