From: Luciana Lima Brito <lubrito@posteo.net>
To: Christopher Baines <mail@cbaines.net>
Cc: guix-devel@gnu.org
Subject: Re: Outreachy - Guix Data Service: questions about improving the data for derivation comparisons.
Date: Tue, 27 Apr 2021 13:10:01 +0000 [thread overview]
Message-ID: <20210427101001.0242f90e@lubrito> (raw)
In-Reply-To: <87im48g2s1.fsf@cbaines.net>
[-- Attachment #1: Type: text/plain, Size: 1674 bytes --]
On Mon, 26 Apr 2021 22:21:50 +0100
Christopher Baines <mail@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
[-- Attachment #2: 0001-Change-handling-of-queried-data-for-derivations-comp.patch --]
[-- Type: text/x-patch, Size: 13694 bytes --]
From 03a70ac2e07f2eec35a9473d8930a9cbefa50b92 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@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
next prev parent reply other threads:[~2021-04-27 13:11 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-21 18:29 Outreachy - Guix Data Service: questions about improving the data for derivation comparisons Luciana Lima Brito
2021-04-22 7:53 ` Christopher Baines
2021-04-22 20:00 ` Luciana Lima Brito
2021-04-22 20:08 ` Christopher Baines
2021-04-22 21:02 ` Luciana Lima Brito
2021-04-22 21:15 ` Christopher Baines
2021-04-23 21:15 ` Luciana Lima Brito
2021-04-23 21:48 ` Christopher Baines
2021-04-25 20:15 ` Luciana Lima Brito
2021-04-26 8:15 ` Christopher Baines
2021-04-26 19:11 ` Luciana Lima Brito
2021-04-26 21:21 ` Christopher Baines
2021-04-27 13:10 ` Luciana Lima Brito [this message]
2021-04-27 18:23 ` Christopher Baines
2021-04-27 18:33 ` Luciana Lima Brito
2021-04-27 18:42 ` Christopher Baines
2021-04-27 19:53 ` Luciana Lima Brito
2021-04-27 20:29 ` Christopher Baines
2021-04-27 22:35 ` Luciana Lima Brito
2021-04-28 7:56 ` Christopher Baines
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210427101001.0242f90e@lubrito \
--to=lubrito@posteo.net \
--cc=guix-devel@gnu.org \
--cc=mail@cbaines.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).