guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

Implement basic JSON output for the derivation comparison page

Browse source 
Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Luciana Brito 2021-04-11 11:06:06 -03:00 committed by Christopher Baines
parent c2c033b435
commit a498433643
1 changed files with 76 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

79
guix-data-service/web/compare/controller.scm
View file

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