Add a page to show a formatted derivation representation
The HTML is very rough, and the way it's displayed is also rough, but it does provide a way to understand the derivation. I'm also unsure it's a perfect representation, but it's a start at least.
This commit is contained in:
parent
41afcef9a6
commit
a658d64b46
2 changed files with 240 additions and 0 deletions
|
|
@ -118,6 +118,32 @@
|
||||||
"No derivation found with this file name.")
|
"No derivation found with this file name.")
|
||||||
#:code 404))))
|
#:code 404))))
|
||||||
|
|
||||||
|
(define (render-formatted-derivation conn derivation-file-name)
|
||||||
|
(let ((derivation (select-derivation-by-file-name conn
|
||||||
|
derivation-file-name)))
|
||||||
|
(if derivation
|
||||||
|
(let ((derivation-inputs (select-derivation-inputs-by-derivation-id
|
||||||
|
conn
|
||||||
|
(first derivation)))
|
||||||
|
(derivation-outputs (select-derivation-outputs-by-derivation-id
|
||||||
|
conn
|
||||||
|
(first derivation)))
|
||||||
|
(derivation-sources (select-derivation-sources-by-derivation-id
|
||||||
|
conn
|
||||||
|
(first derivation))))
|
||||||
|
(render-html
|
||||||
|
#:sxml (view-formatted-derivation derivation
|
||||||
|
derivation-inputs
|
||||||
|
derivation-outputs
|
||||||
|
derivation-sources)
|
||||||
|
#:extra-headers http-headers-for-unchanging-content))
|
||||||
|
|
||||||
|
(render-html
|
||||||
|
#:sxml (general-not-found
|
||||||
|
"Derivation not found"
|
||||||
|
"No derivation found with this file name.")
|
||||||
|
#:code 404))))
|
||||||
|
|
||||||
(define (render-store-item conn filename)
|
(define (render-store-item conn filename)
|
||||||
(let ((derivation (select-derivation-by-output-filename conn filename)))
|
(let ((derivation (select-derivation-by-output-filename conn filename)))
|
||||||
(match derivation
|
(match derivation
|
||||||
|
|
@ -239,6 +265,11 @@
|
||||||
(if (string-suffix? ".drv" path)
|
(if (string-suffix? ".drv" path)
|
||||||
(render-derivation conn path)
|
(render-derivation conn path)
|
||||||
(render-store-item conn path))))
|
(render-store-item conn path))))
|
||||||
|
(('GET "gnu" "store" filename "formatted")
|
||||||
|
(if (string-suffix? ".drv" filename)
|
||||||
|
(render-formatted-derivation conn
|
||||||
|
(string-append "/gnu/store/" filename))
|
||||||
|
(not-found (request-uri request))))
|
||||||
(('GET "compare" _ ...) (delegate-to compare-controller))
|
(('GET "compare" _ ...) (delegate-to compare-controller))
|
||||||
(('GET "compare-by-datetime" _ ...) (delegate-to compare-controller))
|
(('GET "compare-by-datetime" _ ...) (delegate-to compare-controller))
|
||||||
(('GET "jobs") (delegate-to jobs-controller))
|
(('GET "jobs") (delegate-to jobs-controller))
|
||||||
|
|
|
||||||
|
|
@ -43,6 +43,7 @@
|
||||||
view-statistics
|
view-statistics
|
||||||
view-builds
|
view-builds
|
||||||
view-derivation
|
view-derivation
|
||||||
|
view-formatted-derivation
|
||||||
view-store-item
|
view-store-item
|
||||||
error-page))
|
error-page))
|
||||||
|
|
||||||
|
|
@ -451,6 +452,15 @@
|
||||||
,(string-append
|
,(string-append
|
||||||
"/" (string-join fileparts "/"))))))
|
"/" (string-join fileparts "/"))))))
|
||||||
|
|
||||||
|
(define (display-file-in-store-item-oneline filename)
|
||||||
|
(match (string-split filename #\/)
|
||||||
|
(("" "gnu" "store" item fileparts ...)
|
||||||
|
`(,(let ((full-item (string-append "/gnu/store/" item)))
|
||||||
|
`(a (@ (href ,full-item))
|
||||||
|
,(display-store-item full-item)))
|
||||||
|
,(string-append
|
||||||
|
"/" (string-join fileparts "/"))))))
|
||||||
|
|
||||||
(define (view-store-item filename derivations derivations-using-store-item-list)
|
(define (view-store-item filename derivations derivations-using-store-item-list)
|
||||||
(layout
|
(layout
|
||||||
#:body
|
#:body
|
||||||
|
|
@ -576,6 +586,205 @@
|
||||||
,(display-store-item-short path))))))
|
,(display-store-item-short path))))))
|
||||||
derivation-outputs)))))))))
|
derivation-outputs)))))))))
|
||||||
|
|
||||||
|
(define (view-formatted-derivation derivation derivation-inputs derivation-outputs
|
||||||
|
derivation-sources)
|
||||||
|
(layout
|
||||||
|
#:body
|
||||||
|
`(,(header)
|
||||||
|
(div
|
||||||
|
(@ (class "container"))
|
||||||
|
,(match derivation
|
||||||
|
((id file-name builder args env-vars system)
|
||||||
|
`(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-sm-12"))
|
||||||
|
,(display-store-item-title file-name)))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace; font-size: 1.5em;"))
|
||||||
|
"Derive("))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"[")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Outputs")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
,@(map (match-lambda*
|
||||||
|
(((output-name path hash-algorithm hash recursive?) count-down)
|
||||||
|
`(div
|
||||||
|
(@ (style "margin-left: 3em;"))
|
||||||
|
,(simple-format #f "(\"~A\",\"" output-name)
|
||||||
|
(a (@ (href ,path))
|
||||||
|
,(display-store-item path))
|
||||||
|
"\")"
|
||||||
|
,@(if (eq? count-down 0)
|
||||||
|
'()
|
||||||
|
'(",")))))
|
||||||
|
derivation-outputs
|
||||||
|
(reverse (iota (length derivation-outputs))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"],[")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Inputs")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
,@(map (match-lambda*
|
||||||
|
(((file-name output-name path) count-down)
|
||||||
|
`(div
|
||||||
|
(@ (style "margin-left: 3em;"))
|
||||||
|
"(\""
|
||||||
|
(a (@ (href ,file-name))
|
||||||
|
,(display-store-item file-name))
|
||||||
|
"\",\""
|
||||||
|
"[\"" ,output-name "\"]"
|
||||||
|
")"
|
||||||
|
,@(if (eq? count-down 0)
|
||||||
|
'()
|
||||||
|
'(",")))))
|
||||||
|
derivation-inputs
|
||||||
|
(reverse (iota (length derivation-inputs))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"],[")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Sources")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
,@(map (lambda (source count-down)
|
||||||
|
`(div (@ (style "margin-left: 3em;"))
|
||||||
|
"\""
|
||||||
|
(a (@ (href ,source))
|
||||||
|
,(display-store-item source))
|
||||||
|
"\""
|
||||||
|
,@(if (eq? count-down 0)
|
||||||
|
'()
|
||||||
|
'(","))))
|
||||||
|
derivation-sources
|
||||||
|
(reverse (iota (length derivation-sources))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"],")))
|
||||||
|
,@(match derivation
|
||||||
|
((id file-name builder args env-vars system)
|
||||||
|
`((div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"System")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"\"" ,system "\",")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Builder")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
,@(if (string=? "builtin:download"
|
||||||
|
builder)
|
||||||
|
'("builtin:download")
|
||||||
|
`("\""
|
||||||
|
(a (@ (href ,builder))
|
||||||
|
,(display-file-in-store-item-oneline builder))
|
||||||
|
"\""))
|
||||||
|
",")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"[")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Arguments")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(div
|
||||||
|
(@ (style "margin-left: 3em;"))
|
||||||
|
,@(map (lambda (arg count-down)
|
||||||
|
`(div "\""
|
||||||
|
,arg
|
||||||
|
"\""
|
||||||
|
,@(if (eq? count-down 0)
|
||||||
|
'()
|
||||||
|
'(","))))
|
||||||
|
args
|
||||||
|
(reverse (iota (length args)))))))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"],[")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-2"))
|
||||||
|
"Environment variables")
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-10")
|
||||||
|
(style "font-family: monospace;"))
|
||||||
|
,@(map (lambda (env-var count-down)
|
||||||
|
`(div (@ (style "margin-left: 3em;"))
|
||||||
|
"("
|
||||||
|
"\"" ,(assq-ref env-var 'key) "\""
|
||||||
|
","
|
||||||
|
"\"" ,(assq-ref env-var 'value) "\""
|
||||||
|
")"))
|
||||||
|
env-vars
|
||||||
|
(reverse (iota (length env-vars))))
|
||||||
|
(span (@ (style "margin-left: 1.5em;"))
|
||||||
|
"]")))
|
||||||
|
(div
|
||||||
|
(@ (class "row"))
|
||||||
|
(div
|
||||||
|
(@ (class "col-md-offset-2 col-md-10")
|
||||||
|
(style "font-family: monospace; font-size: 1.5em;"))
|
||||||
|
")")))))))))
|
||||||
|
|
||||||
(define (general-not-found header-text body)
|
(define (general-not-found header-text body)
|
||||||
(layout
|
(layout
|
||||||
#:body
|
#:body
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue