From 31b11de1a60d0ec5ad307b073139d6308a33156f Mon Sep 17 00:00:00 2001 From: pho4cexa Date: Sun, 25 Dec 2022 23:16:07 -0800 Subject: [PATCH] update-in and ref-in (takes a path of keys) for nested alists --- main.scm | 30 +++++++++++++++++++++--------- 1 file changed, 21 insertions(+), 9 deletions(-) diff --git a/main.scm b/main.scm index 7e42a9e..03b7daf 100755 --- a/main.scm +++ b/main.scm @@ -72,6 +72,21 @@ (define (alist-merge a b) (lset-union (lambda (x y) (eq? (car x) (car y))) a b)) +;; like alist-ref but works on nested alists by specifying a path (list of keys) +(define (alist-ref-in keys alist #!optional (test eqv?)) + (if (null? (cdr keys)) + (alist-ref (car keys) alist test) + (alist-ref-in (cdr keys) (alist-ref (car keys) alist test)))) + +;; like alist-update, but works on nested alists by specifying a path (list of +;; keys) +(define (alist-update-in keys value alist #!optional (test eqv?)) + (if (null? (cdr keys)) + (alist-update (car keys) value alist test) + (alist-update (car keys) + (alist-update-in (cdr keys) value (alist-ref (car keys) alist test) test) + alist test))) + ;; auto-apply ids to headings --------------------------------- (define (slugify _ inner) @@ -112,16 +127,13 @@ ;; the relative-root. `(a . ,(lambda (t i) - (let ((linkurl (alist-ref 'href (alist-ref '@ i)))) + (let ((linkurl (alist-ref-in '(@ href) i))) `(,t . - ,(if (and adjust-relative - (not (any - (cute string-prefix? <> linkurl) - '("#" "/" "https://" "http://" "mailto:" "https://")))) - (alist-update '@ - (alist-update 'href `(,adjust-relative ,linkurl) (alist-ref '@ i)) - i) - i))))) + ,(if (or (not adjust-relative) + (any (cute string-prefix? <> linkurl) + '("#" "/" "https://" "http://" "mailto:" "https://"))) + i + (alist-update-in '(@ href) (list adjust-relative linkurl) i)))))) ;; this copied from lowdown html-serialization-rules* because it ;; is for some reason not exported?? (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))