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 19:53:55 +0000 [thread overview]
Message-ID: <20210427165355.0abb1f77@lubrito> (raw)
In-Reply-To: <877dknfu2i.fsf@cbaines.net>
[-- Attachment #1: Type: text/plain, Size: 339 bytes --]
On Tue, 27 Apr 2021 19:42:13 +0100
Christopher Baines <mail@cbaines.net> wrote:
> I'd go with this approach, applying the comments I made about the
> match-lambda bit above in the email I sent a few minutes ago.
I applied all you instructed me. See if it looks better now.
--
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: 17796 bytes --]
From 93ef30e06d7e10fd3a140c6f2a729d40540b05a8 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: remove mapping for outputs/inputs/sources.
utils.scm: add group-to-alist/vector function.
---
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 e5e1955..46f5377 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 895bb40..8445185 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,82 +588,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 5b5fe0a..e1ff15c 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 (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
@@ -521,14 +517,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)))))))
@@ -545,13 +540,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)
@@ -615,8 +609,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
@@ -625,8 +619,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
--
2.30.2
next prev parent reply other threads:[~2021-04-27 19:54 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
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 [this message]
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=20210427165355.0abb1f77@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).