unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
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: Sat, 17 Apr 2021 12:48:57 +0000	[thread overview]
Message-ID: <20210417094857.14599c72@lubrito> (raw)
In-Reply-To: <877dl1xq15.fsf@cbaines.net>

[-- Attachment #1: Type: text/plain, Size: 773 bytes --]

On Sat, 17 Apr 2021 09:40:22 +0100
Christopher Baines <mail@cbaines.net> wrote:

> I think you're getting there, but it looks like you're close to what
> you want with matched-outputs say, and then later you pick bits out
> of that alist, generate vectors from the lists, and then rebuild the
> alist. I think you can remove all that complexity by just tweaking
> what you're doing up when you generate matched-outputs. I think this
> is true for matched-outputs, matched-inputs and matched-sources.

It's beautiful!
Now I could understand better the alist, and things make much more
sense to me. I simplified this part of getting properly the values from
matched-outputs, matched-inputs and matched-sources.

-- 
Best Regards,

Luciana Lima Brito
MSc. in Computer Science

[-- Attachment #2: 0001-Implement-basic-json-output-for-the-derivation-compa.patch --]
[-- Type: text/x-patch, Size: 6782 bytes --]

From 8d91269ead953c7d087242fbce5857af89af3025 Mon Sep 17 00:00:00 2001
From: Luciana Brito <lubrito@posteo.net>
Date: Sun, 11 Apr 2021 11:06:06 -0300
Subject: [PATCH] Implement basic json output for the derivation comparison
 page

---
 guix-data-service/web/compare/controller.scm | 114 ++++++++++++++++++-
 1 file changed, 111 insertions(+), 3 deletions(-)

diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index a6aa198..d05c177 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -588,9 +588,117 @@
                  '(application/json text/html)
                  mime-types)
             ((application/json)
-             (render-json
-              '((error . "unimplemented")) ; TODO
-              #:extra-headers http-headers-for-unchanging-content))
+             (let* ((outputs (assq-ref data 'outputs))
+                    (matched-outputs
+                     (map
+                      (lambda (label items)
+                        (cons label
+                              (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 '()))))
+                      '(base target common)
+                      (list (assq-ref outputs 'base)
+                            (assq-ref outputs 'target)
+                            (assq-ref outputs 'common))))
+
+                    (inputs  (assq-ref data 'inputs))
+                    (matched-inputs
+                     (map
+                      (lambda (label items)
+                        (cons label
+                              (map 
+                               (match-lambda
+                                 ((derivation output)
+                                  `(,@(if (null? derivation)
+                                          '()
+                                          `((derivation . ,derivation)))
+                                    ,@(if (null? output)
+                                          '()
+                                          `((output . ,output))))))
+                               (or items '()))))
+                      '(base target common)
+                      (list (assq-ref inputs 'base)
+                            (assq-ref inputs 'target))))
+                    
+                    (sources (assq-ref data 'sources))
+                    (matched-sources
+                     (map
+                      (lambda (label items)
+                        (cons label
+                              (map
+                               (match-lambda
+                                 ((derivation)
+                                  `(,@(if (null? derivation)
+                                          '()
+                                          `((derivation . ,derivation))))))
+                               (or items '())))) 
+                      '(base target common)
+                      (list (assq-ref sources 'base)
+                            (assq-ref sources 'target)
+                            (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 (assq-ref matched-outputs 'base)))
+                      (target . ,(list->vector (assq-ref matched-outputs 'target)))
+                      (common . ,(list->vector (assq-ref matched-outputs 'common)))))
+                  (inputs
+                   . ((base . ,(list->vector (assq-ref matched-inputs 'base)))
+                      (target . ,(list->vector (assq-ref matched-inputs 'target)))))
+                  (sources                   
+                   . ((base . ,(list->vector (assq-ref matched-sources 'base)))
+                      (target . ,(list->vector (assq-ref matched-sources 'target)))
+                      (common . ,(list->vector (assq-ref matched-sources 'common)))))
+                  (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
-- 
2.30.2


  reply	other threads:[~2021-04-17 12:49 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
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 [this message]
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

  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=20210417094857.14599c72@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).