blob: be9408a0a23fc7d383379acb9b091b73b53ca776 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(define-module (xyz euandreh 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)))))
|
