dev-stylish
Matthew Butterick 6 years ago
parent a26670c009
commit d2fe2073f0

@ -1,31 +1,33 @@
#lang racket/base #lang racket/base
(require racket/match
racket/list)
(provide (all-defined-out)) (provide (all-defined-out))
;; (string->symbol (format "~a" #\u200B)) ;; (string->symbol (format "~a" #\u200B))
(define splice-signal-tag '@) (define splice-signal-tag '@)
(define (attrs? x) (define (attrs? x)
(and (list? x) (match x
(andmap (λ (xi) [(list (list (? symbol?) (? string?)) ...) #true]
(and (list? xi) [_ #false]))
(= (length xi) 2)
(symbol? (car xi))
(string? (cadr xi)))) x)))
(define (null-string? x) (equal? x ""))
(define ((spliceable? splicing-tag) x)
(match x
[(cons (== splicing-tag eq?) _) #true]
[_ #false]))
(define (splice x [splicing-tag splice-signal-tag]) (define (splice x [splicing-tag splice-signal-tag])
; (listof txexpr-elements?) . -> . (listof txexpr-elements?)) ; (listof txexpr-elements?) . -> . (listof txexpr-elements?))
(define spliceable? (λ (x) (and (pair? x) (eq? (car x) splicing-tag))))
(define not-null-string? (λ (x) (not (and (string? x) (zero? (string-length x))))))
(let loop ([x x]) (let loop ([x x])
(if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo")) (if (list? x) ; don't exclude `attrs?` here, because it will exclude valid splice input like '((@ "foo"))
(apply append (map (λ (x) (let ([proc (if (spliceable? x) ; drop the splice-signal from front with `cdr` (append-map (λ (x)
cdr ; drop the splice-signal from front with `rest`
list)] ; don't recur on attributes, so null strings are not spliced within
[x (if (not (attrs? x)) ; don't recur on attributes, so null strings are not spliced within (define proc (if ((spliceable? splicing-tag) x) rest list))
(loop x) (proc (if (attrs? x) x (loop x))))
x)]) (filter-not null-string? x))
(proc x))) (filter not-null-string? x)))
x))) x)))
(module+ test (module+ test
@ -40,29 +42,25 @@
(check-equal? (splice `((,splice-signal-tag "str"))) '("str"))) (check-equal? (splice `((,splice-signal-tag "str"))) '("str")))
;; this will strip all empty lists.
;; in practice, they would only appear in attrs position
(define (strip-empty-attrs x) (define (strip-empty-attrs x)
(let loop ([x x]) (let loop ([x x])
(if (list? x) (if (pair? x)
;; this will strip all empty lists. (map loop (filter-not null? x))
;; in practice, they would only appear in attrs position
(map loop (filter (λ (x) (not (null? x))) x))
x))) x)))
(module+ test (module+ test
(check-equal? (strip-empty-attrs '(p ())) '(p)) (check-equal? (strip-empty-attrs '(p ())) '(p))
(check-equal? (strip-empty-attrs '(p () "foo")) '(p "foo")) (check-equal? (strip-empty-attrs '(p () "foo")) '(p "foo"))
(check-equal? (strip-empty-attrs '(p () (em () "foo") "bar")) '(p (em "foo") "bar"))) (check-equal? (strip-empty-attrs '(p () (em () "foo") "bar")) '(p (em "foo") "bar")))
;; used with pollen/markup to suppress void arguments, ;; used with pollen/markup to suppress void arguments,
;; consistent with how pollen/pre and pollen/markdown handle them ;; consistent with how pollen/pre and pollen/markdown handle them
(define (remove-voids x) (define (remove-voids x)
(let loop ([x x]) (let loop ([x x])
(if (pair? x) (if (pair? x)
(for/list ([xi (in-list x)] (map loop (filter-not void? x))
#:unless (void? xi))
(loop xi))
x))) x)))
(module+ test (module+ test

@ -1 +1 @@
1540858378 1540858381

Loading…
Cancel
Save