Continue improving pages and linking things together
This commit is contained in:
Christopher Baines
parent
0380c84a67
commit
a1e481cc4d
|
|
@ -2,6 +2,7 @@
|
|||
#:use-module (squee)
|
||||
#:export (select-build-stats
|
||||
select-builds-with-context
|
||||
select-builds-with-context-by-derivation-id
|
||||
select-build-by-build-server-and-id
|
||||
insert-build
|
||||
ensure-build-exists))
|
||||
|
|
@ -42,6 +43,25 @@
|
|||
|
||||
(exec-query conn query))
|
||||
|
||||
(define (select-builds-with-context-by-derivation-id conn derivation-id)
|
||||
(define query
|
||||
(string-append
|
||||
"SELECT builds.id, build_servers.url, "
|
||||
"latest_build_status.status_fetched_at, latest_build_status.starttime, "
|
||||
"latest_build_status.stoptime, latest_build_status.status "
|
||||
"FROM builds "
|
||||
"INNER JOIN build_servers ON build_servers.id = builds.build_server_id "
|
||||
"INNER JOIN "
|
||||
"(SELECT DISTINCT ON (internal_build_id) * "
|
||||
"FROM build_status "
|
||||
"ORDER BY internal_build_id, status_fetched_at DESC"
|
||||
") AS latest_build_status "
|
||||
"ON latest_build_status.internal_build_id = builds.internal_id "
|
||||
"WHERE builds.derivation_id = $1 "
|
||||
"ORDER BY latest_build_status.status_fetched_at DESC "))
|
||||
|
||||
(exec-query conn query (list derivation-id)))
|
||||
|
||||
(define (select-build-by-build-server-and-id
|
||||
conn build-server-id id)
|
||||
(exec-query conn
|
||||
|
|
|
|||
|
|
@ -9,6 +9,8 @@
|
|||
#:use-module (guix-data-service model utils)
|
||||
#:export (select-derivation-by-file-name
|
||||
select-derivation-outputs-by-derivation-id
|
||||
select-derivation-by-output-filename
|
||||
select-derivations-using-output
|
||||
select-derivation-inputs-by-derivation-id
|
||||
select-existing-derivations
|
||||
select-derivations-by-id
|
||||
|
|
@ -34,6 +36,32 @@
|
|||
",")
|
||||
")"))
|
||||
|
||||
(define (select-derivation-by-output-filename conn filename)
|
||||
(define query
|
||||
(string-append
|
||||
"SELECT derivations.file_name, derivation_outputs.id "
|
||||
"FROM derivation_output_details "
|
||||
"INNER JOIN derivation_outputs"
|
||||
" ON derivation_output_details.id = derivation_outputs.derivation_output_details_id "
|
||||
"INNER JOIN derivations"
|
||||
" ON derivation_outputs.derivation_id = derivations.id "
|
||||
"WHERE derivation_output_details.path = $1"))
|
||||
|
||||
(exec-query conn query (list filename)))
|
||||
|
||||
(define (select-derivations-using-output conn output-id)
|
||||
(define query
|
||||
(string-append
|
||||
"SELECT derivations.file_name "
|
||||
"FROM derivations "
|
||||
"INNER JOIN derivation_inputs"
|
||||
" ON derivation_inputs.derivation_id = derivations.id "
|
||||
"WHERE derivation_output_id = $1 "
|
||||
"ORDER BY derivations.file_name "
|
||||
"LIMIT 100 "))
|
||||
|
||||
(exec-query conn query (list output-id)))
|
||||
|
||||
(define (insert-derivation-outputs conn
|
||||
derivation-id
|
||||
names-and-derivation-outputs)
|
||||
|
|
|
|||
|
|
@ -210,17 +210,31 @@
|
|||
(first derivation)))
|
||||
(derivation-outputs (select-derivation-outputs-by-derivation-id
|
||||
conn
|
||||
(first derivation))))
|
||||
(first derivation)))
|
||||
(builds (select-builds-with-context-by-derivation-id
|
||||
conn
|
||||
(first derivation))))
|
||||
(apply render-html
|
||||
(view-derivation derivation
|
||||
derivation-inputs
|
||||
derivation-outputs)))
|
||||
derivation-outputs
|
||||
builds)))
|
||||
#f ;; TODO
|
||||
)))
|
||||
|
||||
(define (render-store-item conn filename)
|
||||
(apply render-html
|
||||
(view-store-item filename)))
|
||||
(let ((derivation (select-derivation-by-output-filename conn filename)))
|
||||
(match derivation
|
||||
(()
|
||||
#f)
|
||||
((derivation)
|
||||
(apply render-html
|
||||
(view-store-item filename
|
||||
derivation
|
||||
(match derivation
|
||||
((file-name output-id rest ...)
|
||||
(select-derivations-using-output
|
||||
conn output-id)))))))))
|
||||
|
||||
(define (controller request body conn)
|
||||
(match-lambda
|
||||
|
|
@ -237,6 +251,11 @@
|
|||
(view-revision commit-hash
|
||||
(select-packages-in-revision conn
|
||||
commit-hash))))
|
||||
((GET "revision" commit-hash "package" name version)
|
||||
(apply render-html
|
||||
(view-revision-package-and-version commit-hash
|
||||
name
|
||||
version)))
|
||||
((GET "gnu" "store" filename)
|
||||
(if (string-suffix? ".drv" filename)
|
||||
(render-derivation conn (string-append "/gnu/store/" filename))
|
||||
|
|
|
|||
|
|
@ -24,6 +24,7 @@
|
|||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:export (index
|
||||
view-revision-package-and-version
|
||||
view-revision
|
||||
view-builds
|
||||
view-derivation
|
||||
|
|
@ -144,7 +145,9 @@
|
|||
((id url commit store_path)
|
||||
`(tr
|
||||
(td ,url)
|
||||
(td (samp ,commit)))))
|
||||
(td (a (@ (href ,(string-append
|
||||
"/revision/" commit)))
|
||||
(samp ,commit))))))
|
||||
guix-revisions)))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
|
|
@ -168,6 +171,18 @@
|
|||
(td ,source))))
|
||||
queued-guix-revisions)))))))))
|
||||
|
||||
(define (view-revision-package-and-version revision-commit-hash name version)
|
||||
(layout
|
||||
#:extra-headers
|
||||
'((cache-control . ((max-age . 60))))
|
||||
#:body
|
||||
`(,(header)
|
||||
(div
|
||||
(@ (class "container"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(h1 "Package " ,name " @ " ,version))))))
|
||||
|
||||
(define (view-revision commit-hash packages)
|
||||
(layout
|
||||
#:extra-headers
|
||||
|
|
@ -187,13 +202,16 @@
|
|||
(thead
|
||||
(tr
|
||||
(th (@ (class "col-md-3")) "Name")
|
||||
(th (@ (class "col-md-9")) "Version")))
|
||||
(th (@ (class "col-md-3")) "Version")))
|
||||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
((name version rest ...)
|
||||
`(tr
|
||||
(td ,name)
|
||||
(td (a (@ (href ,(string-append
|
||||
"/revision/" commit-hash
|
||||
"/package/" name "/" version)))
|
||||
,name))
|
||||
(td ,version))))
|
||||
packages))))))))
|
||||
|
||||
|
|
@ -258,7 +276,7 @@
|
|||
(define (display-store-item-short item)
|
||||
`((span (@ (style "font-size: small; font-family: monospace; display: block;"))
|
||||
,(string-take item 44))
|
||||
(span (@ (style "font-size: x-large; font-family: monospace;"))
|
||||
(span (@ (style "font-size: x-large; font-family: monospace; display: block;"))
|
||||
,(string-drop item 44))))
|
||||
|
||||
(define (display-store-item item)
|
||||
|
|
@ -267,7 +285,22 @@
|
|||
(span (@ (style "font-size: x-large; font-family: monospace;"))
|
||||
,(string-drop item 44))))
|
||||
|
||||
(define (view-store-item filename)
|
||||
(define (display-store-item-title item)
|
||||
`(h1 (span (@ (style "font-size: 1em; font-family: monospace; display: block;"))
|
||||
,(string-take item 44))
|
||||
(span (@ (style "line-height: 1.7em; font-size: 1.5em; font-family: monospace;"))
|
||||
,(string-drop item 44))))
|
||||
|
||||
(define (display-file-in-store-item filename)
|
||||
(match (string-split filename #\/)
|
||||
(("" "gnu" "store" item fileparts ...)
|
||||
`(,(let ((full-item (string-append "/gnu/store/" item)))
|
||||
`(a (@ (href ,full-item))
|
||||
,(display-store-item-short full-item)))
|
||||
,(string-append
|
||||
"/" (string-join fileparts "/"))))))
|
||||
|
||||
(define (view-store-item filename derivation derivations-using-store-item)
|
||||
(layout
|
||||
#:extra-headers
|
||||
'((cache-control . ((max-age . 60))))
|
||||
|
|
@ -277,9 +310,32 @@
|
|||
(@ (class "container"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(h1 (samp ,filename)))))))
|
||||
,(display-store-item-title filename))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(h4 "Derivation: ")
|
||||
,(match derivation
|
||||
((file-name output-id)
|
||||
`(a (@ (href ,file-name))
|
||||
,(display-store-item file-name)))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(h2 "Derivations using this store item "
|
||||
,(let ((count (length derivations-using-store-item)))
|
||||
(if (eq? count 100)
|
||||
"(> 100)"
|
||||
(simple-format #f "(~A)" count))))
|
||||
(ul
|
||||
(@ (class "list-unstyled"))
|
||||
,(map
|
||||
(match-lambda
|
||||
((file-name)
|
||||
`(li (a (@ (href ,file-name))
|
||||
,(display-store-item file-name)))))
|
||||
derivations-using-store-item)))))))
|
||||
|
||||
(define (view-derivation derivation derivation-inputs derivation-outputs)
|
||||
(define (view-derivation derivation derivation-inputs derivation-outputs
|
||||
builds)
|
||||
(layout
|
||||
#:extra-headers
|
||||
'((cache-control . ((max-age . 60))))
|
||||
|
|
@ -291,7 +347,7 @@
|
|||
((id file-name builder args env-vars system)
|
||||
`(div
|
||||
(@ (class "row"))
|
||||
(h1 "Derivation " (samp ,file-name)))))
|
||||
,(display-store-item-title file-name))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
|
|
@ -311,7 +367,31 @@
|
|||
derivation-inputs))))
|
||||
(div
|
||||
(@ (class "col-md-4"))
|
||||
"Details")
|
||||
(h3 "Derivation details")
|
||||
,(match derivation
|
||||
((id file-name builder args env-vars system)
|
||||
`(table
|
||||
(@ (class "table"))
|
||||
(tbody
|
||||
(tr
|
||||
(td "Builder")
|
||||
(td (a (@ (href ,builder))
|
||||
,(display-file-in-store-item builder))))
|
||||
(tr
|
||||
(td "System")
|
||||
(td (samp ,system)))))))
|
||||
(h3 "Build status")
|
||||
,@(map
|
||||
(match-lambda
|
||||
((build-id build-server-url status-fetched-at
|
||||
starttime stoptime status)
|
||||
`(div
|
||||
(@ (class "text-center"))
|
||||
(div ,status)
|
||||
(a (@ (href ,(simple-format
|
||||
#f "~Abuild/~A" build-server-url build-id)))
|
||||
"View build on " ,build-server-url))))
|
||||
builds))
|
||||
(div
|
||||
(@ (class "col-md-4"))
|
||||
(h3 "Outputs")
|
||||
|
|
|
|||
Loading…
Reference in New Issue