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)
|
||||
((application/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
|
||||
(render-html
|
||||
#:sxml (view-revision-system-tests
|
||||
|
|
|
|||
|
|
@ -868,6 +868,16 @@
|
|||
(button (@ (type "submit")
|
||||
(class "btn btn-lg btn-primary"))
|
||||
"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
|
||||
(@ (class "table"))
|
||||
(thead
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue