A newerer beginning

1 files changed, 68 insertions, 0 deletions

@@ -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)))))))