From d2fe2073f00c98771fc895405dd4d094a34ba7b7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Oct 2018 17:13:01 -0700 Subject: [PATCH] splice --- pollen/private/splice.rkt | 46 +++++++++++++++++++-------------------- pollen/private/ts.rktd | 2 +- 2 files changed, 23 insertions(+), 25 deletions(-) diff --git a/pollen/private/splice.rkt b/pollen/private/splice.rkt index a3ab1d5..556b088 100644 --- a/pollen/private/splice.rkt +++ b/pollen/private/splice.rkt @@ -1,31 +1,33 @@ #lang racket/base +(require racket/match + racket/list) (provide (all-defined-out)) ;; (string->symbol (format "~a" #\u200B)) (define splice-signal-tag '@) (define (attrs? x) - (and (list? x) - (andmap (λ (xi) - (and (list? xi) - (= (length xi) 2) - (symbol? (car xi)) - (string? (cadr xi)))) x))) + (match x + [(list (list (? symbol?) (? string?)) ...) #true] + [_ #false])) +(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]) ; (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]) (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` - cdr - list)] - [x (if (not (attrs? x)) ; don't recur on attributes, so null strings are not spliced within - (loop x) - x)]) - (proc x))) (filter not-null-string? x))) + (append-map (λ (x) + ; drop the splice-signal from front with `rest` + ; don't recur on attributes, so null strings are not spliced within + (define proc (if ((spliceable? splicing-tag) x) rest list)) + (proc (if (attrs? x) x (loop x)))) + (filter-not null-string? x)) x))) (module+ test @@ -40,29 +42,25 @@ (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) (let loop ([x x]) - (if (list? x) - ;; this will strip all empty lists. - ;; in practice, they would only appear in attrs position - (map loop (filter (λ (x) (not (null? x))) x)) + (if (pair? x) + (map loop (filter-not null? x)) x))) - (module+ test (check-equal? (strip-empty-attrs '(p ())) '(p)) (check-equal? (strip-empty-attrs '(p () "foo")) '(p "foo")) (check-equal? (strip-empty-attrs '(p () (em () "foo") "bar")) '(p (em "foo") "bar"))) - ;; used with pollen/markup to suppress void arguments, ;; consistent with how pollen/pre and pollen/markdown handle them (define (remove-voids x) (let loop ([x x]) (if (pair? x) - (for/list ([xi (in-list x)] - #:unless (void? xi)) - (loop xi)) + (map loop (filter-not void? x)) x))) (module+ test diff --git a/pollen/private/ts.rktd b/pollen/private/ts.rktd index 2755309..6e391b1 100644 --- a/pollen/private/ts.rktd +++ b/pollen/private/ts.rktd @@ -1 +1 @@ -1540858378 +1540858381