Package: guix-patches;
Reported by: Philip McGrath <philip <at> philipmcgrath.com>
Date: Sun, 14 Nov 2021 12:43:01 UTC
Severity: normal
Tags: patch
Done: Liliana Marie Prikler <liliana.prikler <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Philip McGrath <philip <at> philipmcgrath.com> To: Liliana Marie Prikler <liliana.prikler <at> gmail.com> Cc: 51838 <at> debbugs.gnu.org, Timothy Sample <samplet <at> ngyro.com>, Pierre Langlois <pierre.langlois <at> gmx.com>, Jelle Licht <jlicht <at> fsfe.org>, Leo Famulari <leo <at> famulari.name> Subject: [bug#51838] [PATCH v8 03/41] guix: node-build-system: Add JSON utilities. 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 <liliana.prikler <at> 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 <at> fsfe.org>
> ;;; Copyright © 2019, 2021 Timothy Sample <samplet <at> ngyro.com>
> ;;; Copyright © 2021 Philip McGrath <philip <at> philipmcgrath.com>
> +;;; Copyright © 2021 Liliana Marie Prikler <liliana.prikler <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.