Add support for table

markdown/parse.rkt

@@ -849,6 +849,153 @@
                       (add-linkref! label (cons src title))
                       "")))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Table
+
+;; Don't spend the time to find a table spec, just rush on the first thing
+;; found:
+;; https://github.com/adam-p/markdown-here/wiki/Markdown-Cheatsheet#tables
+;;
+;; Seems ok with github version:
+;; https://help.github.com/articles/github-flavored-markdown/#tables
+
+(define $table-cell
+  (let ([$cell-str
+         (pdo (cs <- (many1 (<?> (noneOf (string-append "|" "\n"))
+                                 "table cell char")))
+              (return (string-trim (list->string cs))))]
+        [$cell-inner (manyTill $inline $newline)])
+    (pdo
+     (cell <- $cell-str)
+     (return (parse-result $cell-inner (string-append cell "\n\n"))))))
+
+(define $table-sep (char #\|))
+(define $table-end (pdo-seq (many (<or> (char #\space) (char #\tab))) (char #\newline)))
+
+(define $table-line
+  (let ([$table-line-compact
+         (pdo-seq
+          (~ (many (char #\space)))
+          $table-cell
+          (many1Till (pdo-one $table-sep (~> $table-cell))
+                     (try $table-end))
+          #:combine-with (lambda (x y) (list* 'compact x y)))]
+        [$table-line-bordered
+         (pdo-seq
+          (~ (many (char #\space)))
+          (~ $table-sep)
+          (many1Till (pdo-one (~> $table-cell) $table-sep)
+                     (try $table-end))
+          #:combine-with (lambda (x) (cons 'bordered x)))])
+    (<or> (try $table-line-bordered) $table-line-compact)))
+
+(module+ test
+  (check-equal?
+   (parse-result $table-line (open-input-string "| abc | edf |  \n"))
+   '(bordered ("abc") ("edf")))
+  (check-equal?
+   (parse-result $table-line (open-input-string " | a | b | \n"))
+   '(bordered ("a") ("b")))
+  (check-equal?
+   (parse-result $table-line (open-input-string " a | b \n"))
+   '(compact ("a") ("b"))))
+
+(define $table-separator
+  (let* ([$table-separator-cell
+          (let ([$: (char #\:)]
+                [$- (char #\-)])
+            (pdo-seq (~ (<or> (char #\space) (return null)))
+                     (<or> $- $:) $- (many $-) (<or> $: (return null))
+                     (~ (<or> (char #\space) (return null)))
+                     #:combine-with (lambda x
+                                      (case (list (eq? (first x) #\:) (eq? (last x) #\:))
+                                        [((#t #t)) 'center]
+                                        [((#f #t)) 'right]
+                                        [((#t #f)) 'left]
+                                        [else 'unknown]))))]
+         [$table-separator-compact
+          (pdo-seq
+           (~ (many (char #\space)))
+           $table-separator-cell
+           (many1Till (pdo-one $table-sep (~> $table-separator-cell))
+                      (try $table-end))
+           #:combine-with (lambda (x y) (list* 'compact x y)))]
+         [$table-separator-bordered
+          (pdo-seq
+           (~ (many (char #\space)))
+           (~ $table-sep)
+           (many1Till (pdo-one (~> $table-separator-cell) $table-sep)
+                      (try $table-end))
+           #:combine-with (lambda (x) (cons 'bordered x)))])
+    (<or> (try $table-separator-bordered) $table-separator-compact)))
+
+(module+ test
+  (check-equal?
+   (parse-result $table-separator (open-input-string "---|:--|--:\n"))
+   '(compact unknown left right))
+  (check-equal?
+   (parse-result $table-separator (open-input-string "|---|:--|\n"))
+   '(bordered unknown left)))
+
+
+;; TODO: Fail if the number of column per line is not the same, the separator
+;; specify the number of column. Beware the column that are empty at the
+;; begining of a row in compact formating.
+;;
+;; TODO: Fail if the style of line differ between line (bordered or compact),
+;; the separator line specify the style.
+;;
+;; TODO: Currentrly every row should end with a newline, but there is the case
+;; where the last row could end on eof.
+(define $table
+  (try
+   (pdo
+    (header <- $table-line)
+    (separator <- $table-separator)
+    (rows <- (many1 $table-line))
+    (many $blank-line)
+    (return
+     (let ([html-align
+            (lambda (x)
+              (case x
+                [(center) '(align "center")]
+                [(left) '(align "left")]
+                [(right) '(align "right")]
+                [else '()]))])
+       `(table ()
+               (thead ()
+                      (tr ()
+                          ,@(for/list ([cell (rest header)]
+                                       [align (rest separator)])
+                              `(th ,(html-align align) ,@cell))))
+               (tbody ()
+                      ,@(for/list ([row rows])
+                          `(tr ()
+                               ,@(for/list ([cell (rest row)]
+                                            [align (rest separator)])
+                                   `(td ,(html-align align) ,@cell)))))))))))
+
+(module+ test
+  (check-equal?
+   (parse-result $table
+                 (open-input-string
+                  "| batiment | véhicule      | animaux |
+                   | -------: | :------------ | ------- |
+                   | maison   | ba<i>te</i>au | cheval  |
+                   | garage   | voi _tu_ re   | vache   |
+"))
+   '(table
+     ()
+     (thead
+      ()
+      (tr () (th (align "right") "batiment") (th (align "left") "véhicule") (th () "animaux")))
+     (tbody
+      ()
+      (tr () (td (align "right") "maison") (td (align "left") "ba" (i () (SPLICE "te")) "au") (td () "cheval"))
+      (tr () (td (align "right") "garage") (td (align "left") "voi" " " (em () "tu") " " "re") (td () "vache"))))))
+
+
 ;;----------------------------------------------------------------------
 ;; list blocks
 ;;
@@ -948,7 +1095,8 @@
 (define $list (<or> $ordered-list $bullet-list))
 
 (define $block
-  (<?> (<or> $atx-heading
+  (<?> (<or> (unless-strict $table)
+             $atx-heading
              $blockquote
              $verbatim/indent
              (unless-strict $verbatim/fenced)

markdown/test/test.html

@@ -112,6 +112,29 @@ <h2 id="heading-level-2">Heading level 2</h2>
     <td>Row 2 Col 2</td></tr></table>
   <p>Here is <code>&lt;span style="font-weight:bold"&gt;span&lt;/span&gt;</code> &mdash; <span style="font-weight:bold">span</span> &mdash; in the middle of a sentence.</p>
   <pre><code>code block</code></pre><!-- more-->
+  <table>
+   <thead>
+    <tr>
+     <th>head A</th>
+     <th>head B</th></tr></thead>
+   <tbody>
+    <tr>
+     <td>cell A</td>
+     <td>cell B</td></tr></tbody></table>
+  <p>The other table style</p>
+  <table>
+   <thead>
+    <tr>
+     <th>
+      <i>head A</i></th>
+     <th>
+      <i>head B</i></th>
+     <th><em>head C</em></th></tr></thead>
+   <tbody>
+    <tr>
+     <td>cell A</td>
+     <td>cell B</td>
+     <td>cell C</td></tr></tbody></table>
   <p>Some text.</p>
   <p>The end.</p>
   <div class="footnotes">

markdown/test/test.md

@@ -188,6 +188,16 @@ code block
 
 <!-- more -->
 
+| head A | head B |
+| ------ | ------ |
+| cell A | cell B |
+
+The other table style
+
+<i>head A</i> | <i>head B</i> | *head C*
+------------- | ------------- | --------
+cell A        | cell B        | cell C
+
 Some text.
 
 The end.