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

[Philip McGrath]

Hi Liliana,

On 12/30/21 11:56, Liliana Marie Prikler wrote:
> Am Donnerstag, dem 30.12.2021 um 02:38 -0500 schrieb Philip McGrath:
>> 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
>> should
>> eventually be exported, but most are private for now to allow for
>> more
>> experience and consideration before commiting to the API.  The design
>> was largely inspired by the 'racket/dict' and 'racket/hash'
>> libraries.
>> Liliana Marie Prikler proposed 'with-atomic-json-file-replacement'.
> Given that this is a fair amount of procedures that you're proposing, I
> think a new file would be appropriate.  Perhaps (guix build json-
> utils)?  Adding that should IIUC not cause a world rebuild, so we could
> do that on master.
>

I agree that these functions ultimately belong in their own file, and 
I'd even had the name (guix build json-utils) in mind.

I put them in (guix build node-build-system) for now because, if they 
were in (guix build json-utils), they would have to be exported, at 
which point their API would have to be relatively stable, and I didn't 
want designing them to block, or to be rushed by, the rest of this 
series. Now, maybe consensus on the json-utils will turn out to be the 
easy part! But my high-level question is, in your view, do any of the 
points I'm about to respond to block this patch series?

On 12/30/21 13:18, Liliana Marie Prikler wrote:
> Having argued for these procedures to be moved into their own file in a
> separate mail, now it's time to bikeshed stylistic choices.
>
> Am Donnerstag, dem 30.12.2021 um 02:38 -0500 schrieb Philip McGrath:
> > +(define (jsobject-ref js key failure-result)
> > +  "Return the value assosciated with KEY in the json object JS.  If
> > KEY is not
> > +found and FAILURE-RESULT is a procedure, it is called in tail position
> > with
> > +zero arguments.  Otherwise, FAILURE-RESULT is returned."
> > +  ;; TODO: `failure-result` should be optional, but should the default
> > +  ;; `failure-result` be #f (like `assoc-ref`), a thunk raising an
> > exception,
> > +  ;; '(@), or something else?  Keep it mandatory until we discuss and
> > decide.
> > +  (match js
> > +    (('@ . alist)
> > +     (match (assoc key alist)
> > +       (#f
> > +        (if (procedure? failure-result)
> > +            (failure-result)
> > +            failure-result))
> > +       ((_ . value)
> > +        value)))))
> We can safely replace failure-result by Guile's DEFAULT and leave error
> handling to the user.

I don't care whether we call it DEFAULT or FAILURE-RESULT.

I agree that it should not raise an exception by default. My current 
thinking is that '(@) would be a good default DEFAULT: it is useful for 
the common pattern of traversing or transforming nested objects, and, as 
you point out at the end of this email, explicitly typing #f (the other 
useful possibility) looks much more like normal Scheme than explicitly 
typing '(@).

In my experience with [1] and [2] (the purely-functional dictionary 
libraries I use most often), the special case for a procedure as DEFAULT 
is useful. I feel less strongly about it because it's relatively easy to 
work around for JSON, since you can pick some non-JSON signal value, but 
it also seems to have especially little downside for JSON, since (guix 
build json) will never have a procedure in a valid JSON object. In 
addition to raising exceptions and other control flow, it's useful for 
default values that are expensive to produce.

[1]: https://docs.racket-lang.org/reference/hashtables.html
[2]: https://docs.racket-lang.org/reference/dicts.html

> > +(define (alist-pop alist key)
> > +  "Return two values: the first pair in ALIST with the given KEY in
> > its
> > +'car' (or #f, if no such pair exists) and an assosciation list like
> > (and
> > +potentially sharing storage with) ALIST, but with no entry for KEY."
> > +  (match (assoc key alist)
> > +    ;; If key isn't present, we don't need to do any allocation
> > +    (#f
> > +     (values #f alist))
> > +    (found
> > +     (values found
> > +             ;; Because we have `found`, we can find it more
> > +             ;; efficiently this time with `eq?`. We avoid using
> > +             ;; `delq` because it would copy pairs in a shared
> > +             ;; tail. We assume a sufficiently smart compiler to
> > +             ;; handle "tail recursion modulo cons" (vid. e.g. Indiana
> > +             ;; University Technical Report No. 19, Friedman & Wise
> > +             ;; 1975) at least as efficiently as a hand-written
> > +             ;; tail-recursive implementation with an accumulator.
> > +             (let loop ((alist alist))
> > +               (match alist
> > +                 ;; We know that `found` is present,
> > +                 ;; so no need to check for '()
> > +                 ((this . alist)
> > +                  (if (eq? this found)
> > +                      alist
> > +                      (cons this (loop alist))))))))))
> I think this can be more efficiently be done in a "single" loop.
>
>    (let loop ((rest alist)
>               (previous '()))
>      (match rest
>        (() (values #f alist))
>        ((first . rest)
>         (if (eq? (car first) key)
>             (values first (reverse! previous rest))
>             (loop rest (cons first previous))))))

I'll admit to a Racket bias, but, having just eliminated the use of 
'assoc-set!', I'm loathe to start mutating pairs (even correctly). To 
quote a bit from the SRFI-1 spec for 'append-reverse!', "note that this 
pattern of iterative computation followed by a reverse can frequently be 
rewritten as a recursion, dispensing with the reverse and append-reverse 
steps, and shifting temporary, intermediate storage from the heap to the 
stack, which is typically a win for reasons of cache locality and eager 
storage reclamation." (See how 'set-cdr!' can crash safe Chez Scheme! 
<https://github.com/cisco/ChezScheme/issues/599>)

IIUC, using SRFI-1's 'span' would lead to the same situation.

> Also, I don't think your version is tail-recursive.  (loop alist) is
> not in tail position from what I can tell.

Yes, "tail recursion modulo cons" refers to a compiler optimization for 
functions which are _not_ tail recursive. For full details, see the 
Friedman & Wise 1975 tech report I cited at 
<https://legacy.cs.indiana.edu/ftp/techreports/TR19.pdf> (or various 
other articles), but, as briefly as I can: The optimization rests on the 
observation that many recursive functions, like the classic definition 
of 'map':

    (define (map f lst)
      (match lst
        (()
         '())
        ((this . lst)
         (cons (f this)
               (map f lst)))))

are nearly tail-recursive, and the only real work remaining to be done 
in the continuation of the recursive call is to fill in the cdr of the 
pair. Thus, a compiler can safely transform this code into a truly 
tail-recursive implementation:

    (define (map f lst)
      (match lst
        (()
         '())
        ((this . lst)
         (define ret (list (f this)))
         (let loop ((dest ret)
                    (lst lst))
           (match lst
             ((this . lst)
              (define new (list (f this)))
              (set-cdr! dest new)
              (loop new lst))
             (()
              ret))))))

Unlike the Proper Implementation of Tail Calls (so-called "tail-call 
optimization"), handling "tail recursion modulo cons" truly is an 
optimization: it does not change the space complexity of the function. 
But it can allow the compiler to generate whatever code it thinks will 
work best with its collector/allocator and continuation/"call stack" 
implementation.

(The optimizations applies to constructors in general, not just 'cons', 
and a compiler can safely apply it to values that are immutable from the 
perspective of the source language.)

> > +;; Sadly, Guile's implementation of (@ (srfi srfi-1) alist-delete)
> > +;; performs unnecessary allocation, e.g. this currently evaluates to
> > #f:
> > +;;
> > +;;     (let ((alist `(("a" . 1)("b" . 2)("c" . 3))))
> > +;;       (eq? alist (alist-delete "x" alist)))
> > +;;
> > +;; These functions generally choose to allocate a new outer pair
> > (with the '@
> > +;; tag), even though in unusual cases the resulting object might not
> > have
> > +;; changed, for the sake of simplicity and to avoid retaining a
> > reference to
> > +;; the original alist longer than necessary. But that is O(1)
> > allocation that
> > +;; could only rarely be avoided: `alist-delete` would allocate O(n)
> > pairs,
> > +;; which would only be necessary in the worst case.
> > +(define (alist-delete* alist key)
> > +  "Return an assosciation list like (and potentially sharing storage
> > with)
> > +ALIST, but with no entry for KEY."
> > +  (define-values (_popped remaining)
> > +    (alist-pop alist key))
> > +  remaining)
> That's a pretty long comment around something that could be done with
> call-with-values or SRFI-71 let.  I think one of these two should be
> preferred.
>
> Note that both our versions of alist-pop only pop the first key (as
> they should).  This means that alist-delete* should really be called
> alist-delete-1 as in "remove the first pair in ALIST belonging to KEY".
> For the larger JSON handling below, this makes no difference however.

Here I was using '*' to mean "a slightly altered version of", as with 
'letrec' and 'letrec*', but, yes, since the other functions defined here 
use '*' to mean "zero or more times", the name is confusing: I think I'd 
just call it 'alist-delete' and not import (srfi srfi-1)'s version.

The comment may be unnecessarily long ... the essence of what I was 
trying to explain is that, in all of these implementations, I've tried 
to avoid unnecessary allocation. Being able to rely on 'alist-delete', 
and more generally 'alist-pop', not to needlessly copy the "spine" of 
the list lets later functions use them unconditionally.

Why would you prefer 'call-with-values' or SRFI-71 over 'define-values'? 
The style guide against which I'm used to working [3] generally prefers 
internal definitions, to avoid rightward drift.

[3]: 
https://docs.racket-lang.org/style/Choosing_the_Right_Construct.html#%28part._.Definitions%29

> > +(define (alist-set alist key value)
> > +  "Return an assosciation list like ALIST, but with KEY mapped to
> > VALUE,
> > +replacing any existing mapping for KEY."
> > +  (acons key value (alist-delete* alist key)))
> Is order relevant here?  Because we could just as well reimplement our
> alist-delete* loop and cons the replacement onto the rest.  WDYT?

Relying on order for JSON objects is non-interoperable, per RFC 8259 § 
4. I'm not intending for these alist procedures to be exported, so I'm 
not trying to handle any more general case than that, as I explain in 
the comments at the top of the file.

I'm not sure what the advantage would be to reimplementing the 
'alist-delete' loop here.

> > +(define (jsobject-set js key value)
> > +  "Return a json object like JS, but with KEY mapped to VALUE,
> > replacing any
> > +existing mapping for KEY."
> > +  (cons '@ (match js
> > +             (('@ . alist)
> > +              (alist-set alist key value)))))
> I think it'd be wiser to put the cons inside the match.

I don't care very much either way.

> > +(define jsobject-set*
> > +  (case-lambda
> > +    "Return a json object like JS, but functionally extended by
> > mapping each
> > +KEY to each VALUE, replacing any existing mapping for each KEY.  The
> > update
> > +takes place from left to right, so later mappings overwrite earlier
> > mappings
> > +for the same KEY."
> > +    ((js)
> > +     js)
> > +    ((js key value)
> > +     (jsobject-set js key value))
> > +    ((js . args)
> > +     (cons '@ (match js
> > +                (('@ . alist)
> > +                 (let loop ((alist alist)
> > +                            (args args))
> > +                   (match args
> > +                     (()
> > +                     alist)
> > +                     ((key value . args)
> > +                      (loop (alist-set alist key value)
> > +                            args))))))))))
> I'm not sure if I like this "syntax".  I think I'd prefer
>    (jsobject-set* obj (FIELD1 VALUE1) (FIELD2 VALUE2) ...)
> with FIELD1, FIELD2 being identifiers
> WDYT?

So you would make 'jsobject-set*' a macro? When you say, "with FIELD1, 
FIELD2 being identifiers", do you mean that the macro should convert 
them to strings at compile-time? While, if I were designing a JSON 
representation, I'd much prefer to use symbols for the object keys, I 
think it would be confusing to use strings everywhere else but magic 
symbols here.

I based this function on 'hash-set*' [4], 'dict-set*' [5], and numerous 
similar functions in the Racket world, so I have a high degree of 
confidence in the usability of the interface.

[4]: 
https://docs.racket-lang.org/reference/hashtables.html#%28def._%28%28lib._racket%2Fprivate%2Fbase..rkt%29._hash-set%2A%29%29
[5]: 
https://docs.racket-lang.org/reference/dicts.html#%28def._%28%28lib._racket%2Fdict..rkt%29._dict-set%2A%29%29


> > +(define (alist-update alist key failure-result updater)
> > +  "Return an assosciation list like ALIST, but with KEY mapped to
> > the result
> > +of applying UPDATER to the value to which KEY is mapped in ALIST.
> > When ALIST
> > +does not have an existing mapping for KEY, FAILURE-RESULT is used as
> > with
> > +'jsobject-ref' to obtain the argument for UPDATER."
> > +  ;; Often, `updater` will be a lambda expression, so making it the
> > last
> > +  ;; argument may help to makes the code legible, and the most
> > likely
> > +  ;; `failure-result` arguments are all shorter than the keyword
> > +  ;; `#:failure-result`.  Plus, making `failure-result` mandatory
> > helps make
> > +  ;; `alist-update` consistent with `alist-update*`.
> Which alist-update* are you referring to here?  Either way, the
> failure-result to default argument from above applies, but we could
> keyword it.

Ah, I guess read that as, "Plus, making 'default' mandatory helps make 
'jsobject-update' consistent with 'jsobject-update*'."

> > +  (define-values (popped tail-alist)
> > +    (alist-pop alist key))
> > +  (acons key
> > +         (updater (match popped
> > +                    (#f
> > +                     (if (procedure? failure-result)
> > +                         (failure-result)
> > +                         failure-result))
> > +                    ((_ . value)
> > +                     value)))
> > +         tail-alist))
> SRFI-71 let says hi.  Also the ordering question applies.  I'm starting
> to think we should implement alist-pop, alist-set and alist-update in
> terms of a single more powerful function producing three values (or
> SRFI-1 span).

Same question again re 'define-values'.

My intent in creating 'alist-pop' was to have a primitive that would 
work for both 'alist-update' and 'alist-delete', and thereby 
'alist-set'. Returning the prefix and the tail separately would involve 
either extra allocation or mutating pairs. Since order never matters in 
this context, why pay that price?

> > +(define* (jsobject-union #:key
> > +                         (combine (lambda (a b) b))
> > +                         (combine/key (lambda (k a b) (combine a
> > b)))
> > +                         #:rest json-objects)
> > +  "Combine the given JSON-OBJECTS into a single json object.  The
> > JSON-OBJECTS
> > +are merged from left to right by adding each key/value pair of each
> > object to
> > +the aggregate object in turn.  When one of the JSON-OBJECTS contains
> > a mapping
> > +from some key KEY to a value VAL such that the aggregate object
> > already
> > +contains a mapping from KEY to a value VAL0, the aggregate object is
> > +functionally updated to instead map KEY to the value of (COMBINE/KEY
> > KEY VAL0
> > +VAL).  The default COMBINE/KEY tail-calls (COMBINE VAL0 VAL), and
> > the default
> > +COMBINE simply returns its second argument, so, by default, mappings
> > in later
> > +JSON-OBJECTS supersede those in earlier ones."
> > +  (match (filter (lambda (v)
> > +                   (not (or (keyword? v)
> > +                            (procedure? v))))
> > +                 json-objects)
> > +    (()
> > +     '(@))
> > +    (((and js0 ('@ . _)))
> > +     js0)
> > +    ((('@ . alist0) ('@ . alist*) ...)
> > +     (cons '@ (fold (lambda (alist1 alist0)
> > +                      (if (null? alist0)
> > +                          alist1
> > +                          (fold (lambda (k+v alist0)
> > +                                  (match k+v
> > +                                    ((k . v)
> > +                                     (define-values (popped tail-
> > alist)
> > +                                       (alist-pop alist0 k))
> > +                                     (match popped
> > +                                       (#f
> > +                                        (cons k+v tail-alist))
> > +                                       ((_ . v0)
> > +                                        (acons k
> > +                                               (combine/key k v0 v)
> > +                                               tail-alist))))))
> > +                                alist0
> > +                                alist1)))
> > +                    alist0
> > +                    alist*)))))
> Same default argument.  Cons inside.
> I think having a single combine function taking (k a b) would be less
> confusing than having two.  Is there a rationale for the form you
> chose?

I based this function in particular on 'hash-union' from 'racket/hash' 
[6], which uses these keywords. (But in 'hash-union', collisions trigger 
an exception by default, and it requires at least one argument, because 
otherwise it would be unclear what key-comparison function the result 
should use.)

Having '#:combine' in addition to '#:combine/key' is ultimately just a 
convenience, but it is quite a nice convenience in practice. It is quite 
rare, in my experience, for a '#:combine' function to actually depend on 
the key: it might depend on the type of the value, but, very often, it 
unconditionally applies to all keys. Using '#:combine' is particularly 
nice when using a combination function that already exists, like 
'append' or '+'.

[6]: 
https://docs.racket-lang.org/reference/hashtables.html#%28def._%28%28lib._racket%2Fhash..rkt%29._hash-union%29%29

> > +  (with-atomic-json-file-replacement "package.json"
> > +    (lambda (pkg-meta)
> > +      (jsobject-update*
> > +       pkg-meta
> > +       "devDependencies" '(@) resolve-dependencies
> > +       "dependencies" '(@) (lambda (deps)
> > +                             (resolve-dependencies
> > +                              (jsobject-union
> > +                               (jsobject-ref pkg-meta
> > "peerDependencies" '(@))
> > +                               deps))))))
> >     #t)
> We should probably add a function to our js utils that "generates an
> empty object", because '(@) is quite confusing to see in these
> circumstances.  Otherwise LGTM with the aforementioned caveats.

I'm not sure what to call it: it would have to be short, or people (me, 
at least) might end up writing '(@) anyway. Also, IIUC Guile doesn't 
actually prevent you from mutating quoted constant pairs, so I function 
would have to allocate a fresh pair to be robust.

It's a somewhat odd idea, but how about this?

    (define-syntax |{}| (identifier-syntax '(@)))

It's as short as '(@), it looks like the JSON notation for the empty 
object, and IIUC people could only use it to mess up occurrences of '(@) 
within the same compilation unit, which we can't stop them from doing 
anyway.

Alternatively, if we give up the thunk special case for 'default' 
values, we could do:

    (define jsobject-update
      (case-lambda
        ((js key updater)
         (jsobject-update js key '(@) updater))
        ((js key default updater)
         ...)))
    (define jsobject-update*
      (case-lambda
        ...
        ((js . args)
         (match js
           (('@ . alist)
            (cons '@ (let loop ((alist alist)
                                (args args))
                       (match args
                         (()
                          alist)
                         ((key (? procedure? updater) . args)
                          (loop (alist-update alist key '(@) updater)
                                args))
                         ((key default updater . args)
                          (loop (alist-update alist key '(@) updater)
                                args))))))))))

-Philip