summaryrefslogtreecommitdiff
path: root/src/xyz/euandreh/heredoc.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/xyz/euandreh/heredoc.scm')
-rw-r--r--src/xyz/euandreh/heredoc.scm97
1 files changed, 97 insertions, 0 deletions
diff --git a/src/xyz/euandreh/heredoc.scm b/src/xyz/euandreh/heredoc.scm
new file mode 100644
index 0000000..fb10088
--- /dev/null
+++ b/src/xyz/euandreh/heredoc.scm
@@ -0,0 +1,97 @@
+(define-module (heredoc)
+ #:use-module ((srfi srfi-1) #:prefix s1:)
+ #:export (heredoc-reader))
+
+(define consumable-chars
+ '(#\space #\tab))
+
+(define (extract-single-line-indentation chars)
+ (s1:fold (lambda (curr acc)
+ (let* ((prev (s1:first acc))
+ (halted? (s1:second acc))
+ (n (s1:third acc))
+ (non-blank? (not (member curr consumable-chars)))
+ (changed? (and (not (null? prev))
+ (not (equal? curr prev)))))
+ (cond
+ (halted? acc)
+ (non-blank? (list prev #t n))
+ (changed? (list prev #t n))
+ (#:else (list curr #f (+ 1 n))))))
+ '(#nil #f 0)
+ chars))
+
+(define (extract-line-indentations lines)
+ (map (compose (lambda (triple)
+ (list (s1:first triple)
+ (s1:third triple)))
+ extract-single-line-indentation
+ string->list)
+ lines))
+
+(define (maximum-indentation lines)
+ (let* ((line-indentations (extract-line-indentations lines))
+ (chars (map s1:first line-indentations))
+ (different-indents? (not (= 1 (length (s1:delete-duplicates chars))))))
+ (if different-indents?
+ 0
+ (apply min (map s1:second line-indentations)))))
+
+(define (trim-indentation s)
+ (let* ((lines (string-split s #\newline))
+ (trim-n (maximum-indentation
+ (filter (lambda (s) (not (equal? "" s)))
+ lines))))
+ (string-join
+ (map (lambda (line)
+ (if (equal? "" line)
+ line
+ (substring line trim-n)))
+ lines)
+ "\n")))
+
+(define (non-quote-chars? chars)
+ (let ((non-quote-chars (filter (lambda (c)
+ (not (equal? #\" c)))
+ chars)))
+ (< 0 (length non-quote-chars))))
+
+(define (heredoc-reader _char port)
+ (let ((should-trim? #f)
+ (chars '()))
+ (do ((curr (read-char port)
+ (read-char port)))
+ ((equal? #\newline curr))
+ (set! chars (cons curr chars)))
+ (when (and (not (null? chars))
+ (equal? #\- (car chars)))
+ (set! should-trim? #t)
+ (set! chars (cdr chars)))
+ (let ((non-quote-chars (non-quote-chars? chars)))
+ (when non-quote-chars
+ (error
+ (format
+ #f
+ "Invalid characters at the beginning of the multiline reader: ~s"
+ (reverse non-quote-chars)))))
+ (let* ((quote-count (+ 1 (length chars)))
+ (quote-n 0)
+ (output '()))
+ (while #t
+ (let ((curr (read-char port)))
+ (when (eof-object? curr)
+ (error "EOF while reading #\"\"# multiline string"))
+ (set! output (cons curr output))
+ (set! quote-n
+ (cond
+ ((and (>= quote-n quote-count)
+ (equal? #\# curr))
+ (break))
+ ((equal? #\" curr) (+ 1 quote-n))
+ (#:else 0)))))
+ (let ((s (list->string
+ (reverse
+ (s1:drop output (+ 1 quote-count))))))
+ (if should-trim?
+ (trim-indentation s)
+ s)))))