diff options
author | EuAndreh <eu@euandre.org> | 2022-05-17 14:10:45 -0300 |
---|---|---|
committer | EuAndreh <eu@euandre.org> | 2022-05-17 14:10:45 -0300 |
commit | 27a3db35e8f982f3c33c6a03513f4111fed3815c (patch) | |
tree | 74bb16777d3e94bff1cdb455091e989164aeac7f /src/xyz/euandreh/heredoc.scm | |
parent | Add first workikng version, with proper Makefile with "install" target (diff) | |
download | guile-heredoc-27a3db35e8f982f3c33c6a03513f4111fed3815c.tar.gz guile-heredoc-27a3db35e8f982f3c33c6a03513f4111fed3815c.tar.xz |
git mv src/heredoc.scm src/xyz/euandreh/
Diffstat (limited to 'src/xyz/euandreh/heredoc.scm')
-rw-r--r-- | src/xyz/euandreh/heredoc.scm | 97 |
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))))) |