From 27a3db35e8f982f3c33c6a03513f4111fed3815c Mon Sep 17 00:00:00 2001 From: EuAndreh Date: Tue, 17 May 2022 14:10:45 -0300 Subject: git mv src/heredoc.scm src/xyz/euandreh/ --- src/heredoc.scm | 97 -------------------------------------------- src/xyz/euandreh/heredoc.scm | 97 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+), 97 deletions(-) delete mode 100644 src/heredoc.scm create mode 100644 src/xyz/euandreh/heredoc.scm diff --git a/src/heredoc.scm b/src/heredoc.scm deleted file mode 100644 index fb10088..0000000 --- a/src/heredoc.scm +++ /dev/null @@ -1,97 +0,0 @@ -(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))))) 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))))) -- cgit v1.2.3