add #:force? option to `detect-paragraphs`

decode.rkt

@@ -69,16 +69,16 @@
 
 
 (define+provide/contract (decode-elements elements
-                                 #:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)]
+                                          #:txexpr-tag-proc [txexpr-tag-proc (λ(x)x)]
-                                 #:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)]
+                                          #:txexpr-attrs-proc [txexpr-attrs-proc (λ(x)x)]
-                                 #:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)]
+                                          #:txexpr-elements-proc [txexpr-elements-proc (λ(x)x)]
-                                 #:block-txexpr-proc [block-txexpr-proc (λ(x)x)]
+                                          #:block-txexpr-proc [block-txexpr-proc (λ(x)x)]
-                                 #:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)]
+                                          #:inline-txexpr-proc [inline-txexpr-proc (λ(x)x)]
-                                 #:string-proc [string-proc (λ(x)x)]
+                                          #:string-proc [string-proc (λ(x)x)]
-                                 #:symbol-proc [symbol-proc (λ(x)x)]
+                                          #:symbol-proc [symbol-proc (λ(x)x)]
-                                 #:valid-char-proc [valid-char-proc (λ(x)x)]
+                                          #:valid-char-proc [valid-char-proc (λ(x)x)]
-                                 #:cdata-proc [cdata-proc (λ(x)x)]
+                                          #:cdata-proc [cdata-proc (λ(x)x)]
-                                 #:exclude-tags [excluded-tags '()])
+                                          #:exclude-tags [excluded-tags '()])
   ((txexpr-elements?)  
    (#:txexpr-tag-proc (txexpr-tag? . -> . txexpr-tag?)
                       #:txexpr-attrs-proc (txexpr-attrs? . -> . txexpr-attrs?)
@@ -94,17 +94,17 @@
   (define temp-tag (gensym "temp-tag"))
   (define decode-result (decode `(temp-tag ,@elements)
                                 #:txexpr-tag-proc txexpr-tag-proc
-                                 #:txexpr-attrs-proc txexpr-attrs-proc
+                                #:txexpr-attrs-proc txexpr-attrs-proc
-                                 #:txexpr-elements-proc txexpr-elements-proc
+                                #:txexpr-elements-proc txexpr-elements-proc
-                                 #:block-txexpr-proc block-txexpr-proc
+                                #:block-txexpr-proc block-txexpr-proc
-                                 #:inline-txexpr-proc inline-txexpr-proc
+                                #:inline-txexpr-proc inline-txexpr-proc
-                                 #:string-proc string-proc
+                                #:string-proc string-proc
-                                 #:symbol-proc symbol-proc
+                                #:symbol-proc symbol-proc
-                                 #:valid-char-proc valid-char-proc
+                                #:valid-char-proc valid-char-proc
-                                 #:cdata-proc cdata-proc
+                                #:cdata-proc cdata-proc
-                                 #:exclude-tags excluded-tags))
+                                #:exclude-tags excluded-tags))
   (get-elements decode-result))
-  
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -334,23 +334,26 @@
 ;; todo: unit tests
 (define+provide/contract (detect-paragraphs elements #:tag [tag 'p]
                                             #:separator [sep world:paragraph-separator]
-                                            #:linebreak-proc [linebreak-proc detect-linebreaks])
+                                            #:linebreak-proc [linebreak-proc detect-linebreaks]
-  ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?)) 
+                                            #:force? [force-paragraph #f])
+  ((txexpr-elements?) (#:tag symbol? #:separator string? #:linebreak-proc (txexpr-elements? . -> . txexpr-elements?) #:force? boolean?) 
                       . ->* . txexpr-elements?)
   
   ;; prepare elements for paragraph testing
-  (define (prep-paragraph-flow xc)
+  (define (prep-paragraph-flow elems)
-    (linebreak-proc (merge-newlines (trimf xc whitespace?))))
+    (linebreak-proc (merge-newlines (trimf elems whitespace?))))
   
   (define my-paragraph-break? (λ(x) (and (paragraph-break? x #:separator sep) #t)))
   
-  (define (wrap-paragraph xc) 
+  (define (wrap-paragraph elems) 
-    (match xc
+    (match elems
       [(list (? block-txexpr? bxs) ...) bxs] ; leave a series of block xexprs alone
-      [else (list (make-txexpr tag empty xc))])) ; otherwise wrap in p tag
+      [else (list (make-txexpr tag empty elems))])) ; otherwise wrap in p tag
   
   (let ([elements (prep-paragraph-flow elements)]) 
     (if (ormap my-paragraph-break? elements) ; need this condition to prevent infinite recursion
         ;; use append-map rather than map to permit return of multiple elements
         (append-map wrap-paragraph (filter-split elements my-paragraph-break?)) ; split into ¶¶
-        elements)))                
+        (if force-paragraph
+            (append-map wrap-paragraph (slicef elements block-txexpr?)) ; upconverts non-block elements to paragraphs
+            elements))))                

scribblings/decode.scrbl

@@ -327,7 +327,8 @@ Within @racket[_tagged-xexpr-elements], convert occurrences of @racket[_linebrea
 [elements txexpr-elements?]
 [#:separator paragraph-sep string? world:paragraph-separator]
 [#:tag paragraph-tag symbol? 'p]
-[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks])
+[#:linebreak-proc linebreak-proc (txexpr-elements? . -> . txexpr-elements?) detect-linebreaks]
+[#:force? force-paragraph? boolean? #f])
 txexpr-elements?]
 Find paragraphs within @racket[_elements] (as denoted by @racket[_paragraph-sep]) and wrap them with @racket[_paragraph-tag]. Also handle linebreaks using @racket[detect-linebreaks].
 
@@ -337,6 +338,8 @@ The @racket[_paragraph-tag] argument sets the tag used to wrap paragraphs.
 
 The @racket[_linebreak-proc] argument allows you to use a different linebreaking procedure other than the usual @racket[detect-linebreaks].
 
+The @racket[#:force?] option will wrap a paragraph tag around @racket[_elements], even if no paragraph break is found. If any @racket[_element] is already a @racket[block-txexpr?], it is skipped, but the remaining sequences of non-block @racket[_elements] are wrapped. The @racket[#:force?] option is useful for when you want to guarantee that you get a list of blocks.
+
 @examples[#:eval my-eval
 (detect-paragraphs '("First para" "\n\n" "Second para"))
 (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line"))
@@ -345,6 +348,8 @@ The @racket[_linebreak-proc] argument allows you to use a different linebreaking
 (detect-paragraphs '("First para" "\n\n" "Second para") #:tag 'ns:p)
 (detect-paragraphs '("First para" "\n\n" "Second para" "\n" "Second line")
 #:linebreak-proc (λ(x) (detect-linebreaks x #:insert '(newline))))
+(detect-paragraphs '("First" (span "para") (div "Block") "Second para") 
+#:force? #t)
 ]
 
 @defproc[

tests/tests-decode.rkt

@@ -54,6 +54,18 @@
 (check-equal? (detect-paragraphs '("foo" "\n\n" (div "bar") "\n\n" (div "zam")))
               '((p "foo") (div "bar") (div "zam")))
 
+(check-equal? (detect-paragraphs '("foo")) '("foo"))
+(check-equal? (detect-paragraphs '("foo") #:force? #t) '((p "foo")))
+(check-equal? (detect-paragraphs '((div "foo"))) '((div "foo")))
+(check-equal? (detect-paragraphs '((div "foo")) #:force? #t) '((div "foo")))
+(check-equal? (detect-paragraphs '("foo" (div "bar"))) '("foo" (div "bar")))
+(check-equal? (detect-paragraphs '("foo" (div "bar")) #:force? #t) '((p "foo") (div "bar")))
+(check-equal? (detect-paragraphs '("foo" (div "bar") "zam")) '("foo" (div "bar") "zam"))
+(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam")) '("foo" (span "zing") (div "bar") "zam"))
+(check-equal? (detect-paragraphs '("foo" (span "zing") (div "bar") "zam") #:force? #t) '((p "foo" (span "zing")) (div "bar") (p "zam")))
+
+
+
 (check-equal? (merge-newlines '(p "\n" "foo" "\n" "\n" "bar" (em "\n" "\n" "\n"))) 
               '(p "\n" "foo" "\n\n" "bar" (em "\n\n\n")))