From: Luciana Lima Brito <lubrito@posteo.net>
To: Christopher Baines <mail@cbaines.net>
Cc: guix-devel@gnu.org
Subject: Re: Outreachy - Guix Data Service: implementing basic json output for derivation comparison page
Date: Thu, 15 Apr 2021 16:09:47 +0000 [thread overview]
Message-ID: <20210415130947.7387a546@lubrito> (raw)
In-Reply-To: <87wnt4x7e3.fsf@cbaines.net>
[-- Attachment #1: Type: text/plain, Size: 1517 bytes --]
On Thu, 15 Apr 2021 09:46:12 +0100
Christopher Baines <mail@cbaines.net> wrote:
Hi,
> I'm not quite sure how to apply this, I'd suggest using git
> format-patch to generate the file next time as I think there would
> normally be some metadata along with the diff.
I tried using git format-patch and I got 7 patches from my 7 commits,
then I generate a single patch output, which is attached.
The last commit before my modifications is this:
410f58cb43f083623885a430700c6818a187cadc
> I would consider whether it's useful to have all these let blocks, and
> whether here is the right place for them.
> Taking a binding like outputs, it's only used in a later let. You can
> do something like this (with let*) to remove the need to have
> multiple let blocks.
> Also, since matched-outputs is only used when rendering the JSON, I'd
> move all the bindings that are only used for the JSON output within
> that part of the case statement, so that it's clearer that they only
> apply to that bit of the code.
>
> Does that make sense?
I did it, I used the let* and this helped a lot. I also moved
everything into the case branch of the json.
> I'm not sure what revision here referrs to.
It was a placeholder, but now I removed it.
> I hope that helps, just let me know if you have any questions,
The function get-derivation-data does not depend on anything, don't you
think it goes better in another place outside render-compare/derivation?
--
Best Regards,
Luciana Lima Brito
MSc. in Computer Science
[-- Attachment #2: controller-0415.patch --]
[-- Type: text/x-patch, Size: 65186 bytes --]
From c7af970c677a8d97cb4841a748e343c03e0bc886 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Sun, 11 Apr 2021 11:06:06 -0300
Subject: [PATCH 1/7] Include base-derivation and target-derivation on json of
render-compare/derivation
---
guix-data-service/web/compare/controller.scm | 7 ++++++-
1 file changed, 6 insertions(+), 1 deletion(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index a6aa198..355ce03 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -589,7 +589,12 @@
mime-types)
((application/json)
(render-json
- '((error . "unimplemented")) ; TODO
+ `((revision
+ . ((base
+ . ((derivation . ,base-derivation)))
+ (target
+ . ((derivation . ,target-derivation))))))
+ ;'((error . "unimplemented")) ; TODO
#:extra-headers http-headers-for-unchanging-content))
(else
(render-html
--
2.30.2
From d91856c6b4a0e998288b2291f9a9f420f9916dc4 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Mon, 12 Apr 2021 11:05:20 -0300
Subject: [PATCH 2/7] Include base and target outputs to json of
render-compare/derivation
---
guix-data-service/web/compare/controller.scm | 127 ++++++++++++++++---
1 file changed, 109 insertions(+), 18 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 355ce03..2f54310 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -584,24 +584,115 @@
(derivation-differences-data conn
base-derivation
target-derivation)))))
- (case (most-appropriate-mime-type
- '(application/json text/html)
- mime-types)
- ((application/json)
- (render-json
- `((revision
- . ((base
- . ((derivation . ,base-derivation)))
- (target
- . ((derivation . ,target-derivation))))))
- ;'((error . "unimplemented")) ; TODO
- #:extra-headers http-headers-for-unchanging-content))
- (else
- (render-html
- #:sxml (compare/derivation
- query-parameters
- data)
- #:extra-headers http-headers-for-unchanging-content)))))))
+
+ (let ((outputs (assq-ref data 'outputs))
+ (inputs (assq-ref data 'inputs))
+ (sources (assq-ref data 'sources))
+ (system (assq-ref data 'system))
+ (build-and-args (assq-ref data 'build-and-args))
+ (envronment-and-variables (assq-ref data 'envronment-and-variables))
+ )
+ (let ((base-outputs (assq-ref outputs 'base))
+ (target-outputs (assq-ref outputs 'target))
+
+ (base-inputs (assq-ref inputs 'base))
+ (target-inputs (assq-ref inputs 'target))
+
+ (base-sources (assq-ref sources 'base))
+ (target-sources (assq-ref sources 'target))
+
+ (base-system (assq-ref system 'base))
+ (target-system (assq-ref system 'target))
+
+ (base-build-and-args (assq-ref build-and-args 'base))
+ (target-build-and-args (assq-ref build-and-args 'target))
+
+ (base-environment-and-variables (assq-ref envronment-and-variables 'base))
+ (target-environment-and-variables (assq-ref envronment-and-variables 'target))
+
+ )
+
+ ;(let-values
+ ; (((base-derivation-output target-derivation-output)
+ ; (assq-ref data 'outputs)))
+ ; (let ((derivation-changes
+ ; (package-derivation-data-changes names-and-versions
+ ; base-packages-vhash
+ ; target-packages-vhash)))
+
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ `((revision
+ . ((base
+ . ((derivation . ,base-derivation)))
+ (target
+ . ((derivation . ,target-derivation)))))
+ (outputs . ((base . ,(list->vector
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (null? hash-alg)
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (null? hash)
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,recursive))
+ )
+ ;(change . ,change)
+ )))
+ base-outputs)))
+
+ (target . ,(list->vector
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (null? hash-alg)
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (null? hash)
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,recursive))
+ )
+ ;(change . ,change)
+ )))
+ target-outputs))))
+
+ )
+ )
+ #:extra-headers http-headers-for-unchanging-content))
+ (else
+ (render-html
+ #:sxml (compare/derivation
+ query-parameters
+ data)
+ #:extra-headers http-headers-for-unchanging-content)))))))))
(define (render-compare/package-derivations mime-types
query-parameters)
--
2.30.2
From 3810e457e75a24ae1c1582a35956c6bc9e37c614 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Mon, 12 Apr 2021 15:52:17 -0300
Subject: [PATCH 3/7] Include base and target outputs to json in same anonymous
function of render-compare/derivation
---
guix-data-service/web/compare/controller.scm | 84 +++++++-------------
1 file changed, 30 insertions(+), 54 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 2f54310..7fa2fc0 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -630,62 +630,38 @@
. ((derivation . ,base-derivation)))
(target
. ((derivation . ,target-derivation)))))
- (outputs . ((base . ,(list->vector
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (null? hash-alg)
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (null? hash)
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,recursive))
- )
+ (outputs . ,(list->vector
+ (append-map
+ (lambda (items)
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (null? hash-alg)
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (null? hash)
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,recursive))
+ )
;(change . ,change)
- )))
- base-outputs)))
+ )))
+ (or items '())))
- (target . ,(list->vector
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (null? hash-alg)
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (null? hash)
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,recursive))
- )
- ;(change . ,change)
- )))
- target-outputs))))
-
- )
- )
+ (list base-outputs
+ target-outputs))))
+ );revision
#:extra-headers http-headers-for-unchanging-content))
(else
(render-html
--
2.30.2
From aa5292177bbe70564306cebdebff417754b807b6 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Wed, 14 Apr 2021 14:04:21 -0300
Subject: [PATCH 4/7] Fix rendering for outputs on json from
render-compare/derivation
---
guix-data-service/web/compare/controller.scm | 231 +++++++++++++------
1 file changed, 165 insertions(+), 66 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 7fa2fc0..dcb0175 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -589,86 +589,185 @@
(inputs (assq-ref data 'inputs))
(sources (assq-ref data 'sources))
(system (assq-ref data 'system))
- (build-and-args (assq-ref data 'build-and-args))
- (envronment-and-variables (assq-ref data 'envronment-and-variables))
+ (builder (assq-ref data 'builder))
+ (args (assq-ref data 'arguments))
+ (environment-variables (assq-ref data 'environment-variables))
)
- (let ((base-outputs (assq-ref outputs 'base))
- (target-outputs (assq-ref outputs 'target))
-
+
+ (let (;(base-outputs (assq-ref outputs 'base))
+ ;(target-outputs (assq-ref outputs 'target))
+ ;(common-outputs (assq-ref outputs 'common))
+
+ (matched-outputs (append-map
+ (lambda (items)
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (or (null? hash-alg) (not (string? hash-alg)))
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (or (null? hash) (not (string? hash)))
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,(string=? recursive "t")))))
+ ))
+ (or items '())))
+ (list (assq-ref outputs 'base)
+ (assq-ref outputs 'target)
+ (assq-ref outputs 'common))))
+
(base-inputs (assq-ref inputs 'base))
(target-inputs (assq-ref inputs 'target))
(base-sources (assq-ref sources 'base))
(target-sources (assq-ref sources 'target))
+ (common-sources (assq-ref sources 'common))
(base-system (assq-ref system 'base))
(target-system (assq-ref system 'target))
+ (common-system (assq-ref system 'common))
- (base-build-and-args (assq-ref build-and-args 'base))
- (target-build-and-args (assq-ref build-and-args 'target))
+ (base-builder (assq-ref builder 'base))
+ (target-builder (assq-ref builder 'target))
+ (common-builder (assq-ref builder 'common))
- (base-environment-and-variables (assq-ref envronment-and-variables 'base))
- (target-environment-and-variables (assq-ref envronment-and-variables 'target))
-
+ (base-args (assq-ref args 'base))
+ (target-args (assq-ref args 'target))
+ (common-args (assq-ref args 'common))
)
- ;(let-values
- ; (((base-derivation-output target-derivation-output)
- ; (assq-ref data 'outputs)))
- ; (let ((derivation-changes
- ; (package-derivation-data-changes names-and-versions
- ; base-packages-vhash
- ; target-packages-vhash)))
-
- (case (most-appropriate-mime-type
- '(application/json text/html)
- mime-types)
- ((application/json)
- (render-json
- `((revision
- . ((base
- . ((derivation . ,base-derivation)))
- (target
- . ((derivation . ,target-derivation)))))
- (outputs . ,(list->vector
- (append-map
- (lambda (items)
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (null? hash-alg)
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (null? hash)
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,recursive))
- )
- ;(change . ,change)
- )))
- (or items '())))
+ (match environment-variables
+ ((name . values)
+ (let ((environment-variables-name name)
+ (common-environment-variables (assq-ref values 'common))
+ (base-environment-variables (assq-ref values 'base))
+ (target-environment-variables (assq-ref values 'target))
+ )
+
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ `((revision
+ . ((base
+ . ((derivation . ,base-derivation)))
+ (target
+ . ((derivation . ,target-derivation)))))
+ ;(outputs . ,(list->vector
+ ; (append-map
+ ; (lambda (items)
+ ; (map
+ ; (match-lambda
+ ; ((name path hash-alg hash recursive)
+ ; `(,@(if (null? name)
+ ; '()
+ ; `((name . ,name)))
+ ; ,@(if (null? path)
+ ; '()
+ ; `((path . ,path))
+ ; )
+ ; ,@(if (or (null? hash-alg) (not (string? hash-alg)))
+ ; '()
+ ; `((hash-algorithm . ,hash-alg))
+ ; )
+ ; ,@(if (or (null? hash) (not (string? hash)))
+ ; '()
+ ; `((hash . ,hash))
+ ; )
+ ; ,@(if (null? recursive)
+ ; '()
+ ;if there is other representation for "true"
+ ;this parse won't work
+ ; `((recursive . ,(string=? recursive "t")))
+ ; )
+ ; )))
+ ; (or items '()))
+ ; );inner lambda
- (list base-outputs
- target-outputs))))
- );revision
- #:extra-headers http-headers-for-unchanging-content))
- (else
- (render-html
- #:sxml (compare/derivation
- query-parameters
- data)
- #:extra-headers http-headers-for-unchanging-content)))))))))
+ ; (list base-outputs
+ ; target-outputs
+ ; common-outputs))))
+
+ (output
+ . ,((lambda (x) (cond
+ ((= (length x) 3) `((base . ,(first x))
+ (target . ,(second x))
+ (common . ,(third x))))
+ ((= (length x) 2) `((base . ,(first x))
+ (target . ,(second x))))
+ (else `((common . ,(first x))))))
+
+ matched-outputs))
+
+ (inputs . ,(list->vector
+ (append-map
+ (lambda (items)
+ (map
+ (match-lambda
+ ((derivation output)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation)))
+ ,@(if (null? output)
+ '()
+ `((output . ,output))))))
+ (or items '())))
+ (list base-inputs
+ target-inputs)
+ )))
+
+ (source
+ . ((base . ,base-sources)))
+
+; (sources . ,(list->vector
+; (append-map
+; (lambda (items)
+; (map
+; (match-lambda
+; ((derivation)
+; `(,@(if (null? derivation)
+; '()
+; `((derivation . ,derivation))))))
+; (or items '())))
+; (list base-sources
+; target-sources
+; common-sources)))
+; )
+
+ (system
+ . ((common . ,common-system)))
+
+ (builder-and-arguments
+ . ((builder . ,common-builder)
+ (arguments
+ . ((base . ,(list->vector
+ base-args))
+ (target . ,(list->vector
+ target-args))))))
+
+ (environment-variables . ,environment-variables)
+
+
+ );revision
+ #:extra-headers http-headers-for-unchanging-content))
+ (else
+ (render-html
+ #:sxml (compare/derivation
+ query-parameters
+ data)
+ #:extra-headers http-headers-for-unchanging-content))))))))))))
(define (render-compare/package-derivations mime-types
query-parameters)
--
2.30.2
From b61825ca583b1a3d598575f12aa8c6e279ca60ad Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Wed, 14 Apr 2021 15:37:19 -0300
Subject: [PATCH 5/7] Fix rendering for sources on json from
remder-compare/derivation
---
guix-data-service/web/compare/controller.scm | 169 +++++++------------
1 file changed, 61 insertions(+), 108 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index dcb0175..bfec00c 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -594,46 +594,46 @@
(environment-variables (assq-ref data 'environment-variables))
)
- (let (;(base-outputs (assq-ref outputs 'base))
- ;(target-outputs (assq-ref outputs 'target))
- ;(common-outputs (assq-ref outputs 'common))
-
- (matched-outputs (append-map
- (lambda (items)
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (or (null? hash-alg) (not (string? hash-alg)))
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (or (null? hash) (not (string? hash)))
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,(string=? recursive "t")))))
- ))
- (or items '())))
- (list (assq-ref outputs 'base)
- (assq-ref outputs 'target)
- (assq-ref outputs 'common))))
+ (let ((get-derivation-data
+ (lambda (items)
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (or (null? hash-alg) (not (string? hash-alg)))
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (or (null? hash) (not (string? hash)))
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,(string=? recursive "t"))))))
+ ((derivation output)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation)))
+ ,@(if (null? output)
+ '()
+ `((output . ,output)))))
+ ((derivation)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation)))
+ ))
+ )
+ (or items '())
+ ))
+ )
- (base-inputs (assq-ref inputs 'base))
- (target-inputs (assq-ref inputs 'target))
-
- (base-sources (assq-ref sources 'base))
- (target-sources (assq-ref sources 'target))
- (common-sources (assq-ref sources 'common))
-
(base-system (assq-ref system 'base))
(target-system (assq-ref system 'target))
(common-system (assq-ref system 'common))
@@ -647,6 +647,19 @@
(common-args (assq-ref args 'common))
)
+ (let ((matched-outputs (append-map get-derivation-data
+ (list (assq-ref outputs 'base)
+ (assq-ref outputs 'target)
+ (assq-ref outputs 'common))))
+ (matched-inputs (append-map get-derivation-data
+ (list (assq-ref inputs 'base)
+ (assq-ref inputs 'target))))
+ (matched-sources (append-map get-derivation-data
+ (list (assq-ref sources 'base)
+ (assq-ref sources 'target)
+ (assq-ref sources 'common))))
+ )
+
(match environment-variables
((name . values)
(let ((environment-variables-name name)
@@ -665,42 +678,7 @@
. ((derivation . ,base-derivation)))
(target
. ((derivation . ,target-derivation)))))
- ;(outputs . ,(list->vector
- ; (append-map
- ; (lambda (items)
- ; (map
- ; (match-lambda
- ; ((name path hash-alg hash recursive)
- ; `(,@(if (null? name)
- ; '()
- ; `((name . ,name)))
- ; ,@(if (null? path)
- ; '()
- ; `((path . ,path))
- ; )
- ; ,@(if (or (null? hash-alg) (not (string? hash-alg)))
- ; '()
- ; `((hash-algorithm . ,hash-alg))
- ; )
- ; ,@(if (or (null? hash) (not (string? hash)))
- ; '()
- ; `((hash . ,hash))
- ; )
- ; ,@(if (null? recursive)
- ; '()
- ;if there is other representation for "true"
- ;this parse won't work
- ; `((recursive . ,(string=? recursive "t")))
- ; )
- ; )))
- ; (or items '()))
- ; );inner lambda
-
- ; (list base-outputs
- ; target-outputs
- ; common-outputs))))
-
- (output
+ (outputs
. ,((lambda (x) (cond
((= (length x) 3) `((base . ,(first x))
(target . ,(second x))
@@ -711,41 +689,16 @@
matched-outputs))
- (inputs . ,(list->vector
- (append-map
- (lambda (items)
- (map
- (match-lambda
- ((derivation output)
- `(,@(if (null? derivation)
- '()
- `((derivation . ,derivation)))
- ,@(if (null? output)
- '()
- `((output . ,output))))))
- (or items '())))
- (list base-inputs
- target-inputs)
- )))
+ (inputs
+ . ((base . ,(first matched-inputs))
+ (target . ,(second matched-inputs))
+ ))
(source
- . ((base . ,base-sources)))
+ . ((base . ,(first matched-sources))
+ (target . ,(second matched-sources))
+ (common . ,(third matched-sources))))
-; (sources . ,(list->vector
-; (append-map
-; (lambda (items)
-; (map
-; (match-lambda
-; ((derivation)
-; `(,@(if (null? derivation)
-; '()
-; `((derivation . ,derivation))))))
-; (or items '())))
-; (list base-sources
-; target-sources
-; common-sources)))
-; )
-
(system
. ((common . ,common-system)))
@@ -767,7 +720,7 @@
#:sxml (compare/derivation
query-parameters
data)
- #:extra-headers http-headers-for-unchanging-content))))))))))))
+ #:extra-headers http-headers-for-unchanging-content)))))))))))))
(define (render-compare/package-derivations mime-types
query-parameters)
--
2.30.2
From 2c8d95aea7ef3f2950bbb125c995e009f61edf12 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Wed, 14 Apr 2021 16:28:43 -0300
Subject: [PATCH 6/7] Generate a complete json output for
render-compare/derivation procedure for the derivation comparison page.
---
guix-data-service/web/compare/controller.scm | 202 ++++++++-----------
1 file changed, 87 insertions(+), 115 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index bfec00c..b7788cb 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -584,57 +584,50 @@
(derivation-differences-data conn
base-derivation
target-derivation)))))
-
(let ((outputs (assq-ref data 'outputs))
- (inputs (assq-ref data 'inputs))
+ (inputs (assq-ref data 'inputs))
(sources (assq-ref data 'sources))
- (system (assq-ref data 'system))
+ (system (assq-ref data 'system))
(builder (assq-ref data 'builder))
- (args (assq-ref data 'arguments))
+ (args (assq-ref data 'arguments))
(environment-variables (assq-ref data 'environment-variables))
- )
-
- (let ((get-derivation-data
- (lambda (items)
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (or (null? hash-alg) (not (string? hash-alg)))
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (or (null? hash) (not (string? hash)))
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,(string=? recursive "t"))))))
- ((derivation output)
- `(,@(if (null? derivation)
- '()
- `((derivation . ,derivation)))
- ,@(if (null? output)
- '()
- `((output . ,output)))))
- ((derivation)
- `(,@(if (null? derivation)
- '()
- `((derivation . ,derivation)))
- ))
- )
- (or items '())
- ))
- )
-
- (base-system (assq-ref system 'base))
+ (get-derivation-data
+ (lambda (items)
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (or (null? hash-alg) (not (string? hash-alg)))
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (or (null? hash) (not (string? hash)))
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,(string=? recursive "t"))))))
+ ((derivation output)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation)))
+ ,@(if (null? output)
+ '()
+ `((output . ,output)))))
+ ((derivation)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation))))))
+ (or items '())))))
+
+ (let ((base-system (assq-ref system 'base))
(target-system (assq-ref system 'target))
(common-system (assq-ref system 'common))
@@ -644,8 +637,7 @@
(base-args (assq-ref args 'base))
(target-args (assq-ref args 'target))
- (common-args (assq-ref args 'common))
- )
+ (common-args (assq-ref args 'common)))
(let ((matched-outputs (append-map get-derivation-data
(list (assq-ref outputs 'base)
@@ -655,72 +647,52 @@
(list (assq-ref inputs 'base)
(assq-ref inputs 'target))))
(matched-sources (append-map get-derivation-data
- (list (assq-ref sources 'base)
- (assq-ref sources 'target)
- (assq-ref sources 'common))))
- )
-
- (match environment-variables
- ((name . values)
- (let ((environment-variables-name name)
- (common-environment-variables (assq-ref values 'common))
- (base-environment-variables (assq-ref values 'base))
- (target-environment-variables (assq-ref values 'target))
- )
-
- (case (most-appropriate-mime-type
- '(application/json text/html)
- mime-types)
- ((application/json)
- (render-json
- `((revision
- . ((base
- . ((derivation . ,base-derivation)))
- (target
- . ((derivation . ,target-derivation)))))
- (outputs
- . ,((lambda (x) (cond
- ((= (length x) 3) `((base . ,(first x))
- (target . ,(second x))
- (common . ,(third x))))
- ((= (length x) 2) `((base . ,(first x))
- (target . ,(second x))))
- (else `((common . ,(first x))))))
-
- matched-outputs))
-
- (inputs
- . ((base . ,(first matched-inputs))
- (target . ,(second matched-inputs))
- ))
-
- (source
- . ((base . ,(first matched-sources))
- (target . ,(second matched-sources))
- (common . ,(third matched-sources))))
-
- (system
- . ((common . ,common-system)))
-
- (builder-and-arguments
- . ((builder . ,common-builder)
- (arguments
- . ((base . ,(list->vector
- base-args))
- (target . ,(list->vector
- target-args))))))
-
- (environment-variables . ,environment-variables)
-
-
- );revision
- #:extra-headers http-headers-for-unchanging-content))
- (else
- (render-html
- #:sxml (compare/derivation
- query-parameters
- data)
- #:extra-headers http-headers-for-unchanging-content)))))))))))))
+ (list (assq-ref sources 'base)
+ (assq-ref sources 'target)
+ (assq-ref sources 'common)))))
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (render-json
+ `((revision
+ . ((base
+ . ((derivation . ,base-derivation)))
+ (target
+ . ((derivation . ,target-derivation)))))
+ (outputs
+ . ,((lambda (l) (cond
+ ((= (length l) 3) `((base . ,(first l))
+ (target . ,(second l))
+ (common . ,(third l))))
+ ((= (length l) 2) `((base . ,(first l))
+ (target . ,(second l))))
+ (else `((common . ,(first l))))))
+ matched-outputs))
+ (inputs
+ . ((base . ,(first matched-inputs))
+ (target . ,(second matched-inputs))))
+ (source
+ . ((base . ,(first matched-sources))
+ (target . ,(second matched-sources))
+ (common . ,(third matched-sources))))
+ (system
+ . ((common . ,common-system)))
+ (builder-and-arguments
+ . ((builder . ,common-builder)
+ (arguments
+ . ((base . ,(list->vector
+ base-args))
+ (target . ,(list->vector
+ target-args))))))
+ (environment-variables . ,environment-variables))
+ #:extra-headers http-headers-for-unchanging-content))
+ (else
+ (render-html
+ #:sxml (compare/derivation
+ query-parameters
+ data)
+ #:extra-headers http-headers-for-unchanging-content))))))))))
(define (render-compare/package-derivations mime-types
query-parameters)
--
2.30.2
From e8d99e4a422dc9ee01625e5a3206768ba09a2d54 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Thu, 15 Apr 2021 12:47:46 -0300
Subject: [PATCH 7/7] Improve json output for render-data/derivation
---
guix-data-service/web/compare/controller.scm | 213 +++++++++----------
1 file changed, 103 insertions(+), 110 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index b7788cb..882652a 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -583,116 +583,109 @@
(lambda (conn)
(derivation-differences-data conn
base-derivation
- target-derivation)))))
- (let ((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))
- (args (assq-ref data 'arguments))
- (environment-variables (assq-ref data 'environment-variables))
- (get-derivation-data
- (lambda (items)
- (map
- (match-lambda
- ((name path hash-alg hash recursive)
- `(,@(if (null? name)
- '()
- `((name . ,name)))
- ,@(if (null? path)
- '()
- `((path . ,path))
- )
- ,@(if (or (null? hash-alg) (not (string? hash-alg)))
- '()
- `((hash-algorithm . ,hash-alg))
- )
- ,@(if (or (null? hash) (not (string? hash)))
- '()
- `((hash . ,hash))
- )
- ,@(if (null? recursive)
- '()
- `((recursive . ,(string=? recursive "t"))))))
- ((derivation output)
- `(,@(if (null? derivation)
- '()
- `((derivation . ,derivation)))
- ,@(if (null? output)
- '()
- `((output . ,output)))))
- ((derivation)
- `(,@(if (null? derivation)
- '()
- `((derivation . ,derivation))))))
- (or items '())))))
-
- (let ((base-system (assq-ref system 'base))
- (target-system (assq-ref system 'target))
- (common-system (assq-ref system 'common))
-
- (base-builder (assq-ref builder 'base))
- (target-builder (assq-ref builder 'target))
- (common-builder (assq-ref builder 'common))
-
- (base-args (assq-ref args 'base))
- (target-args (assq-ref args 'target))
- (common-args (assq-ref args 'common)))
-
- (let ((matched-outputs (append-map get-derivation-data
- (list (assq-ref outputs 'base)
- (assq-ref outputs 'target)
- (assq-ref outputs 'common))))
- (matched-inputs (append-map get-derivation-data
- (list (assq-ref inputs 'base)
- (assq-ref inputs 'target))))
- (matched-sources (append-map get-derivation-data
- (list (assq-ref sources 'base)
- (assq-ref sources 'target)
- (assq-ref sources 'common)))))
- (case (most-appropriate-mime-type
- '(application/json text/html)
- mime-types)
- ((application/json)
- (render-json
- `((revision
- . ((base
- . ((derivation . ,base-derivation)))
- (target
- . ((derivation . ,target-derivation)))))
- (outputs
- . ,((lambda (l) (cond
- ((= (length l) 3) `((base . ,(first l))
- (target . ,(second l))
- (common . ,(third l))))
- ((= (length l) 2) `((base . ,(first l))
- (target . ,(second l))))
- (else `((common . ,(first l))))))
- matched-outputs))
- (inputs
- . ((base . ,(first matched-inputs))
- (target . ,(second matched-inputs))))
- (source
- . ((base . ,(first matched-sources))
- (target . ,(second matched-sources))
- (common . ,(third matched-sources))))
- (system
- . ((common . ,common-system)))
- (builder-and-arguments
- . ((builder . ,common-builder)
- (arguments
- . ((base . ,(list->vector
- base-args))
- (target . ,(list->vector
- target-args))))))
- (environment-variables . ,environment-variables))
- #:extra-headers http-headers-for-unchanging-content))
- (else
- (render-html
- #:sxml (compare/derivation
- query-parameters
- data)
- #:extra-headers http-headers-for-unchanging-content))))))))))
+ target-derivation))))
+ (get-derivation-data
+ (lambda (items)
+ (map
+ (match-lambda
+ ((name path hash-alg hash recursive)
+ `(,@(if (null? name)
+ '()
+ `((name . ,name)))
+ ,@(if (null? path)
+ '()
+ `((path . ,path))
+ )
+ ,@(if (or (null? hash-alg) (not (string? hash-alg)))
+ '()
+ `((hash-algorithm . ,hash-alg))
+ )
+ ,@(if (or (null? hash) (not (string? hash)))
+ '()
+ `((hash . ,hash))
+ )
+ ,@(if (null? recursive)
+ '()
+ `((recursive . ,(string=? recursive "t"))))))
+ ((derivation output)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation)))
+ ,@(if (null? output)
+ '()
+ `((output . ,output)))))
+ ((derivation)
+ `(,@(if (null? derivation)
+ '()
+ `((derivation . ,derivation))))))
+ (or items '())))))
+
+ (case (most-appropriate-mime-type
+ '(application/json text/html)
+ mime-types)
+ ((application/json)
+ (let* ((outputs (assq-ref data 'outputs))
+ (base-outputs (append-map get-derivation-data (list (assq-ref outputs 'base))))
+ (target-outputs (append-map get-derivation-data (list (assq-ref outputs 'target))))
+ (common-outputs (append-map get-derivation-data (list (assq-ref outputs 'common))))
+
+ (inputs (assq-ref data 'inputs))
+ (base-inputs (append-map get-derivation-data (list (assq-ref inputs 'base))))
+ (target-inputs (append-map get-derivation-data (list (assq-ref inputs 'target))))
+
+ (sources (assq-ref data 'sources))
+ (base-sources (append-map get-derivation-data (list (assq-ref sources 'base))))
+ (target-sources (append-map get-derivation-data (list (assq-ref sources 'target))))
+ (common-sources (append-map get-derivation-data (list (assq-ref sources 'common))))
+
+ (system (assq-ref data 'system))
+ (base-system (assq-ref system 'base))
+ (target-system (assq-ref system 'target))
+ (common-system (assq-ref system 'common))
+
+ (builder (assq-ref data 'builder))
+ (base-builder (assq-ref builder 'base))
+ (target-builder (assq-ref builder 'target))
+ (common-builder (assq-ref builder 'common))
+
+ (args (assq-ref data 'arguments))
+ (base-args (assq-ref args 'base))
+ (target-args (assq-ref args 'target))
+ (common-args (assq-ref args 'common))
+ (environment-variables (assq-ref data 'environment-variables)))
+ (render-json
+ `((base
+ . ((derivation . ,base-derivation)))
+ (target
+ . ((derivation . ,target-derivation)))
+ (outputs
+ . ((base . ,(list->vector base-outputs))
+ (target . ,(list->vector target-outputs))
+ (common . ,(list->vector common-outputs))))
+ (inputs
+ . ((base . ,(list->vector base-inputs))
+ (target . ,(list->vector target-inputs))))
+ (sources
+ . ((base . ,(list->vector base-sources))
+ (target . ,(list->vector target-sources))
+ (common . ,(list->vector common-sources))))
+ (system
+ . ((common . ,common-system)))
+ (builder-and-arguments
+ . ((builder . ,common-builder)
+ (arguments
+ . ((base . ,(list->vector
+ base-args))
+ (target . ,(list->vector
+ target-args))))))
+ (environment-variables . ,environment-variables))
+ #:extra-headers http-headers-for-unchanging-content)))
+ (else
+ (render-html
+ #:sxml (compare/derivation
+ query-parameters
+ data)
+ #:extra-headers http-headers-for-unchanging-content)))))))
(define (render-compare/package-derivations mime-types
query-parameters)
--
2.30.2
next prev parent reply other threads:[~2021-04-15 16:14 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-14 19:48 Outreachy - Guix Data Service: implementing basic json output for derivation comparison page Luciana Lima Brito
2021-04-15 8:46 ` Christopher Baines
2021-04-15 16:09 ` Luciana Lima Brito [this message]
2021-04-15 23:19 ` Christopher Baines
2021-04-16 15:07 ` Luciana Lima Brito
2021-04-16 15:47 ` Christopher Baines
2021-04-16 18:46 ` Luciana Lima Brito
2021-04-16 19:17 ` Christopher Baines
2021-04-16 22:47 ` Luciana Lima Brito
2021-04-17 8:40 ` Christopher Baines
2021-04-17 12:48 ` Luciana Lima Brito
2021-04-17 13:11 ` Christopher Baines
2021-04-17 14:08 ` Luciana Lima Brito
2021-04-17 17:45 ` Christopher Baines
2021-04-18 13:12 ` Luciana Lima Brito
2021-04-18 13:19 ` Luciana Lima Brito
2021-04-18 16:34 ` Christopher Baines
2021-04-18 19:12 ` Luciana Lima Brito
2021-04-19 8:26 ` Christopher Baines
2021-04-19 14:04 ` Luciana Lima Brito
2021-04-19 20:20 ` Christopher Baines
2021-04-19 20:56 ` Luciana Lima Brito
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210415130947.7387a546@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 external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.