From 59598f42c16cf12e544e5bf2ce9c873fba94238e Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 6 Sep 2023 22:45:45 -0500
Subject: A newerer beginning

---
 boudin.util.scm | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 68 insertions(+)
 create mode 100644 boudin.util.scm

(limited to 'boudin.util.scm')

diff --git a/boudin.util.scm b/boudin.util.scm
new file mode 100644
index 0000000..2683730
--- /dev/null
+++ b/boudin.util.scm
@@ -0,0 +1,68 @@
+(declare (module (boudin util))
+         (export assoc-ref
+                 slurp
+                 wrap-paragraphs
+                 edisplay
+                 eprint))
+
+(import (srfi 1)
+        (srfi 152))
+
+(define (edisplay x)
+  (parameterize ((current-output-port (current-error-port)))
+    (display x)))
+
+(define (eprint . xs)
+  (parameterize ((current-output-port (current-error-port)))
+    (for-each display xs)
+    (newline)))
+
+(define (assoc-ref k alist)
+  (let ((k/v (and (pair? alist)
+                  (assoc k alist))))
+    (if k/v (cdr k/v) #f)))
+
+(define (wrap-paragraphs text)
+  (let loop ((ps (map string-trim (*split-paragraphs text)))
+             (acc '()))
+    (cond
+     ((null? ps)
+      (apply string-append (reverse acc)))
+     ((zero? (string-length (car ps)))
+      (loop (cdr ps) acc))
+     ((eq? #\< (string-ref (car ps) 0))
+      (loop (cdr ps) (cons (car ps) acc)))
+     (else
+      (loop (cdr ps)
+            (cons (string-append "<p>" (car ps) "</p>\n")
+                  acc))))))
+
+(define (*split-paragraphs text)
+  (define (*end-buf buf acc)
+    (cons (apply string-append (reverse buf)) acc))
+  (let loop ((ls (string-split text "\n"))
+             (buf '())
+             (acc '()))
+    (cond
+     ((and (null? ls)
+           (null? buf))
+      (reverse acc))
+     ((null? ls)
+      (loop '() '() (*end-buf buf acc)))
+     ((zero? (string-length (car ls)))
+      (loop (cdr ls) '() (*end-buf buf acc)))
+     (else
+      (loop (cdr ls)
+            (cons (string-append (car ls) "\n") buf)
+            acc)))))
+
+(define slurp
+  (case-lambda
+    (() (slurp (current-input-port)))
+    ((port)
+     (let loop ((ch (read-char port))
+                (acc '()))
+       (if (eof-object? ch)
+           (list->string (reverse acc))
+           (loop (read-char port)
+                 (cons ch acc)))))))
-- 
cgit 1.4.1-21-gabe81