diff --git a/markdown/parse.rkt b/markdown/parse.rkt index 60d29ee..786a806 100644 --- a/markdown/parse.rkt +++ b/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 ( (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)))]) + ( (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 (~ ( (char #\space) (return null))) + ( $- $:) $- (many $-) ( $: (return null)) + (~ ( (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)))]) + ( (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 | bateau | 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 ( $ordered-list $bullet-list)) (define $block - ( ( $atx-heading + ( ( (unless-strict $table) + $atx-heading $blockquote $verbatim/indent (unless-strict $verbatim/fenced) diff --git a/markdown/test/test.html b/markdown/test/test.html index 542bdac..c1260e7 100644 --- a/markdown/test/test.html +++ b/markdown/test/test.html @@ -112,6 +112,29 @@

Heading level 2

Row 2 Col 2

Here is <span style="font-weight:bold">span</span>span — in the middle of a sentence.

code block
+ + + + + + + + +
head Ahead B
cell Acell B
+

The other table style

+ + + + + + + + + + +
+ head A + head Bhead C
cell Acell Bcell C

Some text.

The end.

diff --git a/markdown/test/test.md b/markdown/test/test.md index 7d1f1e2..a1548e1 100644 --- a/markdown/test/test.md +++ b/markdown/test/test.md @@ -188,6 +188,16 @@ code block +| head A | head B | +| ------ | ------ | +| cell A | cell B | + +The other table style + +head A | head B | *head C* +------------- | ------------- | -------- +cell A | cell B | cell C + Some text. The end.