From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp2 ([2001:41d0:2:bcc0::]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id 2P1sIWFmeGC2EgAAgWs5BA (envelope-from ) for ; Thu, 15 Apr 2021 18:14:25 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp2 with LMTPS id gO4RG2FmeGC/NQAAB5/wlQ (envelope-from ) for ; Thu, 15 Apr 2021 16:14:25 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id E167C26182 for ; Thu, 15 Apr 2021 18:14:24 +0200 (CEST) Received: from localhost ([::1]:43646 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lX4dL-0002R1-Rd for larch@yhetil.org; Thu, 15 Apr 2021 12:14:23 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34712) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lX4ZP-00078K-HI for guix-devel@gnu.org; Thu, 15 Apr 2021 12:10:19 -0400 Received: from mout02.posteo.de ([185.67.36.66]:59853) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lX4ZK-0003F8-Ge for guix-devel@gnu.org; Thu, 15 Apr 2021 12:10:19 -0400 Received: from submission (posteo.de [89.146.220.130]) by mout02.posteo.de (Postfix) with ESMTPS id 70DDB240107 for ; Thu, 15 Apr 2021 18:10:10 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=posteo.net; s=2017; t=1618503010; bh=3iK67g7AMr9ON0bnOSlXUJKnoJvcYGBr3DJkqrV3XfM=; h=Date:From:To:Cc:Subject:From; b=A237ppeqVfNtWlC8DtiZm97dtwR83TqnAiWUqRgxwLydcQQ5XAs8UlwF9IUTilsaP zeeYuE99KF2vN8t3c+xfxRPZuxv//goceafb0oS4PaxDmvN8qLw8aWRmPyaHXDrurn FBdiEWkR9HuspxIdieEuo2QRGz1Ii6qdXtnrWO/p6NOm8iyKDQw9e+xxl7zdVmYFoF ad5dFxZYI3+IDvksFTPdPYhjLcM5N9RRF+z3eXlDlgpykfS2ra/2NV1/zsIwwdE6po 2Bb51ROo4PMdKMU3sWBRtCyW99MRofNhurADOCwDQ82Tw5PBnmU/6gAj+K/z/3E+PR /VTNCcvIAOvJA== Received: from customer (localhost [127.0.0.1]) by submission (posteo.de) with ESMTPSA id 4FLkng3x1rz9rxH; Thu, 15 Apr 2021 18:09:57 +0200 (CEST) Date: Thu, 15 Apr 2021 16:09:47 +0000 From: Luciana Lima Brito To: Christopher Baines Subject: Re: Outreachy - Guix Data Service: implementing basic json output for derivation comparison page Message-ID: <20210415130947.7387a546@lubrito> In-Reply-To: <87wnt4x7e3.fsf@cbaines.net> References: <20210414164859.7acc631f@lubrito> <87wnt4x7e3.fsf@cbaines.net> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="MP_/b7rv9EXu11Lssbp3g=B2NOC" Received-SPF: pass client-ip=185.67.36.66; envelope-from=lubrito@posteo.net; helo=mout02.posteo.de X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H4=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: guix-devel@gnu.org Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: "Guix-devel" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1618503265; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=gmKhhurto0v+YslZO2yKrxZYV0FyZcGO4ITKlUAqhiM=; b=K6jyywqLj1r6wG54yCWINKeA/oryc0ih9/5wyTmcTOTEXtkqCOaIpgQoWyQTfIUA1BUWyy 1N3uamVOWO20cYVS3PgtrWbSwpLUGg2CHl/9RGCsfp9GZ9FuogtncNGJM8ADalyKBNG6ov Kif9QmcJ9YOddk1SliG1CGAuvt+N8x/tAZpYMKg0sCi0DkOG2ez8nV1vxpMH5uSFH7hy6X JRAJmhz3R6o4vH2rvIAvu0WtwrFZA0MXoPxn/I6plyCdm+MlGoQWdZx86oyKJdW3/sdKP/ grMrfuicNtkqc17oMG95U0eZ0vukQQrUIfGgs93cplU5KQ9z+RMNT+ojLvqw5w== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1618503265; a=rsa-sha256; cv=none; b=QHpxrh7VERuRPfyq8CcPleQTJN/gFIN/ohcGmRT/P70ecKRsZR1PhAG5ARUi0XXYKmtto6 B5z/kXEiaf1F3HUWAbU9KPQpWdGpPs7uaq48HzoOdiGdlerL8IQkN/lM+G5iuEjt2dI/AI cwKafeqLmDRlpc7haOqyYhLUkmek4iXrh6sRXFgewf2SZzRBeUe3rS+mcEOYmoXBAuboPF TA+XYXl3ChW7C2MKrwmGBFUFhG1Y7HWAbOW6Vmmp22Yv1GaCfUDIeSBQtCAoK6vDfLI64Y f+1hgxCVj2J+no1dbigldpLEkTgXMEly1LCdyHkKqgU7bHNMvV8aFClI2BdAWg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=posteo.net header.s=2017 header.b=A237ppeq; dmarc=pass (policy=none) header.from=posteo.net; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Spam-Score: -2.64 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=posteo.net header.s=2017 header.b=A237ppeq; dmarc=pass (policy=none) header.from=posteo.net; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Queue-Id: E167C26182 X-Spam-Score: -2.64 X-Migadu-Scanner: scn0.migadu.com X-TUID: SyepuLNNOXVv --MP_/b7rv9EXu11Lssbp3g=B2NOC Content-Type: text/plain; charset=US-ASCII Content-Transfer-Encoding: 7bit Content-Disposition: inline On Thu, 15 Apr 2021 09:46:12 +0100 Christopher Baines 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 --MP_/b7rv9EXu11Lssbp3g=B2NOC Content-Type: text/x-patch Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename=controller-0415.patch >From c7af970c677a8d97cb4841a748e343c03e0bc886 Mon Sep 17 00:00:00 2001 From: Luciana Brito 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 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 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 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 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 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 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 --MP_/b7rv9EXu11Lssbp3g=B2NOC--