decode

pollen/decode.rkt

@@ -2,6 +2,7 @@
 (require xml
          txexpr/base
          racket/list
+         racket/match
          sugar/list
          sugar/define
          sugar/test
@@ -48,27 +49,29 @@
     #:exclude-tags txexpr-tags?
     #:exclude-attrs txexpr-attrs?) . ->* . decode-proc-output-contract)
   (let loop ([x tx-in])
-    (cond
+    (match x
-      [(txexpr? x) (define-values (tag attrs elements) (txexpr->values x))
+      [(? txexpr?)
-                   (cond
+       (define-values (tag attrs elements) (txexpr->values x))
-                     [(or (memq tag excluded-tags)
+       (cond
-                          (for/or ([attr (in-list attrs)])
+         [(or (memq tag excluded-tags)
-                            (member attr excluded-attrs))) 
+              (for/or ([attr (in-list attrs)])
-                      x] ; because it's excluded
+                      (member attr excluded-attrs))) x] ; because it's excluded
-                     [else
+         [else
-                      ;; we apply processing here rather than do recursive descent on the pieces
+          ;; we apply processing here rather than do recursive descent on the pieces
-                      ;; because if we send them back through loop, certain element types are ambiguous
+          ;; because if we send them back through loop, certain element types are ambiguous
-                      ;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
+          ;; e.g., ((p "foo")) tests out as both txexpr-attrs and txexpr-elements
-                      (define decoded-txexpr (make-txexpr (txexpr-tag-proc tag) 
+          (define decoded-txexpr
-                                                          (txexpr-attrs-proc attrs) 
+            (make-txexpr (txexpr-tag-proc tag) 
-                                                          (txexpr-elements-proc (append-map (λ (x) (->list/tx (loop x))) elements))))
+                         (txexpr-attrs-proc attrs) 
-                      (txexpr-proc ((if (block-txexpr? decoded-txexpr)
+                         (txexpr-elements-proc (append-map (λ (x) (->list/tx (loop x))) elements))))
-                                        block-txexpr-proc
+          (txexpr-proc ((if (block-txexpr? decoded-txexpr)
-                                        inline-txexpr-proc) decoded-txexpr))])]
+                            block-txexpr-proc
-      [(string? x) (string-proc x)]
+                            inline-txexpr-proc) decoded-txexpr))])]
-      [(or (symbol? x) (valid-char? x)) (entity-proc x)]
+      [(? string?) (string-proc x)]
-      [(cdata? x) (cdata-proc x)]
+      [(? symbol?) (entity-proc x)]
-      [else (error "decode: can't decode" x)])))
+      [(? valid-char?) (entity-proc x)]
+      [(? cdata?) (cdata-proc x)]
+      [else (raise-argument-error 'decode "decodable thing" x)])))
 
 (module-test-external
  (require racket/list txexpr racket/function)
@@ -115,10 +118,8 @@
   (make-keyword-procedure
    (λ (kws kwargs . args)
      (define temp-tag (gensym "temp-tag"))
-     (define elements (car args))
+     (define elements (first args))
-     (define decode-result (keyword-apply decode kws kwargs (list (cons temp-tag elements))))
+     (get-elements (keyword-apply decode kws kwargs (list (cons temp-tag elements)))))))
-     (get-elements decode-result))))
-
 
 (define+provide/contract (block-txexpr? x)
   (any/c . -> . boolean?)
@@ -129,27 +130,30 @@
 
 (define+provide/contract (decode-linebreaks elems [maybe-linebreak-proc '(br)]
                                             #:separator [newline (setup:linebreak-separator)])
-  ((txexpr-elements?) ((or/c #f txexpr-element? (txexpr-element? txexpr-element? . -> . (or/c #f txexpr-element?))) #:separator string?) . ->* . txexpr-elements?)
+  ((txexpr-elements?)
+   ((or/c #f txexpr-element?
+          (txexpr-element? txexpr-element? . -> . (or/c #f txexpr-element?))) #:separator string?)
+   . ->* . txexpr-elements?)
   (unless (string? newline)
     (raise-argument-error 'decode-linebreaks "string" newline))
-  (define linebreak-proc (if (procedure? maybe-linebreak-proc)
+  (define linebreak-proc (match maybe-linebreak-proc
-                             maybe-linebreak-proc
+                           [(? procedure? proc) proc]
-                             (λ (e1 e2) maybe-linebreak-proc)))
+                           [val (λ (e1 e2) val)]))
   (define elems-vec (list->vector elems))
   (filter values
           (for/list ([(elem idx) (in-indexed elems-vec)])
-            (cond
+                    (cond
-              [(= idx 0) elem] ; pass first item
+                      [(zero? idx) elem] ; pass first item
-              [(= idx (sub1 (vector-length elems-vec))) elem] ; pass through last item
+                      [(= idx (sub1 (vector-length elems-vec))) elem] ; pass through last item
-              [(equal? elem newline)
+                      [(equal? elem newline)
-               (define prev (vector-ref elems-vec (sub1 idx)))
+                       (define prev (vector-ref elems-vec (sub1 idx)))
-               (define next (vector-ref elems-vec (add1 idx)))
+                       (define next (vector-ref elems-vec (add1 idx)))
-               ;; only convert if neither adjacent tag is a block
+                       ;; only convert if neither adjacent tag is a block
-               ;; (because blocks automatically force a newline before & after)
+                       ;; (because blocks automatically force a newline before & after)
-               (if (or (block-txexpr? prev) (block-txexpr? next))
+                       (if (or (block-txexpr? prev) (block-txexpr? next))
-                   #f ; flag for filtering
+                           #false ; flag for filtering
-                   (linebreak-proc prev next))]
+                           (linebreak-proc prev next))]
-              [else elem]))))
+                      [else elem]))))
 
 (module-test-external
  (check-equal? (decode-linebreaks '("foo" "\n" "bar")) '("foo" (br) "bar"))
@@ -169,17 +173,21 @@
 (define+provide/contract (merge-newlines x)
   (txexpr-elements? . -> . txexpr-elements?)
   (define newline-pat (regexp (format "^~a+$" (setup:newline))))
-  (define (newline? x) (and (string? x) (regexp-match newline-pat x)))  
+  (define (newline? x) (match x
+                         [(regexp newline-pat) #true]
+                         [_ #false]))  
   (define (merge-newline-slice xs)
-    (if (newline? (car xs)) ; if first member of slice is newline, they all are
+    (match xs
-        (list (apply string-append xs))
+      ;; if first member of slice is newline, they all are
-        xs))
+      [(cons (? newline?) _) (list (apply string-append xs))]
-  (define empty-string? (λ (x) (equal? x "")))
+      [_ xs]))
+  (define (empty-string? x) (equal? x ""))
   (let loop ([x x])
-    (if (and (pair? x) (not (attrs? x)))
+    (match x
-        (let ([xs (map loop (filter-not empty-string? x))])
+      [(? pair? x) #:when (not (attrs? x))
-          (append-map merge-newline-slice (slicef xs newline?)))
+                   (define xs (map loop (filter-not empty-string? x)))
-        x)))
+                   (append-map merge-newline-slice (slicef xs newline?))]
+      [_ x])))
 
 (module-test-external
  (require racket/list)
@@ -189,7 +197,6 @@
  (check-equal? (merge-newlines '(p "\n" "\n" "foo" "\n" "\n\n" "bar" (em "\n" "\n" "\n"))) 
                '(p "\n\n" "foo" "\n\n\n" "bar" (em "\n\n\n"))))
 
-
 (define+provide/contract (decode-paragraphs elements-in [maybe-wrap-proc 'p]
                                             #:linebreak-proc [linebreak-proc decode-linebreaks]
                                             #:force? [force-paragraph #f])
@@ -206,26 +213,30 @@
   
   (define (paragraph-break? x)
     (define paragraph-pattern (pregexp (format "^~a+$" paragraph-separator)))
-    (and (string? x) (regexp-match paragraph-pattern x)))
+    (match x
+      [(pregexp paragraph-pattern) #true]
+      [_ #false]))
   
   (define (explicit-or-implicit-paragraph-break? x)
     (or (paragraph-break? x) (block-txexpr? x)))
 
-  (define wrap-proc (if (procedure? maybe-wrap-proc)
+  (define wrap-proc (match maybe-wrap-proc
-                        maybe-wrap-proc
+                      [(? procedure? proc) proc]
-                        (λ (elems) (list* maybe-wrap-proc elems))))
+                      [_ (λ (elems) (list* maybe-wrap-proc elems))]))
 
   (define (wrap-paragraph elems)
-    (if (andmap block-txexpr? elems)
+    (match elems
-        elems ; leave a series of block xexprs alone
+      [(list (? block-txexpr?) ...) elems] ; leave a series of block xexprs alone
-        (list (wrap-proc elems)))) ; otherwise wrap in p tag 
+      [_ (list (wrap-proc elems))])) ; otherwise wrap in p tag
 
   (define elements (prep-paragraph-flow elements-in))
   (if (ormap explicit-or-implicit-paragraph-break? elements) ; need this condition to prevent infinite recursion
-      ;; use append-map on wrap-paragraph rather than map to permit return of multiple elements
+      ;; use `append-map` on `wrap-paragraph` rather than `map` to permit return of multiple elements
-      (append-map wrap-paragraph (append-map (λ (es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
+      (append-map wrap-paragraph
+                  (append-map (λ (es) (filter-split es paragraph-break?)) (slicef elements block-txexpr?))) ; split into ¶¶, using both implied and explicit paragraph breaks
       (if force-paragraph
-          (append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
+          ;; upconverts non-block elements to paragraphs
+          (append-map wrap-paragraph (slicef elements block-txexpr?)) 
           elements)))            
 
 (module-test-external
@@ -246,7 +257,6 @@
                '((p "foo") (div "bar") (div "zam")))
  (check-equal? (decode-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
                '((p "foo") (div "bar") (div "zam")))
- 
  (check-equal? (decode-paragraphs '("foo")) '("foo"))
  (check-equal? (decode-paragraphs '("foo") #:force? #t) '((p "foo")))
  (check-equal? (decode-paragraphs '((div "foo"))) '((div "foo")))

pollen/private/ts.rktd

@@ -1 +1 @@
-1540858423
+1540858426