diff options
author | Christopher Baines <mail@cbaines.net> | 2019-11-14 20:57:21 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2019-11-14 21:08:20 +0000 |
commit | ada5a04dd137ba77a5497042968970b47d272e65 (patch) | |
tree | 088396f2b3739f54678ec259ba5703bc1841e6e6 /guix-data-service/web/compare/controller.scm | |
parent | c7224dc2adbbddc4f6a3c48d16adf9af44428fa6 (diff) | |
download | data-service-ada5a04dd137ba77a5497042968970b47d272e65.tar data-service-ada5a04dd137ba77a5497042968970b47d272e65.tar.gz |
Add a basic derivation comparison page
Diffstat (limited to 'guix-data-service/web/compare/controller.scm')
-rw-r--r-- | guix-data-service/web/compare/controller.scm | 52 |
1 files changed, 52 insertions, 0 deletions
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index 381d25b..16dcf39 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -53,6 +53,13 @@ (make-invalid-query-parameter s "unknown commit")))) +(define (parse-derivation conn) + (lambda (file-name) + (if (select-derivation-by-file-name conn file-name) + file-name + (make-invalid-query-parameter + file-name "unknown derivation")))) + (define (compare-controller request method-and-path-components mime-types @@ -79,6 +86,15 @@ (render-compare-by-datetime mime-types conn parsed-query-parameters))) + (('GET "compare" "derivation") + (let* ((parsed-query-parameters + (parse-query-parameters + request + `((base_derivation ,(parse-derivation conn) #:required) + (target_derivation ,(parse-derivation conn) #:required))))) + (render-compare/derivation mime-types + conn + parsed-query-parameters))) (('GET "compare" "derivations") (let* ((parsed-query-parameters (parse-query-parameters @@ -287,6 +303,42 @@ lint-warnings-data) #:extra-headers http-headers-for-unchanging-content))))))))) +(define (render-compare/derivation 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/derivation + query-parameters + '())))) + + (let ((base-derivation (assq-ref query-parameters 'base_derivation)) + (target-derivation (assq-ref query-parameters 'target_derivation))) + (let ((data + (derivation-differences-data conn + base-derivation + target-derivation))) + (case (most-appropriate-mime-type + '(application/json text/html) + mime-types) + ((application/json) + (render-json + '((error . "unimplemented")) ; TODO + #:extra-headers http-headers-for-unchanging-content)) + (else + (render-html + #:sxml (compare/derivation + query-parameters + data) + #:extra-headers http-headers-for-unchanging-content))))))) + (define (render-compare/derivations mime-types conn query-parameters) |