On Mon, 26 Apr 2021 22:21:50 +0100
Christopher Baines <m...@cbaines.net> wrote:
>
> Rather than writing:
>
> (match-lambda
> ((alist ...)
>
> I'd just use
>
> (lambda (alist)
>
> as I think that's equivalent right?
Right, I did this.
> >> 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.
>
> Maybe add another procedure that combines group-to-alist but generates
> an alist with vectors as the values? (group-to-alist/vector maybe).
> I think using let is OK, but I think just unpacking data-groups as
> you've called it directly in to the alist is fine (so ,@data-groups),
> rather than picking out the elements. JSON objects are unordered, so
> the ordering isn't something that really matters.
>
> If you do go down this route though, I'd probably add a comment saying
> what things are being added to the outer most alist, just to make the
> code quicker to read.
Well, I went down the second route, now I'm calling the ,@data-groups
and I added a comment explaining its use.
The main point here is, the code is working and it looks nice, but to
get the data with the vectors seems to be right too. I'm sending the
new patch for your review and I'll wait for your call, if you think I
should try the first route or not.
--
Best Regards,
Luciana Lima Brito
MSc. in Computer Science
>From 03a70ac2e07f2eec35a9473d8930a9cbefa50b92 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 | 78 +++-----------------
guix-data-service/web/compare/html.scm | 62 +++++++---------
3 files changed, 75 insertions(+), 133 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..a48b7c5 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,79 +588,23 @@
'(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))))
+ ;data-groups returns four pairs/entries: outputs, inputs, sources and arguments.
(render-json
`((base . ((derivation . ,base-derivation)))
(target . ((derivation . ,target-derivation)))
- (outputs . ,outputs)
- (inputs . ,inputs)
- (sources . ,sources)
+ ,@data-groups
(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)))
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index 5b5fe0a..d144736 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -487,27 +487,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 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
@@ -521,13 +517,12 @@
,@(append-map
(lambda (label items)
(map
- (match-lambda
- ((derivation outputs)
- `(tr
- (td ,label)
- (td (a (@ (href ,derivation))
- ,(display-store-item derivation)))
- (td ,outputs))))
+ (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 items '())))
(list base target)
(list (assq-ref inputs 'base)
@@ -545,12 +540,11 @@
,@(append-map
(lambda (label items)
(map
- (match-lambda
- ((file)
- `(tr
- (td ,label)
- (td (a (@ (href ,file))
- ,(display-store-item file))))))
+ (lambda (alist)
+ `(tr
+ (td ,label)
+ (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
