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

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 <liliana.prikler@gmail.com>
---
 guix/build/node-build-system.scm | 145 ++++++++++++++++++++++++-------
 1 file changed, 115 insertions(+), 30 deletions(-)

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 <liliana.prikler@gmail.com>
> ---
>   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 <jlicht@fsfe.org>
>   ;;; Copyright © 2019, 2021 Timothy Sample <samplet@ngyro.com>
>   ;;; Copyright © 2021 Philip McGrath <philip@philipmcgrath.com>
> +;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler@gmail.com>
>   ;;;
>   ;;; 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

Hi,

Am Freitag, dem 07.01.2022 um 23:13 -0500 schrieb Philip McGrath:
> 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.
Internal definitions are an implicit letrec, which might be useful to
have, but I prefer explicit let-binding.  It has the added benefit of
being shorter to write and having clearer scope.


> 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. 
The reason to have DEFAULT be an optional final argument is imo
symmetry with how you'd call the underlying alist functions.  It makes
the code a little easier to grok, but you're right that inline DEFAULT
looks nicer.

> The docstring no longer specifies left-to-right evaluation or that
> the default DEFAULT is #f.
That's a bug.

>  (And I still think '(@) is a better default DEFAULT.)
I don't think so.  Values could be of any type, not necessarily object
type (e.g. suppose you're updating a key:string mapping).  So explicit
'(@) is preferred in my opinion.

> I don't especially like all of the explicit quasiquotation of lists
> in the rest argument.
Two things: First it makes it easier to understand where each update
begins and where each update ends.  Second, I'm not satisfied with
quasi-quote either (I'd like to have substitute-json* syntax ideally),
but it's a fair middle ground between my ideal solution and what I
could do on top of your submission in a short time.

> > +(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.
I think we could define an (alist-flatten alist #:key combine default-
combine), where again combine is your combine/key and default-combine
is your combine.  Then we could define (json-object-union objs ...)
as (alist-flatten (append-map json-object->alist objs) #:combine ...).
Explicit conversion of json-object to alist and back seems to be the
wiser option to me than defining everything twice.  WDYT?