[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
branch master updated: Change data handling when comparing derivations
|
From: |
Christopher Baines |
|
Subject: |
branch master updated: Change data handling when comparing derivations |
|
Date: |
Tue, 27 Apr 2021 16:29:17 -0400 |
This is an automated email from the git hooks/post-receive script.
cbaines pushed a commit to branch master
in repository data-service.
The following commit(s) were added to refs/heads/master by this push:
new 767e60b Change data handling when comparing derivations
767e60b is described below
commit 767e60b2b3c62f7f3fc185f828fa58b868764150
Author: Luciana Lima Brito <lubrito@posteo.net>
AuthorDate: Tue Apr 27 19:53:55 2021 +0000
Change data handling when comparing derivations
comparison.scm: return query data for derivation comparison as an alist,
instead of list.
html.scm: Access derivation differences data using assq-ref.
controller.scm: remove mapping for outputs/inputs/sources.
utils.scm: add group-to-alist/vector function.
Signed-off-by: Christopher Baines <mail@cbaines.net>
---
guix-data-service/comparison.scm | 81 +++++++++++++------------
guix-data-service/model/utils.scm | 8 +++
guix-data-service/web/compare/controller.scm | 88 ++++------------------------
guix-data-service/web/compare/html.scm | 74 +++++++++++------------
4 files changed, 97 insertions(+), 154 deletions(-)
diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index d40f8e6..3eee5f7 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -74,19 +74,20 @@
'value))
`((outputs
- . ,(group-to-alist
+ . ,(group-to-alist/vector
group-by-last-element
(derivation-outputs-differences-data conn
(first base-derivation)
(first target-derivation))))
(inputs
- . ,(group-to-alist
+ . ,(group-to-alist/vector
group-by-last-element
(derivation-inputs-differences-data conn
(first base-derivation)
(first target-derivation))))
+
(sources
- . ,(group-to-alist
+ . ,(group-to-alist/vector
group-by-last-element
(derivation-sources-differences-data conn
(first base-derivation)
@@ -107,9 +108,9 @@
(target . ,target-builder))))
(arguments
. ,(if (eq? base-args target-args)
- `((common . ,base-args))
- `((base . ,base-args)
- (target . ,target-args))))
+ `((common . ,(list->vector base-args)))
+ `((base . ,(list->vector base-args))
+ (target . ,(list->vector target-args)))))
(environment-variables
. ,(map (lambda (key)
(let ((base-value (fetch-value base-env-vars key))
@@ -158,19 +159,23 @@ GROUP BY 1, 2, 3, 4, 5"))
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
- (list output-name
- path
- hash-algorithm
- hash
- recursive
- (append (if (memq base-derivation-id
- parsed-derivation-ids)
- '(base)
- '())
- (if (memq target-derivation-id
- parsed-derivation-ids)
- '(target)
- '()))))))
+ `((output-name . ,output-name)
+ (path . ,path)
+ ,@(if (string? hash-algorithm)
+ `((hash-algorithm . ,hash-algorithm))
+ `((hash-algorithm . null)))
+ ,@(if (string? hash)
+ `((hash . ,hash))
+ `((hash . null)))
+ (recursive . ,(string=? recursive "t"))
+ ,(append (if (memq base-derivation-id
+ parsed-derivation-ids)
+ '(base)
+ '())
+ (if (memq target-derivation-id
+ parsed-derivation-ids)
+ '(target)
+ '()))))))
(exec-query conn query)))
(define (derivation-inputs-differences-data conn
@@ -202,16 +207,16 @@ INNER JOIN derivations ON
derivation_outputs.derivation_id = derivations.id
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
- (list derivation_file_name
- derivation_output_name
- (append (if (memq base-derivation-id
- parsed-derivation-ids)
- '(base)
- '())
- (if (memq target-derivation-id
- parsed-derivation-ids)
- '(target)
- '()))))))
+ `((derivation_file_name . ,derivation_file_name)
+ (derivation_output_name . ,derivation_output_name)
+ ,(append (if (memq base-derivation-id
+ parsed-derivation-ids)
+ '(base)
+ '())
+ (if (memq target-derivation-id
+ parsed-derivation-ids)
+ '(target)
+ '()))))))
(exec-query conn query)))
(define (derivation-sources-differences-data conn
@@ -235,15 +240,15 @@ GROUP BY derivation_source_files.store_path"))
(let ((parsed-derivation-ids
(map string->number
(parse-postgresql-array-string derivation_ids))))
- (list store_path
- (append (if (memq base-derivation-id
- parsed-derivation-ids)
- '(base)
- '())
- (if (memq target-derivation-id
- parsed-derivation-ids)
- '(target)
- '()))))))
+ `((store_path . ,store_path)
+ ,(append (if (memq base-derivation-id
+ parsed-derivation-ids)
+ '(base)
+ '())
+ (if (memq target-derivation-id
+ parsed-derivation-ids)
+ '(target)
+ '()))))))
(exec-query conn query)))
(define* (package-derivation-differences-data conn
diff --git a/guix-data-service/model/utils.scm
b/guix-data-service/model/utils.scm
index 13947bd..b11cee5 100644
--- a/guix-data-service/model/utils.scm
+++ b/guix-data-service/model/utils.scm
@@ -33,6 +33,7 @@
deduplicate-strings
group-list-by-first-n-fields
group-to-alist
+ group-to-alist/vector
insert-missing-data-and-return-all-ids))
(define NULL '())
@@ -114,6 +115,13 @@
'()
lst))
+(define (group-to-alist/vector process lst)
+ (map
+ (match-lambda
+ ((label . items)
+ (cons label (list->vector items))))
+ (group-to-alist process lst)))
+
(define (table-schema conn table-name)
(let ((results
(exec-query
diff --git a/guix-data-service/web/compare/controller.scm
b/guix-data-service/web/compare/controller.scm
index 30cf835..bbc9829 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -589,82 +589,18 @@
'(application/json text/html)
mime-types)
((application/json)
- (let ((outputs
- (map
- (lambda (label items)
- (cons label
- (list->vector
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `((name . ,name)
- (path . ,path)
- ,@(if (string? hash-alg)
- `((hash-algorithm . ,hash-alg))
- '())
- ,@(if (string? hash)
- `((hash . ,hash))
- '())
- (recursive . ,(string=? recursive "t")))))
- (or items '())))))
- '(base target common)
- (let ((output-groups (assq-ref data 'outputs)))
- (list (assq-ref output-groups 'base)
- (assq-ref output-groups 'target)
- (assq-ref output-groups 'common)))))
-
- (inputs
- (map
- (lambda (label items)
- (cons label
- (list->vector
- (map
- (match-lambda
- ((derivation output)
- `((derivation . ,derivation)
- (output . ,output))))
- (or items '())))))
- '(base target common)
- (let ((input-groups (assq-ref data 'inputs)))
- (list (assq-ref input-groups 'base)
- (assq-ref input-groups 'target)
- (assq-ref input-groups 'common)))))
-
- (sources
- (map
- (lambda (label items)
- (cons label
- (list->vector
- (map
- (match-lambda
- ((derivation)
- `((derivation . ,derivation))))
- (or items '())))))
- '(base target common)
- (let ((source-groups (assq-ref data 'sources)))
- (list (assq-ref source-groups 'base)
- (assq-ref source-groups 'target)
- (assq-ref source-groups 'common)))))
-
- (arguments
- (map
- (match-lambda
- ((label args ...)
- `(,label . ,(list->vector args))))
- (assq-ref data 'arguments))))
-
- (render-json
- `((base . ((derivation . ,base-derivation)))
- (target . ((derivation . ,target-derivation)))
- (outputs . ,outputs)
- (inputs . ,inputs)
- (sources . ,sources)
- (system . ,(assq-ref data 'system))
- (builder . ,(assq-ref data 'builder))
- (arguments . ,arguments)
- (environment-variables . ,(assq-ref
- data 'environment-variables)))
- #:extra-headers http-headers-for-unchanging-content)))
+ (render-json
+ `((base . ((derivation . ,base-derivation)))
+ (target . ((derivation . ,target-derivation)))
+ (outputs . ,(assq-ref data 'outputs))
+ (inputs . ,(assq-ref data 'inputs))
+ (sources . ,(assq-ref data 'sources))
+ (system . ,(assq-ref data 'system))
+ (builder . ,(assq-ref data 'builder))
+ (arguments . ,(assq-ref data 'arguments))
+ (environment-variables . ,(assq-ref
+ data 'environment-variables)))
+ #:extra-headers http-headers-for-unchanging-content))
(else
(render-html
#:sxml (compare/derivation
diff --git a/guix-data-service/web/compare/html.scm
b/guix-data-service/web/compare/html.scm
index be98f43..128e3f4 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -494,27 +494,23 @@
(th "Hash")
(th "Recursive")))
(tbody
- ,@(let ((base-outputs (assq-ref outputs 'base))
- (target-outputs (assq-ref outputs 'target))
- (common-outputs (assq-ref outputs 'common)))
- (append-map
- (lambda (label items)
- (map
- (match-lambda
- ((name path hash-algorithm hash recursive)
- `(tr
- (td ,label)
- (td ,name)
- (td (a (@ (href ,path))
- ,(display-store-item path)))
- (td ,hash-algorithm)
- (td ,hash)
- (td ,recursive))))
- (or items '())))
- (list base target "Common")
- (list (assq-ref outputs 'base)
- (assq-ref outputs 'target)
- (assq-ref outputs 'common))))))))
+ ,@(append-map
+ (lambda (label items)
+ (map
+ (lambda (alist)
+ `(tr
+ (td ,label)
+ (td ,(assq-ref alist 'output-name))
+ (td (a (@ (href ,(assq-ref alist 'path)))
+ ,(display-store-item (assq-ref alist 'path))))
+ (td ,(assq-ref alist 'hash-algorithm))
+ (td ,(assq-ref alist 'hash))
+ (td ,(assq-ref alist 'recursive))))
+ (or (and=> items vector->list) '())))
+ (list base target "Common")
+ (list (assq-ref outputs 'base)
+ (assq-ref outputs 'target)
+ (assq-ref outputs 'common)))))))
(h2 "Inputs")
,@(let ((inputs (assq-ref data 'inputs)))
`((table
@@ -528,14 +524,13 @@
,@(append-map
(lambda (label items)
(map
- (match-lambda
- ((derivation outputs)
- `(tr
- (td ,label)
- (td (a (@ (href ,derivation))
- ,(display-store-item derivation)))
- (td ,outputs))))
- (or items '())))
+ (lambda (alist)
+ `(tr
+ (td ,label)
+ (td (a (@ (href ,(assq-ref alist
'derivation_file_name)))
+ ,(display-store-item (assq-ref alist
'derivation_file_name))))
+ (td ,(assq-ref alist 'derivation_output_name))))
+ (or (and=> items vector->list) '())))
(list base target)
(list (assq-ref inputs 'base)
(assq-ref inputs 'target)))))))
@@ -552,13 +547,12 @@
,@(append-map
(lambda (label items)
(map
- (match-lambda
- ((file)
- `(tr
- (td ,label)
- (td (a (@ (href ,file))
- ,(display-store-item file))))))
- (or items '())))
+ (lambda (alist)
+ `(tr
+ (td ,label)
+ (td (a (@ (href ,(assq-ref alist 'store_path)))
+ ,(display-store-item (assq-ref alist
'store_path))))))
+ (or (and=> items vector->list) '())))
(list base target "Common")
(list (assq-ref sources 'base)
(assq-ref sources 'target)
@@ -622,8 +616,8 @@
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item
arg)))
- (or common-args
- base-args)))))
+ (or (and=> common-args vector->list)
+ (vector->list base-args))))))
(tr
(td ,target)
(td ,(display-possible-store-item
@@ -632,8 +626,8 @@
(td (ol
,@(map (lambda (arg)
`(li ,(display-possible-store-item
arg)))
- (or common-args
- target-args))))))))))))
+ (or (and=> common-args vector->list)
+ (vector->list
target-args)))))))))))))
(h2 "Environment variables")
,(let ((environment-variables (assq-ref data 'environment-variables)))
`(table
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- branch master updated: Change data handling when comparing derivations,
Christopher Baines <=