On Mon, 26 Apr 2021 09:15:37 +0100
Christopher Baines <m...@cbaines.net> wrote:
> So, one advantage of alists over lists is that the code is probably
> less brittle when adding elements say, since code parsing the list
> will probably break with a new element, but this is probably less
> likely to happen with an alist.
>
> However, this will happen with an alist if match is used to pick
> elements out. I'd suggest using assq-ref or similar to pluck elements
> out.
Ok, I changed that on the html.scm.
> I'd consider these options first probably:
>
> - Could the data coming from derivation-differences-data have vectors
> where appropriate already? The HTML code would probably need to be
> adjusted, but I think that's fine.
I tried this for days but with no success. Maybe the only way would be
to tweak group-to-alist, but it touches many places, and I didn't want
to mess with it.
> - Could this be written in a form like:
>
> ,@(map (lambda (name)
> ...)
> '(outputs inputs sources arguments))
This only make sense to me inside render-json (because of the ,@), but I
think the code would be less clean and "arguments" would appear in a
different order. What I did was bind the result of a function similar
to this in the let.
Well, this way made things much shorter. I'm sending a new patch for
you to review.
--
Best Regards,
Luciana Lima Brito
MSc. in Computer Science
>From d0e221f5aef2892582bdcb73aceadf937b50e45f Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubr...@posteo.net>
Date: Sun, 25 Apr 2021 15:17:33 -0300
Subject: [PATCH] Change handling of queried data for derivations comparison.
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: generalize map for outputs/inputs/sources/arguments.
---
guix-data-service/comparison.scm | 68 ++++++++--------
guix-data-service/web/compare/controller.scm | 82 ++++----------------
guix-data-service/web/compare/html.scm | 53 ++++++-------
3 files changed, 75 insertions(+), 128 deletions(-)
diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index e5e1955..1f47c38 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -158,19 +158,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 . ())))
+ ,@(if (string? hash)
+ `((hash . ,hash))
+ `((hash . ())))
+ (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 +206,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 +239,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/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 895bb40..287ae97 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,79 +588,25 @@
'(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))))
-
+ (let ((data-groups
+ (map (lambda (name)
+ (cons name
+ (map
+ (match-lambda
+ ((label args ...)
+ `(,label . ,(list->vector args))))
+ (assq-ref data name))))
+ '(outputs inputs sources arguments))))
+
(render-json
`((base . ((derivation . ,base-derivation)))
(target . ((derivation . ,target-derivation)))
- (outputs . ,outputs)
- (inputs . ,inputs)
- (sources . ,sources)
+ (outputs . ,(assq-ref data-groups 'outputs))
+ (inputs . ,(assq-ref data-groups 'inputs))
+ (sources . ,(assq-ref data-groups 'sources))
(system . ,(assq-ref data 'system))
(builder . ,(assq-ref data 'builder))
- (arguments . ,arguments)
+ (arguments . ,(assq-ref data-groups 'arguments))
(environment-variables . ,(assq-ref
data 'environment-variables)))
#:extra-headers http-headers-for-unchanging-content)))
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index 5b5fe0a..22e2dfc 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -487,27 +487,24 @@
(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
+ (match-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 items '())))
+ (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
@@ -522,12 +519,12 @@
(lambda (label items)
(map
(match-lambda
- ((derivation outputs)
+ ((alist ...)
`(tr
(td ,label)
- (td (a (@ (href ,derivation))
- ,(display-store-item derivation)))
- (td ,outputs))))
+ (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 items '())))
(list base target)
(list (assq-ref inputs 'base)
@@ -546,11 +543,11 @@
(lambda (label items)
(map
(match-lambda
- ((file)
+ ((alist ...)
`(tr
(td ,label)
- (td (a (@ (href ,file))
- ,(display-store-item file))))))
+ (td (a (@ (href ,(assq-ref alist 'store_path)))
+ ,(display-store-item (assq-ref alist 'store_path)))))))
(or items '())))
(list base target "Common")
(list (assq-ref sources 'base)
--
2.30.2
