Hi
Your advices helped me think more clearly.
There was no need to create or modify structures other than what I was
already changing. I now return an alist instead of a list on the
derivation-differences-* functions on comparison.scm (for outputs,
inputs and sources). It helped to simplify the mapping on
controller.scm. The changes on html.scm were minimal, basically it is
matching on pairs, instead of single values.
Two questions:
1 - The match on the html expects 5 values for "outputs", so I had to
settle on using empty objects on the JSON, when needed, else it would
break the match on the html. Is it ok?
2 - Now on controller.scm "outputs", "inputs", "sources", and even
"arguments" have the same structure, which is an alist of the form:
((base . (...))
(target . (...))
(common . (...)))
and I'm using the same map and match-lambda code to process them,
wouldn't it be reasonable now to make it a local function?
I'm sending the patch. I'll be waiting your reviews.
--
Best Regards,
Luciana Lima Brito
MSc. in Computer Science
>From d605d519a684b1be57ebd09cdf697bcdba017da1 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: match on pairs, instead of single values.
controller.scm: simplify mapping on outputs/inputs/sources.
---
guix-data-service/comparison.scm | 68 +++++++++++---------
guix-data-service/web/compare/controller.scm | 62 ++++--------------
guix-data-service/web/compare/html.scm | 43 ++++++-------
3 files changed, 69 insertions(+), 104 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..9ef8e5b 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -590,60 +590,24 @@
((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)))))
+ (match-lambda
+ ((label values ...)
+ `(,label . ,(list->vector values))))
+ (assq-ref data 'outputs)))
(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)))))
+ (match-lambda
+ ((label values ...)
+ `(,label . ,(list->vector values))))
+ (assq-ref data 'inputs)))
(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)))))
+ (match-lambda
+ ((label values ...)
+ `(,label . ,(list->vector values))))
+ (assq-ref data 'sources)))
(arguments
(map
@@ -651,7 +615,7 @@
((label args ...)
`(,label . ,(list->vector args))))
(assq-ref data 'arguments))))
-
+
(render-json
`((base . ((derivation . ,base-derivation)))
(target . ((derivation . ,target-derivation)))
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index 5b5fe0a..30cc499 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
+ (((_ . name) (_ . path) (_ . hash-alg) (_ . hash) (_ . recursive))
+ `(tr
+ (td ,label)
+ (td ,name)
+ (td (a (@ (href ,path))
+ ,(display-store-item path)))
+ (td ,hash-alg)
+ (td ,hash)
+ (td ,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,7 +519,7 @@
(lambda (label items)
(map
(match-lambda
- ((derivation outputs)
+ (((_ . derivation) (_ . outputs))
`(tr
(td ,label)
(td (a (@ (href ,derivation))
@@ -546,7 +543,7 @@
(lambda (label items)
(map
(match-lambda
- ((file)
+ (((_ . file))
`(tr
(td ,label)
(td (a (@ (href ,file))
--
2.30.2
