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