indented code block test

3 files changed, 81 insertions, 14 deletions

diff --git a/README.md b/README.md
index 44425e8..1fb9903 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 # Market
 
-Market is a dialect of Markdown written in portable Scheme. It is designed
-to be easy to extend and understand.
+Market is an opinionated dialect of Markdown written in portable
+Scheme. It is designed to be easy to extend and understand.
 
 It is not a [CommonMark][1] parser. For a Scheme CommonMark parser, see
 [Guile CommonMark][2].
diff --git a/market/default.scm b/market/default.scm
index cbf02f9..0f0ecae 100644
--- a/market/default.scm
+++ b/market/default.scm
@@ -54,9 +54,9 @@
     ((line-member line '(#\* #\- #\+)) first-arg => check-rest)
     (else #f)))
 
-;;; ;;;;;;;;;;;;;;;;;;
-;;; Code blocks
-;;; ;;;;;;;;;;;;;;;;;;
+;;; ;;;;;;;;;;;;;;;;;;;;;
+;;; Indented code blocks
+;;; ;;;;;;;;;;;;;;;;;;;;;
 
 (define (code-block? x)
   (and (block-node? x) (eq? (node-data x) 'code-block)))
@@ -66,16 +66,15 @@
     (or (line-prefix line "    ")
         (line-prefix line #\tab)))
   (define (on-success line)
-    (let ((paragraph (string->xstring "")))
-      (values (make-block-node 'code-block
-                               continues-code-block
-                               always-false
-                               (list-queue paragraph)
-                               paragraph)
-              paragraph
-              line)))
+    (let* ((paragraph (string->xstring ""))
+           (node (make-block-node 'code-block
+                                  continues-code-block
+                                  always-false
+                                  (list-queue paragraph)
+                                  paragraph)))
+      (values node node line)))
   (cond
-    ((continues-code-block line) => starts-code-block)
+    ((continues-code-block line) => on-success)
     (else #f)))
 
 ;;; ;;;;;;;;;;;;;;;;;
diff --git a/tests/run.scm b/tests/run.scm
index d44abb8..550534d 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -250,3 +250,71 @@
                            (list-queue-list _)
                            (list-ref _ 0)
                            (xstring->string _)))))))
+
+(test-group "code blocks"
+  (test-group "single line, 4 spaces"
+    (let ((block (chain (parse->document "    (procedure? call/cc)" #f)
+                        (node-children _)
+                        (list-queue-list _)
+                        (list-ref _ 0))))
+      (test-assert "code-block?" (code-block? block))
+      (test-equal "text"
+                  "(procedure? call/cc)\n"
+                  (chain (node-children block)
+                         (list-queue-list _)
+                         (list-ref _ 0)
+                         (xstring->string _)))))
+  (test-group "single line, tab"
+    (let ((block (chain (parse->document "\t(procedure? call/cc)" #f)
+                        (node-children _)
+                        (list-queue-list _)
+                        (list-ref _ 0))))
+      (test-assert "code-block?" (code-block? block))
+      (test-equal "text"
+                  "(procedure? call/cc)\n"
+                  (chain (node-children block)
+                         (list-queue-list _)
+                         (list-ref _ 0)
+                         (xstring->string _)))))
+  (test-group "multiple lines, mixing"
+    (let ((str (chain (parse->document "    (lambda (x)" #f)
+                      (parse->document "\t  x)" _)
+                      (node-children _)
+                      (list-queue-list _)
+                      (list-ref _ 0)
+                      (node-children _)
+                      (list-queue-list _)
+                      (list-ref _ 0)
+                      (xstring->string _))))
+      (test-equal "text"
+                  "(lambda (x)\n  x)\n"
+                  str)))
+  (test-group "no quotes in code blocks"
+    (let ((first-child (chain (parse->document "    > not a block" #f)
+                              (node-children _)
+                              (list-queue-list _)
+                              (list-ref _ 0)
+                              (node-children _)
+                              (list-queue-list _)
+                              (list-ref _ 0))))
+      (test-assert "xstring" (xstring? first-child))
+      (test-equal "text"
+                  "> not a block\n"
+                  (xstring->string first-child))))
+  (test-group "code block in quotes"
+    (let ((node (chain (parse->document ">     quoted code" #f)
+                       (node-children _)
+                       (list-queue-list _)
+                       (list-ref _ 0))))
+      (test-assert "block-quote?" (block-quote? node))
+      (set! node (chain (node-children node)
+                        (list-queue-list _)
+                        (list-ref _ 0)))
+      (test-assert "code-block?" (code-block? node))
+      (set! text (chain (node-children node)
+                        (list-queue-list _)
+                        (list-ref _ 0)
+                        (xstring->string _)))
+      (test-equal "text"
+                  "quoted code\n"
+                  text))))