From c65f4d500c4b96d4843599b41f014e9b82526cd4 Mon Sep 17 00:00:00 2001 From: Antoine Brand Date: Wed, 18 Nov 2015 23:06:52 +0100 Subject: [PATCH 1/4] Add support for table --- markdown/parse.rkt | 181 +++++++++++++++++++++++++++++++++++++++- markdown/test/test.html | 9 ++ markdown/test/test.md | 4 + 3 files changed, 193 insertions(+), 1 deletion(-) diff --git a/markdown/parse.rkt b/markdown/parse.rkt index 60d29ee..1f9abdb 100644 --- a/markdown/parse.rkt +++ b/markdown/parse.rkt @@ -849,6 +849,184 @@ (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 (~a space-chars special-chars "|" "\n")) + $escaped-char) + "normal char"))) + (val <- (return (list->string cs))) + (pos <- (getPosition)) + (setState 'last-$str-pos pos) + (setState 'last-$str-val val) + (return val))]) + (pdo + (cell <- + (many + ( + $cell-str + $whitespace + (unless-strict $smart-punctuation) + $code + $strong + $emph + (unless-strict $footnote-ref) + (parse-unless ignore-inline-links? $link) + $image/inline + (parse-unless ignore-inline-links? $autolink) ;before html + $html/inline + $entity + $special))) + (return (let loop ([parts cell] + [result '()]) + (cond [(empty? parts) (reverse result)] + [(and (string? (first parts)) + (not (empty? result)) + (string? (first result))) + (loop + (rest parts) + (cons + (string-append (first result) (first parts)) + (rest result)))] + [else + (loop (rest parts) (cons (first parts) result))])))))) + +(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 | voiture | vache | +")) + '(table + () + (thead + () + (tr () (th (align "right") " batiment ") (th (align "left") " véhicule ") (th () " animaux "))) + (tbody + () + (tr () (td (align "right") " maison ") (td (align "left") " bateau ") (td () " cheval ")) + (tr () (td (align "right") " garage ") (td (align "left") " voiture ") (td () " vache ")))))) + + ;;---------------------------------------------------------------------- ;; list blocks ;; @@ -948,7 +1126,8 @@ (define $list ( $ordered-list $bullet-list)) (define $block - ( ( $atx-heading + ( ( $table + $atx-heading $blockquote $verbatim/indent (unless-strict $verbatim/fenced) diff --git a/markdown/test/test.html b/markdown/test/test.html index 542bdac..d12ed84 100644 --- a/markdown/test/test.html +++ b/markdown/test/test.html @@ -112,6 +112,15 @@

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 A head B
cell A cell B

Some text.

The end.

diff --git a/markdown/test/test.md b/markdown/test/test.md index 7d1f1e2..4fa154e 100644 --- a/markdown/test/test.md +++ b/markdown/test/test.md @@ -188,6 +188,10 @@ code block +| head A | head B | +| ------ | ------ | +| cell A | cell B | + Some text. The end. From 54bec45e9119430ed4087c2ae08614bdff166d2d Mon Sep 17 00:00:00 2001 From: Antoine Brand Date: Fri, 20 Nov 2015 20:01:25 +0100 Subject: [PATCH 2/4] Make sure every -cell didn't have any #\newline or #\| --- markdown/parse.rkt | 64 +++++++++++++++++++++++----------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/markdown/parse.rkt b/markdown/parse.rkt index 1f9abdb..8a606a2 100644 --- a/markdown/parse.rkt +++ b/markdown/parse.rkt @@ -861,33 +861,33 @@ ;; https://help.github.com/articles/github-flavored-markdown/#tables (define $table-cell - (let ([$cell-str - (pdo (cs <- (many1 ( ( (noneOf (~a space-chars special-chars "|" "\n")) - $escaped-char) - "normal char"))) - (val <- (return (list->string cs))) - (pos <- (getPosition)) - (setState 'last-$str-pos pos) - (setState 'last-$str-val val) - (return val))]) + (let* ([$cell-str + (pdo (cs <- (many1 ( ( (noneOf (string-append "|" "\n")) + $escaped-char) + "normal char"))) + (return (list->string cs)))] + [$cell-inner + (many + ( + $whitespace + (unless-strict $smart-punctuation) + $code + $strong + $emph + (unless-strict $footnote-ref) + (parse-unless ignore-inline-links? $link) + $image/inline + (parse-unless ignore-inline-links? $autolink) ;before html + $html/inline + $entity + $special + (pdo + (cs <- (many1 ( (noneOf (~a space-chars special-chars "|" "\n")) + $escaped-char))) + (return (list->string cs)))))]) (pdo - (cell <- - (many - ( - $cell-str - $whitespace - (unless-strict $smart-punctuation) - $code - $strong - $emph - (unless-strict $footnote-ref) - (parse-unless ignore-inline-links? $link) - $image/inline - (parse-unless ignore-inline-links? $autolink) ;before html - $html/inline - $entity - $special))) - (return (let loop ([parts cell] + (cell <- $cell-str) + (return (let loop ([parts (parse-result $cell-inner (open-input-string (string-append cell "\n\n")))] [result '()]) (cond [(empty? parts) (reverse result)] [(and (string? (first parts)) @@ -1011,10 +1011,10 @@ (check-equal? (parse-result $table (open-input-string - "| batiment | véhicule | animaux | - | -------: | :------- | ------- | - | maison | bateau | cheval | - | garage | voiture | vache | + "| batiment | véhicule | animaux | + | -------: | :------------ | ------- | + | maison | bateau | cheval | + | garage | voi _tu_ re | vache | ")) '(table () @@ -1023,8 +1023,8 @@ (tr () (th (align "right") " batiment ") (th (align "left") " véhicule ") (th () " animaux "))) (tbody () - (tr () (td (align "right") " maison ") (td (align "left") " bateau ") (td () " cheval ")) - (tr () (td (align "right") " garage ") (td (align "left") " voiture ") (td () " vache ")))))) + (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 ")))))) ;;---------------------------------------------------------------------- From cf50f98439040cdce5ae407de4dab0bfa3af2b9c Mon Sep 17 00:00:00 2001 From: Antoine Brand Date: Fri, 27 Nov 2015 22:58:56 +0100 Subject: [PATCH 3/4] Add a test for compact table format. Add a condition to make table parsing unavailable in strict markdown. Trim whitespace in table cell parse result. Reuse the $inline parser to parse table cell. --- markdown/parse.rkt | 43 ++++++++++++----------------------------- markdown/test/test.html | 22 +++++++++++++++++---- markdown/test/test.md | 6 ++++++ 3 files changed, 36 insertions(+), 35 deletions(-) diff --git a/markdown/parse.rkt b/markdown/parse.rkt index 8a606a2..b2df34b 100644 --- a/markdown/parse.rkt +++ b/markdown/parse.rkt @@ -861,30 +861,11 @@ ;; https://help.github.com/articles/github-flavored-markdown/#tables (define $table-cell - (let* ([$cell-str - (pdo (cs <- (many1 ( ( (noneOf (string-append "|" "\n")) - $escaped-char) - "normal char"))) - (return (list->string cs)))] - [$cell-inner - (many - ( - $whitespace - (unless-strict $smart-punctuation) - $code - $strong - $emph - (unless-strict $footnote-ref) - (parse-unless ignore-inline-links? $link) - $image/inline - (parse-unless ignore-inline-links? $autolink) ;before html - $html/inline - $entity - $special - (pdo - (cs <- (many1 ( (noneOf (~a space-chars special-chars "|" "\n")) - $escaped-char))) - (return (list->string cs)))))]) + (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 (let loop ([parts (parse-result $cell-inner (open-input-string (string-append cell "\n\n")))] @@ -924,13 +905,13 @@ (module+ test (check-equal? (parse-result $table-line (open-input-string "| abc | edf | \n")) - '(bordered (" abc ") (" edf "))) + '(bordered ("abc") ("edf"))) (check-equal? (parse-result $table-line (open-input-string " | a | b | \n")) - '(bordered (" a ") (" b "))) + '(bordered ("a") ("b"))) (check-equal? (parse-result $table-line (open-input-string " a | b \n")) - '(compact ("a ") (" b ")))) + '(compact ("a") ("b")))) (define $table-separator (let* ([$table-separator-cell @@ -1020,11 +1001,11 @@ () (thead () - (tr () (th (align "right") " batiment ") (th (align "left") " véhicule ") (th () " animaux "))) + (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 ")))))) + (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")))))) ;;---------------------------------------------------------------------- @@ -1126,7 +1107,7 @@ (define $list ( $ordered-list $bullet-list)) (define $block - ( ( $table + ( ( (unless-strict $table) $atx-heading $blockquote $verbatim/indent diff --git a/markdown/test/test.html b/markdown/test/test.html index d12ed84..c1260e7 100644 --- a/markdown/test/test.html +++ b/markdown/test/test.html @@ -115,12 +115,26 @@

Heading level 2

- - + + - -
head A head B
head Ahead B
cell A cell B
+ cell A + cell 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 4fa154e..a1548e1 100644 --- a/markdown/test/test.md +++ b/markdown/test/test.md @@ -192,6 +192,12 @@ code block | ------ | ------ | | cell A | cell B | +The other table style + +head A | head B | *head C* +------------- | ------------- | -------- +cell A | cell B | cell C + Some text. The end. From 56ebaaf2612e98f49be799d8b4bcc4c352c10d0d Mon Sep 17 00:00:00 2001 From: Antoine Brand Date: Mon, 30 Nov 2015 22:44:10 +0100 Subject: [PATCH 4/4] Remove premature normalisation of data in $table-cell --- markdown/parse.rkt | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/markdown/parse.rkt b/markdown/parse.rkt index b2df34b..786a806 100644 --- a/markdown/parse.rkt +++ b/markdown/parse.rkt @@ -868,19 +868,7 @@ [$cell-inner (manyTill $inline $newline)]) (pdo (cell <- $cell-str) - (return (let loop ([parts (parse-result $cell-inner (open-input-string (string-append cell "\n\n")))] - [result '()]) - (cond [(empty? parts) (reverse result)] - [(and (string? (first parts)) - (not (empty? result)) - (string? (first result))) - (loop - (rest parts) - (cons - (string-append (first result) (first parts)) - (rest result)))] - [else - (loop (rest parts) (cons (first parts) result))])))))) + (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))) @@ -1005,7 +993,7 @@ (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")))))) + (tr () (td (align "right") "garage") (td (align "left") "voi" " " (em () "tu") " " "re") (td () "vache")))))) ;;----------------------------------------------------------------------