Implement the JSON representation for system tests
This commit is contained in:
parent
5b13ee2251
commit
84907fe040
2 changed files with 26 additions and 1 deletions
|
|
@ -423,7 +423,22 @@
|
||||||
mime-types)
|
mime-types)
|
||||||
((application/json)
|
((application/json)
|
||||||
(render-json
|
(render-json
|
||||||
'())) ; TODO
|
`((commit . ,commit-hash)
|
||||||
|
(system . ,(assq-ref query-parameters 'system))
|
||||||
|
(system_tests
|
||||||
|
. ,(list->vector
|
||||||
|
(map
|
||||||
|
(match-lambda
|
||||||
|
((name description file line column-number
|
||||||
|
derivation-file-name builds)
|
||||||
|
`((name . ,name)
|
||||||
|
(description . ,description)
|
||||||
|
(location . ((file . ,file)
|
||||||
|
(line . ,line)
|
||||||
|
(column-number . ,column-number)))
|
||||||
|
(derivation . ,derivation-file-name)
|
||||||
|
(builds . ,(list->vector builds)))))
|
||||||
|
system-tests))))))
|
||||||
(else
|
(else
|
||||||
(render-html
|
(render-html
|
||||||
#:sxml (view-revision-system-tests
|
#:sxml (view-revision-system-tests
|
||||||
|
|
|
||||||
|
|
@ -868,6 +868,16 @@
|
||||||
(button (@ (type "submit")
|
(button (@ (type "submit")
|
||||||
(class "btn btn-lg btn-primary"))
|
(class "btn btn-lg btn-primary"))
|
||||||
"Update results")))))
|
"Update results")))))
|
||||||
|
(a (@ (class "btn btn-lg btn-default 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)))))
|
||||||
|
(role "button"))
|
||||||
|
"View JSON")
|
||||||
(table
|
(table
|
||||||
(@ (class "table"))
|
(@ (class "table"))
|
||||||
(thead
|
(thead
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue