Subject: [bug#51838] [PATCH v8 03/41] guix: node-build-system: Add JSON utilities.

From: Philip McGrath <[email-masked]>
Date: Fri, 7 Jan 2022 23:13:42 -0500

Hi,

(None of the comments in this email should block these patches, IMO. I 
wouldn't change any of them until we move the functions to (guix build 
json-utils).)

On 12/30/21 02:38, Liliana Marie Prikler wrote:
> This commit adds several utility functions for non-destructive
> transformation of the JSON representation used by (guix build json),
> particularly for purely functional update of JSON objects.  They ought
> to eventually be exported from their own module, but for now are kept
> private to allow experimentation.
> 
> * guix/build/node-build-system.scm (assoc-ref*, jsobject-ref, alist-pop)
> (alist-update, jsobject-update*, jsobject-union): New variables.
> (with-atomic-json-file-replacement): New public variable.
> (module-name, build, patch-dependencies): Use them.  Do not resort to
> unsafe alist primitives from Guile core.
> 
> Co-authored-by: Liliana Marie Prikler <[email-masked]>
> ---
>   guix/build/node-build-system.scm | 145 ++++++++++++++++++++++++-------
>   1 file changed, 115 insertions(+), 30 deletions(-)
> 
> diff --git a/guix/build/node-build-system.scm b/guix/build/node-build-system.scm
> index 2d7a3bdc67..c6602b876b 100644
> --- a/guix/build/node-build-system.scm
> +++ b/guix/build/node-build-system.scm
> @@ -3,6 +3,7 @@
>   ;;; Copyright © 2016, 2020 Jelle Licht <[email-masked]>
>   ;;; Copyright © 2019, 2021 Timothy Sample <[email-masked]>
>   ;;; Copyright © 2021 Philip McGrath <[email-masked]>
> +;;; Copyright © 2021 Liliana Marie Prikler <[email-masked]>
>   ;;;
>   ;;; This file is part of GNU Guix.
>   ;;;
> @@ -26,14 +27,101 @@ (define-module (guix build node-build-system)
>     #:use-module (ice-9 ftw)
>     #:use-module (ice-9 match)
>     #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-71)
>     #:export (%standard-phases
> +            with-atomic-json-file-replacement
>               node-build))
>   
> -;; Commentary:
> -;;
> -;; Builder-side code of the standard Node/NPM package install procedure.
> -;;
> -;; Code:
> +(define (with-atomic-json-file-replacement file proc)
> +  "Like 'with-atomic-file-replacement', but PROC is called with a single
> +argument---the result of parsing FILE's contents as json---and should a value
> +to be written as json to the replacement FILE."
> +  (with-atomic-file-replacement file
> +    (lambda (in out)
> +      (write-json (proc (read-json in)) out))))
> +
> +(define* (assoc-ref* alist key #:optional default)
> +  "Like assoc-ref, but return DEFAULT instead of #f if no value exists."
> +  (match (assoc key alist)
> +    (#f default)
> +    ((_ . value) value)))
> +
> +(define* (jsobject-ref obj key #:optional default)
> +  (match obj
> +    (('@ . alist) (assoc-ref* alist key default))))
> +
> +(define* (alist-pop alist key #:optional (= equal?))
> +  "Return two values, the first pair in ALIST with key KEY, and the other
> +elements.  Equality calls are made as (= KEY ALISTCAR)."
> +  (define (found? pair)
> +    (= key (car pair)))
> +
> +  (let ((before after (break found? alist)))
> +    (if (pair? after)
> +        (values (car after) (append before (cdr after)))
> +        (values #f before))))

FWIW, while I don't feel strongly about `let` vs. `define` in general, I 
find SRFI-71's overloaded `let` less clear than internal definitions and 
`define-values`, which are supported by core Guile.

> +
> +(define* (alist-update alist key proc #:optional default (= equal?))
> +  "Return an association list like ALIST, but with KEY mapped to the result of
> +PROC applied to the first value found under the comparison (= KEY ALISTCAR).
> +If no such value exists, use DEFAULT instead.
> +Unlike acons, this removes the previous association of KEY (assuming it is
> +unique), but the result may still share storage with ALIST."
> +  (let ((pair rest (alist-pop alist key =)))
> +    (acons key
> +           (proc (if (pair? pair)
> +                     (cdr pair)
> +                     default))
> +           rest)))
> +
> +(define (jsobject-update* js . updates)
> +  "Return a json object like JS, but with all UPDATES applied.  Each update
> +is a list (KEY PROC [DEFAULT]), so that KEY is mapped to the result of
> +PROC applied to the value found for it, or DEFAULT otherwise."
> +  (match js
> +    (('@ . alist)
> +     (let loop ((alist alist)
> +                (updates updates))
> +       (match updates
> +         (() (cons '@ alist))
> +         (((key proc) . updates)
> +          (loop (alist-update alist key proc #f equal?) updates))
> +         (((key proc default) . updates)
> +          (loop (alist-update alist key proc default equal?) updates)))))))

I would prefer (KEY [DEFAULT] PROC). In my experience, DEFAULT is often 
something simple like #f, and writing it after a multi-line lambda 
expression is not very pleasant. As a reader, you often want to know 
what DEFAULT is while reading the body of PROC, whereas putting DEFAULT 
last can look like a dangling afterthought. Plus, I think indentation 
tends to work out better with PROC at the end of a clause.

The docstring no longer specifies left-to-right evaluation or that the 
default DEFAULT is #f. (And I still think '(@) is a better default DEFAULT.)

I don't especially like all of the explicit quasiquotation of lists in 
the rest argument.

> +
> +(define (jsobject-union combine seed . objects)
> +  "Merge OBJECTS into SEED by applying (COMBINE KEY VAL0 VAL), where VAL0
> +is the value found in the (possibly updated) SEED and VAL is the new value
> +found in one of the OBJECTS."
> +  (match seed
> +    (('@ . aseed)
> +     (match objects
> +       (() seed)
> +       ((('@ . alists) ...)
> +        (cons
> +         '@
> +         (fold (lambda (alist aseed)
> +                 (if (null? aseed) alist
> +                     (fold
> +                      (match-lambda*
> +                        (((k . v) aseed)
> +                         (let ((pair tail (alist-pop alist k)))
> +                           (match pair
> +                             (#f (acons k v aseed))
> +                             ((_ . v0) (acons k (combine k v0 v) aseed))))))
> +                      aseed
> +                      alist)))
> +               aseed
> +               alists)))))))
> +
> +;; Possibly useful helper functions:
> +;; (define (newest key val0 val) val)
> +;; (define (unkeyed->keyed proc) (lambda (_key val0 val) (proc val0 val)))

I much prefer a keyword argument #:combine, and I still think the 
key-agnostic case is so much more common that the separation of 
#:combine/key is useful.

-Philip