cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Remove the HTTP headers from the html module

Browse source 
Given that the headers may be the same, regardless whether it's HTML or JSON
being sent in the body of the response, I think it makes more sense to handle
the headers in the controller.
This commit is contained in:
Christopher Baines 2019-05-18 20:08:34 +01:00
parent ed19764bc3
commit 03faff5da0
2 changed files with 151 additions and 181 deletions
Download patch file Download diff file Expand all files Collapse all files

65
guix-data-service/web/controller.scm
View file

@ -106,8 +106,8 @@
(derivation_count . ,derivation_count))))
derivations-counts))))))
(else
(apply render-html
(view-revision
(render-html
#:sxml (view-revision
commit-hash
packages-count
git-repositories-and-branches
@ -133,8 +133,8 @@
(render-json
`((error . "invalid query"))))
(else
(apply render-html
(view-revision-packages commit-hash
(render-html
#:sxml (view-revision-packages commit-hash
query-parameters
'()
'()
@ -204,8 +204,8 @@
'()))))
packages))))))
(else
(apply render-html
(view-revision-packages commit-hash
(render-html
#:sxml (view-revision-packages commit-hash
query-parameters
packages
git-repositories
@ -251,8 +251,8 @@
(derivation . ,file-name))))
derivations))))))
(else
(apply render-html
(view-revision-package-and-version commit-hash
(render-html
#:sxml (view-revision-package-and-version commit-hash
name
version
metadata
@ -272,8 +272,8 @@
(render-json
'((unknown_commit . #t))))
(else
(apply render-html
(compare-unknown-commit base-commit
(render-html
#:sxml (compare-unknown-commit base-commit
target-commit
(if base-revision-id #t #f)
(if target-revision-id #t #f)
@ -316,8 +316,8 @@
(version-changes . ,version-changes)
(derivation-changes . ,derivation-changes))))
(else
(apply render-html
(compare base-commit
(render-html
#:sxml (compare base-commit
target-commit
new-packages
removed-packages
@ -346,8 +346,8 @@
(render-json
'((error . "invalid query"))))
(else
(apply render-html
(compare/derivations
(render-html
#:sxml (compare/derivations
query-parameters
(valid-systems conn)
build-status-strings
@ -393,8 +393,8 @@
(derivations->alist
target-derivations))))))))
(else
(apply render-html
(compare/derivations
(render-html
#:sxml (compare/derivations
query-parameters
(valid-systems conn)
build-status-strings
@ -436,8 +436,8 @@
(packages . ,(list->vector
(package-data-vhash->json target-packages-vhash))))))))
(else
(apply render-html
(compare/packages
(render-html
#:sxml (compare/packages
base-commit
target-commit
base-packages-vhash
@ -456,8 +456,8 @@
(builds (select-builds-with-context-by-derivation-id
conn
(first derivation))))
(apply render-html
(view-derivation derivation
(render-html
#:sxml (view-derivation derivation
derivation-inputs
derivation-outputs
builds)))
@ -470,8 +470,8 @@
(()
#f)
(derivations
(apply render-html
(view-store-item filename
(render-html
#:sxml (view-store-item filename
derivations
(map (lambda (derivation)
(match derivation
@ -502,8 +502,8 @@
(match method-and-path-components
((GET)
(apply render-html
(index
(render-html
#:sxml (index
(map
(lambda (git-repository-details)
(cons
@ -521,12 +521,12 @@
(car git-repository-details)))))
(all-git-repositories conn)))))
((GET "builds")
(apply render-html
(view-builds (select-build-stats conn)
(render-html
#:sxml (view-builds (select-build-stats conn)
(select-builds-with-context conn))))
((GET "statistics")
(apply render-html
(view-statistics (count-guix-revisions conn)
(render-html
#:sxml (view-statistics (count-guix-revisions conn)
(count-derivations conn))))
((GET "revision" commit-hash) (render-view-revision mime-types
conn
@ -556,8 +556,8 @@
name
version))
((GET "branches")
(apply render-html
(view-branches
(render-html
#:sxml (view-branches
(all-branches-with-most-recent-commit conn))))
((GET "branch" branch-name)
(let ((parsed-query-parameters
@ -566,9 +566,8 @@
`((after_date ,parse-datetime)
(before_date ,parse-datetime)
(limit_results ,parse-result-limit #:default 100)))))
(apply
render-html
(if (any-invalid-query-parameters? parsed-query-parameters)
(render-html
#:sxml (if (any-invalid-query-parameters? parsed-query-parameters)
(view-branch branch-name parsed-query-parameters '())
(view-branch
branch-name

35
guix-data-service/web/view/html.scm
View file

@ -57,9 +57,8 @@
(define* (layout #:key
(head '())
(body '())
(title "Guix Data Service")
(extra-headers '()))
`(#:sxml ((doctype "html")
(title "Guix Data Service"))
`((doctype "html")
(html
(head
(title ,title)
@ -92,9 +91,7 @@
"Now with even more " (span (@ (class "lambda")) "λ") "! ")
(p "This is free software. Download the "
(a (@ (href "https://git.cbaines.net/guix/data-service/"))
"source code here") ".")))))
#:extra-headers ,extra-headers))
"source code here") "."))))))
(define* (form-horizontal-control label query-parameters
#:key
@ -202,8 +199,6 @@
(define (index git-repositories-and-revisions)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -290,8 +285,6 @@
(define (view-statistics guix-revisions-count derivations-count)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -315,8 +308,6 @@
package-metadata
derivations git-repositories)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -405,8 +396,6 @@
(define (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -490,8 +479,6 @@
"Home page" "Location" "Licenses")))
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -640,8 +627,6 @@
(define (view-branches branches-with-most-recent-commits)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -683,8 +668,6 @@
(define (view-branch branch-name query-parameters
branch-commits)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -746,8 +729,6 @@
(define (view-builds stats builds)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -858,8 +839,6 @@
(define (view-store-item filename derivations derivations-using-store-item-list)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -902,8 +881,6 @@
(define (view-derivation derivation derivation-inputs derivation-outputs
builds)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -996,8 +973,6 @@
"&target_commit=" target-commit))
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -1194,8 +1169,6 @@
base-derivations
target-derivations)
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div
@ -1322,8 +1295,6 @@
"&target_commit=" target-commit))
(layout
#:extra-headers
'((cache-control . ((max-age . 60))))
#:body
`(,(header)
(div