From 23487309c829ac9d871ecf7068ae7759fbb7298c Mon Sep 17 00:00:00 2001
From: pho4cexa <pho4cexa@orbital.rodeo>
Date: Tue, 27 Dec 2022 21:51:48 -0800
Subject: [PATCH] repair bugs in alist-update-in

dang this hurt my brain. need to figure out a better way
---
 main.scm | 47 ++++++++++++++++++++++++++++-------------------
 1 file changed, 28 insertions(+), 19 deletions(-)

diff --git a/main.scm b/main.scm
index b4409dd..e4f8d8c 100755
--- a/main.scm
+++ b/main.scm
@@ -32,6 +32,13 @@
   (when msg (print msg))
   (exit status))
 
+;; clojureish "debugging by print statement" tool since i still haven't reached
+;; lisp enlightenment
+(define ((inspect #!optional label #!rest args) s)
+  (display (list label ":" args " => " s) (current-error-port))
+  (newline (current-error-port))
+  s)
+
 ;; decompose a path s into its constituent parts. returns values:
 ;;
 ;; root: "/" if it's an absolute path, "" if relative directory-elements: a list
@@ -76,19 +83,21 @@
 (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))))
+      (alist-ref-in (cdr keys) (alist-ref (car keys) alist test) 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)))
+  (cond
+   ((not alist) #f)
+   ((null? (cdr keys))
+    (alist-update (car keys) value alist test))
+   (else
+    (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)
   (->
    inner
@@ -110,20 +119,20 @@
 
 (define (enumerate-tag tag inner)
   (let ((slug (slugify tag inner)))
-  `(,tag
-    (@ (id ,slug))
-    ,inner
-    (a (@ (title "Permalink to this section")
-          (href "#" ,slug))))))
+    `(,tag
+      (@ (id ,slug))
+      ,inner
+      (a (@ ((title "Permalink to this section")
+             (href "#" ,slug)))))))
 
 (define ((adjust-relative-link adjust-relative) tag inner)
-  (let ((linkurl (alist-ref-in '(@ href) inner)))
+  (let ((linkurl (alist-ref-in '(@ href) inner equal?)))
     `(,tag .
       ,(if (or (not adjust-relative)
-               (any (cute string-prefix? <> linkurl)
+               (any (cute string-prefix? <> (car linkurl))
                     '("#" "/" "https://" "http://" "mailto:" "https://")))
            inner
-           (alist-update-in '(@ href) (list adjust-relative linkurl) inner)))))
+           (alist-update-in '(@ href) (cons adjust-relative linkurl) inner equal?)))))
 
 (define (sxml-html-rules adjust-relative)
   `(;; assign all headings an id so you can link to them
@@ -133,8 +142,8 @@
     (h4        . ,enumerate-tag)
     (h5        . ,enumerate-tag)
     ;; if adjust-relative is true, all relative links should get prefixed with
-    ;; the relative-root.
-    `(a . ,(adjust-relative-link adjust-relative))
+    ;; the relative-root
+    (a         . ,(adjust-relative-link adjust-relative))
     ;; this copied from lowdown html-serialization-rules* because it
     ;; is for some reason not exported??
     (*COMMENT* . ,(lambda (_ str) (list #\< "!--" str "--" #\>)))
@@ -198,7 +207,7 @@
     ((ul
       ,(map
         (lambda (source-file)
-          `(li (a (@ href ,(make-pathname relative-root source-file ".html")) ,source-file)))
+          `(li (a (@ (href ,(make-pathname relative-root source-file ".html"))) ,source-file)))
         source-files-list)))))
 
 (define (commits->sxml)
@@ -228,7 +237,7 @@
         (lambda (source-file)
           (and
            (string-prefix? "ISSUES/" source-file)
-           `(li (a (@ href ,source-file ".html")
+           `(li (a (@ (href ,source-file ".html"))
                    ,(->
                      source-file
                      ((flip format) "git show HEAD:~a")