Re: Outreachy - Guix Data Service: implementing basic json output for derivation comparison page

[Christopher Baines]

Luciana Lima Brito <lubrito@posteo.net> writes:

> I implemented a basic json output for the derivation comparison page,
> for my first contribution as an Outreachy applicant.
>
> The patch for the code I've changed is attached.
> I'm waiting your reviews :)

Hi Luciana,

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.

Looking at the diff though:

> diff --git a/guix-data-service/web/compare/controller.scm 
> b/guix-data-service/web/compare/controller.scm
> index a6aa198..b7788cb 100644
> --- a/guix-data-service/web/compare/controller.scm
> +++ b/guix-data-service/web/compare/controller.scm
> @@ -584,19 +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
> -              '((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))
> +                (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)))))

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.

  (let* ((outputs (assq-ref data 'outputs))
         (matched-outputs (append-map get-derivation-data
                           (list (assq-ref outputs 'base)
                                 (assq-ref outputs 'target)
                                 (assq-ref outputs 'common))))

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?

> +                (case (most-appropriate-mime-type
> +                       '(application/json text/html)
> +                       mime-types)
> +                  ((application/json)
> +                   (render-json
> +                    `((revision

I'm not sure what revision here referrs to.

> +                       . ((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)

I hope that helps, just let me know if you have any questions,

Chris

signature.asc
Description: PGP signature