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

Add a very rough JSON output for the package derivation outputs page

Browse source
This commit is contained in:
Christopher Baines 2020-10-11 16:53:29 +01:00
parent 3225766207
commit efbbac5099
2 changed files with 57 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
guix-data-service/web/revision/controller.scm
View file

@ -1113,7 +1113,50 @@
mime-types)
((application/json)
(render-json
`()))
`((store_paths
. ,(list->vector
(map (match-lambda
((path hash-algorithm hash recursive
nars)
`((path . ,path)
(data
. ,(if (null? hash-algorithm)
(list->vector
(map
(match-lambda
((hash . nars)
`((hash . ,hash)
(nars . ,(list->vector nars)))))
(group-to-alist
(lambda (nar)
(cons (assoc-ref nar "hash")
nar))
(vector->list nars))))
hash))
(output_consistency
. ,(let* ((hashes
(delete-duplicates
(map (lambda (nar)
(assoc-ref nar "hash"))
(vector->list nars))))
(build-servers
(delete-duplicates
(map (lambda (nar)
(assoc-ref nar "build_server_id"))
(vector->list nars))))
(hash-count
(length hashes))
(build-server-count
(length build-servers)))
(cond
((or (eq? hash-count 0)
(eq? build-server-count 1))
"unknown")
((eq? hash-count 1)
"matching")
((> hash-count 1)
"not-matching")))))))
derivation-outputs))))))
(else
(letpar& ((systems
(with-thread-postgresql-connection valid-systems))

13
guix-data-service/web/revision/html.scm
View file

@ -1756,6 +1756,19 @@ figure {
(button (@ (type "submit")
(class "btn btn-lg btn-primary"))
"Update results")))))))
(div
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(a (@ (class "btn btn-default btn-lg pull-right")
(href ,(let ((query-parameter-string
(query-parameters->string query-parameters)))
(string-append
path-base ".json"
(if (string-null? query-parameter-string)
""
(string-append "?" query-parameter-string))))))
"View JSON")))
(div
(@ (class "row"))
(div