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

Switch the compare page to use parse-query-parameters

Browse source
This commit is contained in:
Christopher Baines 2019-10-12 18:39:45 +01:00
parent 30051a3740
commit 116775ad06
2 changed files with 79 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -491,59 +491,77 @@
(define (render-compare mime-types (define (render-compare mime-types
conn conn
base-commit query-parameters)
base-revision-id (if (any-invalid-query-parameters? query-parameters)
target-commit
target-revision-id)
(let-values
(((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes
(package-differences-data conn
base-revision-id
target-revision-id))))
(let* ((new-packages
(package-data-vhashes->new-packages base-packages-vhash
target-packages-vhash))
(removed-packages
(package-data-vhashes->removed-packages base-packages-vhash
target-packages-vhash))
(version-changes
(package-data-version-changes base-packages-vhash
target-packages-vhash))
(lint-warnings-data
(group-list-by-first-n-fields
2
(lint-warning-differences-data conn
base-revision-id
target-revision-id))))
(case (most-appropriate-mime-type (case (most-appropriate-mime-type
'(application/json text/html) '(application/json text/html)
mime-types) mime-types)
((application/json) ((application/json)
(render-json (render-json
`((new-packages . ,(list->vector new-packages)) '((error . "invalid query"))))
(removed-packages . ,(list->vector removed-packages))
(version-changes . ,(list->vector
(map
(match-lambda
((name data ...)
`((name . ,name)
,@data)))
version-changes))))
#:extra-headers http-headers-for-unchanging-content))
(else (else
(render-html (render-html
#:sxml (compare base-commit #:sxml (compare
target-commit query-parameters
(guix-revisions-cgit-url-bases #f
conn #f
(list base-revision-id #f
target-revision-id)) #f
new-packages #f))))
removed-packages (let ((base-revision-id (commit->revision-id
version-changes conn
lint-warnings-data) (assq-ref query-parameters 'base_commit)))
#:extra-headers http-headers-for-unchanging-content)))))) (target-revision-id (commit->revision-id
conn
(assq-ref query-parameters 'target_commit))))
(let-values
(((base-packages-vhash target-packages-vhash)
(package-data->package-data-vhashes
(package-differences-data conn
base-revision-id
target-revision-id))))
(let* ((new-packages
(package-data-vhashes->new-packages base-packages-vhash
target-packages-vhash))
(removed-packages
(package-data-vhashes->removed-packages base-packages-vhash
target-packages-vhash))
(version-changes
(package-data-version-changes base-packages-vhash
target-packages-vhash))
(lint-warnings-data
(group-list-by-first-n-fields
2
(lint-warning-differences-data conn
base-revision-id
target-revision-id))))
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
`((new-packages . ,(list->vector new-packages))
(removed-packages . ,(list->vector removed-packages))
(version-changes . ,(list->vector
(map
(match-lambda
((name data ...)
`((name . ,name)
,@data)))
version-changes))))
#:extra-headers http-headers-for-unchanging-content))
(else
(render-html
#:sxml (compare query-parameters
(guix-revisions-cgit-url-bases
conn
(list base-revision-id
target-revision-id))
new-packages
removed-packages
version-changes
lint-warnings-data)
#:extra-headers http-headers-for-unchanging-content))))))))
(define (render-compare/derivations mime-types (define (render-compare/derivations mime-types
conn conn
@ -1091,22 +1109,14 @@
(render-derivation conn path) (render-derivation conn path)
(render-store-item conn path)))) (render-store-item conn path))))
(('GET "compare") (('GET "compare")
(with-base-and-target-commits (let* ((parsed-query-parameters
query-parameters conn (parse-query-parameters
(lambda (base-commit base-revision-id target-commit target-revision-id) request
(if (not (and base-revision-id target-revision-id)) `((base_commit ,(parse-commit conn) #:required)
(render-compare-unknown-commit mime-types (target_commit ,(parse-commit conn) #:required)))))
conn (render-compare mime-types
base-commit conn
base-revision-id parsed-query-parameters)))
target-commit
target-revision-id)
(render-compare mime-types
conn
base-commit
base-revision-id
target-commit
target-revision-id)))))
(('GET "compare" "derivations") (('GET "compare" "derivations")
(let* ((parsed-query-parameters (let* ((parsed-query-parameters
(parse-query-parameters (parse-query-parameters

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

@ -1628,13 +1628,18 @@
,(display-store-item-short path)))))) ,(display-store-item-short path))))))
derivation-outputs))))))))) derivation-outputs)))))))))
(define (compare base-commit (define (compare query-parameters
target-commit
cgit-url-bases cgit-url-bases
new-packages new-packages
removed-packages removed-packages
version-changes version-changes
lint-warnings-data) lint-warnings-data)
(define base-commit
(assq-ref query-parameters 'base_commit))
(define target-commit
(assq-ref query-parameters 'target_commit))
(define query-params (define query-params
(string-append "?base_commit=" base-commit (string-append "?base_commit=" base-commit
"&target_commit=" target-commit)) "&target_commit=" target-commit))