diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-10-13 20:51:47 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-10-13 20:51:47 +0100 |
| commit | 955ada8bca477aee95be11b8b7f2f88ecce330d4 (patch) | |
| tree | dcdec2e39b72c2f937acb5620f2f07da99f1b54f | |
| parent | 15db1b06880058b2436aafbb064c85ef6e185953 (diff) | |
| download | data-service-955ada8bca477aee95be11b8b7f2f88ecce330d4.tar data-service-955ada8bca477aee95be11b8b7f2f88ecce330d4.tar.gz | |
Add a compare-by-datetime page
This is to compare the state of a branch (or two different branches) at two
different times. This complements the ability to compare by revision to be
able to just compare by date and time. The relevant revisions are determined,
and then compared as normal.
This is only a very rough initial implementation, as I'm hoping to refactor
the code to reduce duplication.
| -rw-r--r-- | guix-data-service/web/controller.scm | 101 |
1 files changed, 101 insertions, 0 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index cda058e..6f534e9 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -535,6 +535,96 @@ lint-warnings-data) #:extra-headers http-headers-for-unchanging-content)))))))) +(define (render-compare-by-datetime mime-types + conn + query-parameters) + (if (any-invalid-query-parameters? query-parameters) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + '((error . "invalid query")))) + (else + (render-html + #:sxml (compare-invalid-parameters + query-parameters + (match (assq-ref query-parameters 'base_commit) + (($ <invalid-query-parameter> value) + (select-job-for-commit conn value)) + (_ #f)) + (match (assq-ref query-parameters 'target_commit) + (($ <invalid-query-parameter> value) + (select-job-for-commit conn value)) + (_ #f)))))) + + (let ((base-branch (assq-ref query-parameters 'base_branch)) + (base-datetime (assq-ref query-parameters 'base_datetime)) + (target-branch (assq-ref query-parameters 'target_branch)) + (target-datetime (assq-ref query-parameters 'target_datetime))) + (let* ((base-revision-details + (select-guix-revision-for-branch-and-datetime conn + base-branch + base-datetime)) + (base-revision-id + (first base-revision-details)) + (target-revision-details + (select-guix-revision-for-branch-and-datetime conn + target-branch + target-datetime)) + (target-revision-id + (first target-revision-details))) + (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 + (base_commit . ,(second base-revision-details)) + (target_commit . ,(second target-revision-details))) + (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 conn query-parameters) @@ -1178,6 +1268,17 @@ (render-compare mime-types conn parsed-query-parameters))) + (('GET "compare-by-datetime") + (let* ((parsed-query-parameters + (parse-query-parameters + request + `((base_branch ,identity #:required) + (base_datetime ,parse-datetime #:required) + (target_branch ,identity #:required) + (target_datetime ,parse-datetime #:required))))) + (render-compare-by-datetime mime-types + conn + parsed-query-parameters))) (('GET "compare" "derivations") (let* ((parsed-query-parameters (parse-query-parameters |