/- m=markdown :: => |% :: Set label for collapsed / shortcut reference links ++ backfill-ref-link |= [a=link:inline:m] ^- link:inline:m =/ t target.a ?+ -.t a :: only reference links %ref ?: =(%full type.t) a :: only collapsed / shortcut links =/ node=element:inline.m (head contents.a) ?+ -.node a :: ...and it's a %text node %text %_ a target %_ t label text.node == == == == :: ++ whitespace (mask " \09\0d\0a") :: whitespace: space, tab, or newline :: ++ all-link-ref-definitions :: Recursively get link ref definitions =< process-nodes |% ++ process-nodes |= [nodes=markdown:m] ^- (map @t urlt:ln:m) ?~ nodes ~ %- %~(uni by (process-node (head nodes))) $(nodes +.nodes) :: ++ process-nodeses |= [nodeses=(list markdown:m)] ^- (map @t urlt:ln:m) ?~ nodeses ~ %- %~(uni by (process-nodes (head nodeses))) $(nodeses +.nodeses) :: ++ process-node |= [node=node:markdown:m] ^- (map @t urlt:ln:m) =/ result *(map @t urlt:ln:m) ?- -.node %leaf :: Leaf node: check if it's a link ref def =/ leaf=node:leaf:m +.node ?+ -.leaf result %link-ref-definition (~(put by result) label.leaf urlt.leaf) == :: %container =/ container=node:container:m +.node ?- -.container %block-quote (process-nodes markdown.container) %ol (process-nodeses contents.container) %ul (process-nodeses contents.container) %tl (process-nodeses (turn contents.container |=([is-checked=? =markdown:m] markdown))) == == -- -- |% :: :: Parse to and from Markdown text format ++ md |% ++ de :: de:md Deserialize (parse) |% ++ escaped |= [char=@t] (cold char (jest (crip (snoc "\\" char)))) :: ++ newline %+ cold '\0a' :: EOL, with or without carriage return '\0d' ;~(pfix ;~(pose (just '\0d') (easy ~)) (just '\0a')) ++ line-end :: Either EOL or EOF %+ cold '\0a' ;~(pose newline (full (easy ~))) :: ++ ln :: Links and urls |% ++ url =< %+ cook |=(a=url:ln:m a) :: Cast ;~(pose with-triangles without-triangles) |% ++ with-triangles ;~ plug %+ cook crip %+ ifix [gal gar] %- star ;~ pose (escaped '<') (escaped '>') ;~(less gal gar line-end prn) :: Anything except '<', '>' or newline == (easy %.y) :: "yes triangles" == ++ without-triangles ;~ plug %+ cook crip ;~ less gal :: Doesn't start with '<' %- plus :: Non-empty ;~ less whitespace :: No whitespace allowed ;~ pose (escaped '(') (escaped ')') ;~(less pal par line-end prn) :: Anything except '(', ')' or newline == == == (easy %.n) :: "no triangles" == -- :: ++ urlt %+ cook |=(a=urlt:ln:m a) :: Cast ;~ plug url %- punt :: Optional title-text ;~ pfix (plus whitespace) :: Separated by some whitespace %+ cook crip ;~ pose :: Enclosed in single quote, double quote, or '(...)' (ifix [soq soq] (star ;~(pose (escaped '\'') ;~(less soq prn)))) (ifix [doq doq] (star ;~(pose (escaped '"') ;~(less doq prn)))) (ifix [pal par] (star ;~(pose (escaped '(') (escaped ')') ;~(less pal par prn)))) == == == :: :: Labels are used in inline link targets and in a block-level element (labeled link references) ++ label %+ cook crip %+ ifix [sel ser] :: Enclosed in '[...]' %+ ifix :- (star whitespace) :: Strip leading and trailing whitespapce (star whitespace) %- plus ;~ pose :: Non-empty (escaped '[') (escaped ']') ;~(less sel ser prn) :: Anything except '[', ']' (must be escaped) == :: ++ target :: Link target, either reference or direct =< %+ cook |=(a=target:ln:m a) ;~(pose target-direct target-ref) |% ++ target-direct %+ cook |=(a=target:ln:m a) %+ stag %direct %+ ifix [pal par] :: Direct links are enclosed in '(...)' %+ ifix :- (star whitespace) :: Strip leading and trailing whitespace (star whitespace) urlt :: Just the target ++ target-ref %+ cook |=(a=target:ln:m a) %+ stag %ref ;~ pose %+ stag %full label %+ stag %collapsed (cold '' (jest '[]')) %+ stag %shortcut (easy '') == -- -- ++ inline :: Inline elements |% ++ contents (cook |=(a=contents:inline:m a) (star element)) :: Element sequence ++ element :: Any element %+ cook |=(a=element:inline:m a) ;~ pose escape entity strong emphasis code link image autolink text softbrk hardbrk == :: ++ text %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape entity link image autolink emphasis strong code softbrk hardbrk :: ...etc prn == :: ++ escape %+ cook |=(a=escape:inline:m a) %+ stag %escape ;~ pose :: \!\"\#\$\%\&\'\(\)\*\+\,\-\.\/\:\;\<\=\>\?\@\[\\\]\^\_\`\{\|\}\~ (escaped '[') (escaped ']') (escaped '(') (escaped ')') (escaped '!') (escaped '*') (escaped '*') (escaped '_') (escaped '&') (escaped '\\') :: etc == ++ entity %+ cook |=(a=entity:inline:m a) %+ stag %entity %+ ifix [pam mic] %+ cook crip ;~ pose ;~(plug hax (stun [1 7] nud)) :: '#' and one to seven digits (plus alf) :: Named entity == :: ++ softbrk :: Newline %+ cook |=(a=softbrk:inline:m a) %+ stag %soft-line-break (cold ~ newline) :: ++ hardbrk %+ cook |=(a=hardbrk:inline:m a) %+ stag %line-break %+ cold ~ ;~ pose ;~(plug (jest ' ') (star ace) newline) :: Two or more spaces before a newline ;~(plug (just '\\') newline) :: An escaped newline == ++ link %+ knee *link:inline:m |. ~+ :: recurse %+ cook backfill-ref-link %+ stag %link ;~ plug %+ ifix [sel ser] :: Display text is wrapped in '[...]' %- star ;~ pose :: Display text can contain various contents escape entity emphasis strong code image :: Text: => %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape entity emphasis strong code ser :: No closing ']' prn == == target:ln == :: ++ image %+ cook |=(a=image:inline:m a) %+ stag %image ;~ plug %+ ifix [(jest '![') (just ']')] :: alt-text is wrapped in '![...]' %+ cook crip %- star ;~ pose (escaped ']') ;~(less ser prn) == target:ln == :: ++ autolink %+ cook |=(a=autolink:inline:m a) %+ stag %autolink %+ ifix [gal gar] :: Enclosed in '<...>' %+ cook crip %- star ;~ pose ;~(less ace gar prn) :: Spaces are not allowed; neither are backslash-escapes == :: ++ emphasis %+ knee *emphasis:inline:m |. ~+ :: recurse %+ cook |=(a=emphasis:inline:m a) %+ stag %emphasis ;~ pose %+ ifix [tar tar] ;~ plug (easy '*') %- plus ;~ pose :: Display text can contain various contents escape entity strong link autolink code image link softbrk hardbrk %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape entity strong link autolink code image link softbrk hardbrk :: tar :: If a '*', then it's the end of the `emphasis` :: prn == == == %+ ifix [cab cab] ;~ plug (easy '_') %- plus ;~ pose :: Display text can contain various contents escape entity strong link autolink code image link softbrk hardbrk %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape entity strong link autolink code image link softbrk hardbrk :: cab :: If a '*', then it's the end of the `emphasis` :: prn == == == == :: ++ strong %+ knee *strong:inline:m |. ~+ :: recurse %+ cook |=(a=strong:inline:m a) %+ stag %strong ;~ pose %+ ifix [(jest '**') (jest '**')] ;~ plug (easy '*') %- plus ;~ pose :: Display text can contain various contents escape emphasis link autolink code image link softbrk hardbrk %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape emphasis link autolink code image link softbrk hardbrk :: ...etc (jest '**') :: If a '**', then it's the end of the `emphasis` prn == == == %+ ifix [(jest '__') (jest '__')] ;~ plug (easy '_') %- plus ;~ pose :: Display text can contain various contents escape emphasis link autolink code image link softbrk hardbrk %+ knee *text:inline:m |. ~+ :: recurse %+ cook |=(a=text:inline:m a) %+ stag %text %+ cook crip %- plus :: At least one character ;~ less :: ...which doesn't match any other inline rule escape emphasis link autolink code image link softbrk hardbrk :: (jest '__') :: If a '**', then it's the end of the `emphasis` prn == == == == :: ++ code =< %+ cook |=(a=code:inline:m a) %+ stag %code-span inner-parser |% ++ inner-parser |= =nail =/ vex ((plus tic) nail) :: Read the first backtick string ?~ q.vex vex :: If no vex is found, fail =/ tic-sequence ^- tape p:(need q.vex) %. q:(need q.vex) %+ cook |= [a=tape] :: Attach the backtick length to it [(lent tic-sequence) (crip a)] ;~ sfix %+ cook |= [a=(list tape)] ^- tape (zing a) %- star ;~ pose %+ cook trip ;~(less tic prn) :: Any character other than a backtick %+ sear :: A backtick string that doesn't match the opener |= [a=tape] ^- (unit tape) ?: =((lent a) (lent tic-sequence)) ~ `a (plus tic) == (jest (crip tic-sequence)) :: Followed by a closing backtick string == -- -- :: ++ leaf |% ++ node %+ cook |=(a=node:leaf:m a) ;~ pose blank-line heading break codeblk-indent codeblk-fenced link-ref-def :: ...etc table paragraph == ++ blank-line %+ cook |=(a=blank-line:leaf:m a) %+ stag %blank-line (cold ~ newline) ++ heading =< %+ cook |=(a=heading:leaf:m a) %+ stag %heading ;~(pose atx setext) |% ++ atx =/ atx-eol ;~ plug (star ace) (star hax) (star ace) line-end == %+ stag %atx %+ cook :: Parse heading inline content |= [level=@ text=tape] [level (scan text contents:inline)] ;~ pfix (stun [0 3] ace) :: Ignore up to 3 leading spaces ;~ plug (cook |=(a=tape (lent a)) (stun [1 6] hax)) :: Heading level %+ ifix [(plus ace) atx-eol] :: One leading space is required; rest is ignored %- star ;~(less atx-eol prn) :: Trailing haxes/spaces are ignored == == ++ setext %+ stag %setext %+ cook |= [text=tape level=@] [level (scan text contents:inline)] ;~ plug :: Wow this is a mess %+ ifix [(stun [0 3] ace) (star ace)] :: Strip up to 3 spaces, and trailing space (star ;~(less ;~(pfix (star ace) newline) prn)) :: Any text... ;~ pfix newline :: ...followed by newline... (stun [0 3] ace) :: ...up to 3 spaces (stripped)... ;~ sfix ;~ pose :: ...and an underline (cold 1 (plus (just '-'))) :: Underlined by '-' means heading lvl 1 (cold 2 (plus (just '='))) :: Underlined by '=' means heading lvl 2 == (star ace) == == == -- ++ break %+ cook |=(a=break:leaf:m a) %+ stag %break %+ cook |= [first-2=@t trailing=tape] [(head trailing) (add 2 (lent trailing))] %+ ifix :- (stun [0 3] ace) :: Strip indent and trailing space ;~ plug (star (mask " \09")) newline :: No other chars allowed on the line == ;~ pose ;~(plug (jest '**') (plus tar)) :: At least 3, but can be more ;~(plug (jest '--') (plus hep)) ;~(plug (jest '__') (plus cab)) == :: ++ codeblk-indent %+ cook |=(a=codeblk-indent:leaf:m a) %+ stag %indent-codeblock %+ cook |=(a=(list tape) (crip (zing a))) %- plus :: 1 or more lines ;~ pfix (jest ' ') :: 4 leading spaces %+ cook snoc ;~ plug (star ;~(less line-end prn)) line-end == == :: ++ codeblk-fenced =+ |% :: Returns a 3-tuple: :: - indent size :: - char type :: - fence length ++ code-fence ;~ plug %+ cook |=(a=tape (lent a)) (stun [0 3] ace) %+ cook |=(a=tape [(head a) (lent a)]) :: Get code fence char and length ;~ pose (stun [3 999.999.999] sig) (stun [3 999.999.999] tic) == == :: ++ info-string %+ cook crip %+ ifix [(star ace) line-end] :: Strip leading whitespace (star ;~(less line-end tic prn)) :: No backticks in a code fence -- |* =nail :: Get the marker and indent size =/ vex (code-fence nail) ?~ q.vex vex :: If no match found, fail =/ [indent=@ char=@t len=@] p:(need q.vex) =/ closing-fence ;~ plug (star ace) (stun [len 999.999.999] (just char)) :: Closing fence must be at least as long as opener (star ace) :: ...and cannot have any following text except space line-end == :: Read the rest of the list item block %. q:(need q.vex) %+ cook |=(a=codeblk-fenced:leaf:m a) %+ stag %fenced-codeblock ;~ plug %+ cook |=(a=@t a) (easy char) (easy len) %+ cook |=(a=@t a) info-string (easy indent) %+ cook |=(a=(list tape) (crip (zing a))) ;~ sfix %- star :: Any amount of lines ;~ less closing-fence :: ...until the closing code fence ;~ pfix (stun [0 indent] ace) :: Strip indent up to that of the opening fence %+ cook |=(a=tape a) ;~ pose :: Avoid infinite loop at EOF %+ cook trip newline :: A line is either a blank line... %+ cook snoc ;~ plug :: Or a non-blank line (plus ;~(less line-end prn)) line-end == == == == ;~(pose closing-fence (full (easy ~))) == == :: ++ link-ref-def %+ cook |=(a=link-ref-def:leaf:m a) %+ stag %link-ref-definition %+ ifix [(stun [0 3] ace) line-end] :: Strip leading space ;~ plug ;~(sfix label:ln col) :: Label (enclosed in "[...]"), followed by col ":" ;~ pfix :: Optional whitespace, including up to 1 newline (star ace) (stun [0 1] newline) (star ace) urlt:ln == == :: ++ paragraph %+ cook |=(a=paragraph:leaf:m a) %+ stag %paragraph %+ cook :: Reparse the paragraph text as elements |= [a=(list tape)] (scan (zing a) contents:inline) %- plus :: Read lines until a non-paragraph object is found ;~ less heading break block-quote-line:container :: Block quotes can interrupt paragraphs %+ cook snoc ;~ plug %- plus ;~(less line-end prn) :: Lines must be non-empty line-end == == :: ++ table => |% +$ cell-t [len=@ =contents:inline:m] ++ row ;~ pfix bar :: A bar in front... %- star %+ cook :: compute the length and parse inlines |= [pfx=@ stuff=tape sfx=@] [;:(add pfx (lent stuff) sfx) (scan stuff contents:inline)] :: inline elements... ;~ plug (cook lent (star ace)) (star ;~(less newline ;~(plug (star ace) bar) prn)) (cook lent ;~(sfix (star ace) bar)) == == ++ delimiter-row ;~ pfix bar :: A bar in front... %- star %+ cook |= [pfx=@ lal=? heps=@ ral=? sfx=@] :- ;:(add pfx ?:(ral 1 0) heps ?:(lal 1 0) sfx) ?:(ral ?:(lal %c %r) ?:(lal %l %n)) ;~ plug (cook lent (star ace)) :: Delimiter: leading space... (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe a ':'... (cook lent (plus hep)) :: a bunch of '-'... (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe another ':'... (cook lent ;~(sfix (star ace) bar)) :: ..and a bar as a terminator == == -- |* =nail :: Make it a (redundant) gate so I can use `=>` to add a helper core %. nail :: apply the following parser %+ cook |= [hdr=(list cell-t) del=(list [len=@ al=?(%c %r %l %n)]) bdy=(list (list cell-t))] ^- table:leaf:m =/ widths=(list @) (turn del |=([len=@ al=*] len)) =/ rows=(list (list cell-t)) (snoc bdy hdr) :: since they're the same data type =/ computed-widths |- ?~ rows widths %= $ rows (tail rows) widths =/ row=(list cell-t) (head rows) |- ?~ row ~ :- (max (head widths) len:(head row)) %= $ widths (tail widths) row (tail row) == == :* %table computed-widths (turn hdr |=(cell=cell-t contents.cell)) (turn del |=([len=@ al=?(%c %r %l %n)] al)) (turn bdy |=(row=(list cell-t) (turn row |=(cell=cell-t contents.cell)))) == ;~ plug ;~(sfix row line-end) ;~(sfix delimiter-row line-end) (star ;~(sfix row line-end)) == -- :: ++ container =+ |% :: ++ line :: Read a line of plain text %+ cook |=([a=tape b=tape c=tape] ;:(weld a b c)) ;~ plug (star ;~(less line-end prn)) (cook trip line-end) (star newline) :: Can have blank lines in a list item == ++ block-quote-marker ;~ plug :: Single char '>' (stun [0 3] ace) :: Indented up to 3 spaces gar (stun [0 1] ace) :: Optionally followed by a space == ++ block-quote-line %+ cook snoc ;~ plug :: Single line... ;~ pfix block-quote-marker :: ...starting with ">..." (star ;~(less line-end prn)) :: can be empty == line-end == :: +$ ul-marker-t [indent=@ char=@t len=@] ++ ul-marker %+ cook :: Compute the length of the whole thing |= [prefix=tape bullet=@t suffix=tape] ^- ul-marker-t :* (lent prefix) bullet ;:(add 1 (lent prefix) (lent suffix)) == ;~ plug (stun [0 3] ace) ;~(pose hep lus tar) :: Bullet char (stun [1 4] ace) == :: :: Produces a 3-tuple: :: - bullet char (*, +, or -) :: - indent level (number of spaces before the bullet) :: - item contents (markdown) +$ ul-item-t [char=@t indent=@ =markdown:m] ++ ul-item |* =nail :: Get the marker and indent size =/ vex (ul-marker nail) ?~ q.vex vex :: If no match found, fail =/ mrkr=ul-marker-t p:(need q.vex) :: Read the rest of the list item block %. q:(need q.vex) %+ cook |= [a=(list tape)] ^- ul-item-t :* char.mrkr indent.mrkr (scan (zing a) markdown) == ;~ plug line :: First line %- star ;~ pfix :: Subsequent lines must have the same indent (stun [len.mrkr len.mrkr] ace) :: the indent line :: the line == == :: +$ ol-marker-t [indent=@ char=@t number=@ len=@] ++ ol-marker %+ cook :: Compute the length of the whole thing |= [prefix=tape number=@ char=@t suffix=tape] ^- ol-marker-t :* (lent prefix) char number ;:(add 1 (lent (a-co:co number)) (lent prefix) (lent suffix)) == ;~ plug (stun [0 3] ace) dem ;~(pose dot par) :: Bullet char (stun [1 4] ace) == :: :: Produces a 4-tuple: :: - delimiter char: either dot '.' or par ')' :: - list item number :: - indent level (number of spaces before the number) :: - item contents (markdown) +$ ol-item-t [char=@t number=@ indent=@ =markdown:m] ++ ol-item |* =nail ::^- edge :: Get the marker and indent size =/ vex (ol-marker nail) ?~ q.vex vex :: If no match found, fail =/ mrkr=ol-marker-t p:(need q.vex) :: Read the rest of the list item block %. q:(need q.vex) %+ cook |= [a=(list tape)] ^- ol-item-t :* char.mrkr number.mrkr indent.mrkr (scan (zing a) markdown) == ;~ plug line :: First line %- star ;~ pfix :: Subsequent lines must have the same indent (stun [len.mrkr len.mrkr] ace) :: the indent line :: the line == == :: ++ tl-checkbox ;~ pose %+ cold %.y (jest '[x]') %+ cold %.n (jest '[ ]') == :: :: Produces a 4-tuple: :: - bullet char (*, +, or -) :: - indent level (number of spaces before the bullet) :: - is-checked :: - item contents (markdown) +$ tl-item-t [char=@t indent=@ is-checked=? =markdown:m] ++ tl-item |* =nail :: Get the marker and indent size =/ vex (;~(plug ul-marker ;~(sfix tl-checkbox ace)) nail) ?~ q.vex vex :: If no match found, fail =/ [mrkr=ul-marker-t is-checked=?] p:(need q.vex) :: Read the rest of the list item block %. q:(need q.vex) %+ cook |= [a=(list tape)] ^- tl-item-t :* char.mrkr indent.mrkr is-checked (scan (zing a) markdown) == ;~ plug line :: First line %- star ;~ pfix :: Subsequent lines must have the same indent (stun [len.mrkr len.mrkr] ace) :: the indent line :: the line == == -- |% ++ node %+ cook |=(a=node:container:m a) ;~ pose block-quote tl ul ol == :: ++ block-quote %+ cook |=(a=block-quote:container:m a) %+ stag %block-quote %+ cook |= [a=(list tape)] (scan (zing a) markdown) ;~ plug block-quote-line %- star :: At least one line ;~ pose block-quote-line %+ cook zing %- plus :: Paragraph continuation (copied from `paragraph` above) ;~ less :: ...basically just text that doesn't matchZ anything else heading:leaf break:leaf :: ol :: ul block-quote-marker :: Can't start with ">" line-end :: Can't be blank %+ cook snoc ;~ plug %- star ;~(less line-end prn) line-end == == == == :: ++ ul |* =nail :: Start by finding the type of the first bullet (indent level and bullet char) =/ vex (ul-item nail) ?~ q.vex vex :: Fail if it doesn't match a list item =/ first-item=ul-item-t p:(need q.vex) :: Check for more list items %. q:(need q.vex) %+ cook |=(a=ul:container:m a) %+ stag %ul ;~ plug :: Give the first item, first (easy indent.first-item) (easy char.first-item) (easy markdown.first-item) %- star %+ sear :: Reject items that don't have the same bullet char |= [item=ul-item-t] ^- (unit markdown:m) ?. =(char.item char.first-item) ~ `markdown.item ul-item == :: ++ ol |* =nail :: Start by finding the first number, char, and indent level =/ vex (ol-item nail) ?~ q.vex vex :: Fail if it doesn't match a list item =/ first-item=ol-item-t p:(need q.vex) :: Check for more list items %. q:(need q.vex) %+ cook |=(a=ol:container:m a) %+ stag %ol ;~ plug :: Give the first item, first (easy indent.first-item) (easy char.first-item) (easy number.first-item) (easy markdown.first-item) %- star %+ sear :: Reject items that don't have the same delimiter |= [item=ol-item-t] ^- (unit markdown:m) ?. =(char.item char.first-item) ~ `markdown.item ol-item == :: ++ tl |* =nail :: Start by finding the type of the first bullet (indent level and bullet char) =/ vex (tl-item nail) ?~ q.vex vex :: Fail if it doesn't match a list item =/ first-item=tl-item-t p:(need q.vex) :: Check for more list items %. q:(need q.vex) %+ cook |=(a=tl:container:m a) %+ stag %tl ;~ plug :: Give the first item, first (easy indent.first-item) (easy char.first-item) (easy [is-checked.first-item markdown.first-item]) %- star %+ sear :: Reject items that don't have the same bullet char |= [item=tl-item-t] ^- (unit [is-checked=? markdown:m]) ?. =(char.item char.first-item) ~ `[is-checked.item markdown.item] tl-item == -- :: ++ markdown %+ cook |=(a=markdown:m a) %- star ;~ pose (stag %container node:container) (stag %leaf node:leaf) == -- :: :: Enserialize (write out as text) ++ en |% ++ escape-chars |= [text=@t chars=(list @t)] ^- tape %+ rash text %+ cook |=(a=(list tape) `tape`(zing a)) %- star ;~ pose (cook |=(a=@t `tape`~['\\' a]) (mask chars)) (cook trip prn) == :: ++ ln |% ++ url =< |= [u=url:ln:m] ^- tape ?: has-triangle-brackets.u (with-triangles text.u) (without-triangles text.u) |% ++ with-triangles |= [text=@t] ;: weld "<" :: Put it inside triangle brackets (escape-chars text "<>") :: Escape triangle brackets in the text ">" == ++ without-triangles |= [text=@t] (escape-chars text "()") :: Escape all parentheses '(' and ')' -- ++ urlt |= [u=urlt:ln:m] ^- tape ?~ title-text.u :: If there's no title text, then it's just an url (url url.u) ;:(weld (url url.u) " \"" (escape-chars (need title-text.u) "\"") "\"") ++ label |= [text=@t] ^- tape ;:(weld "[" (escape-chars text "[]") "]") ++ target |= [t=target:ln:m] ^- tape ?- -.t %direct ;:(weld "(" (urlt urlt.t) ")") :: Wrap in parentheses :: %ref ?- type.t %full (label label.t) %collapsed "[]" %shortcut "" == == -- :: ++ inline |% ++ contents |= [=contents:inline:m] ^- tape %- zing %+ turn contents element ++ element |= [e=element:inline:m] ?+ -.e !! %text (text e) %link (link e) %escape (escape e) %entity (entity e) %code-span (code e) %strong (strong e) %emphasis (emphasis e) %soft-line-break (softbrk e) %line-break (hardbrk e) %image (image e) %autolink (autolink e) :: ...etc == ++ text |= [t=text:inline:m] ^- tape (trip text.t) :: So easy! :: ++ entity |= [e=entity:inline:m] ^- tape ;:(weld "&" (trip code.e) ";") :: ++ link |= [l=link:inline:m] ^- tape ;: weld "[" (contents contents.l) "]" (target:ln target.l) == :: ++ image |= [i=image:inline:m] ^- tape ;: weld "![" (escape-chars alt-text.i "]") "]" (target:ln target.i) == :: ++ autolink |= [a=autolink:inline:m] ^- tape ;: weld "<" (trip text.a) ">" == :: ++ escape |= [e=escape:inline:m] ^- tape (snoc "\\" char.e) :: Could use `escape-chars` but why bother-- this is shorter :: ++ softbrk |= [s=softbrk:inline:m] ^- tape "\0a" ++ hardbrk |= [h=hardbrk:inline:m] ^- tape "\\\0a" ++ code |= [c=code:inline:m] ^- tape ;:(weld (reap num-backticks.c '`') (trip text.c) (reap num-backticks.c '`')) :: ++ strong |= [s=strong:inline:m] ^- tape ;: weld (reap 2 emphasis-char.s) (contents contents.s) (reap 2 emphasis-char.s) == :: ++ emphasis |= [e=emphasis:inline:m] ^- tape ;: weld (trip emphasis-char.e) (contents contents.e) (trip emphasis-char.e) == -- :: ++ leaf |% ++ node |= [n=node:leaf:m] ?+ -.n !! %blank-line (blank-line n) %break (break n) %heading (heading n) %indent-codeblock (codeblk-indent n) %fenced-codeblock (codeblk-fenced n) %link-ref-definition (link-ref-def n) %paragraph (paragraph n) %table (table n) :: ...etc == ++ blank-line |= [b=blank-line:leaf:m] ^- tape "\0a" :: ++ break |= [b=break:leaf:m] ^- tape (weld (reap char-count.b char.b) "\0a") :: ++ heading |= [h=heading:leaf:m] ^- tape ?- style.h %atx ;:(weld (reap level.h '#') " " (contents:inline contents.h) "\0a") %setext =/ line (contents:inline contents.h) ;:(weld line "\0a" (reap (lent line) ?:(=(level.h 1) '-' '=')) "\0a") == :: ++ codeblk-indent |= [c=codeblk-indent:leaf:m] ^- tape %+ rash text.c %+ cook |= [a=(list tape)] ^- tape %- zing %+ turn a |=(t=tape (weld " " t)) %- plus %+ cook snoc ;~(plug (star ;~(less (just '\0a') prn)) (just '\0a')) :: ++ codeblk-fenced |= [c=codeblk-fenced:leaf:m] ^- tape ;: weld (reap indent-level.c ' ') (reap char-count.c char.c) (trip info-string.c) "\0a" ^- tape %+ rash text.c %+ cook zing %- star :: Many lines %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " ^- tape ;: weld ?~(a "" (reap indent-level.c ' ')) :: If the line is blank, no indent a "\0a" == ;~ plug :: Break into lines (star ;~(less (just '\0a') prn)) (just '\0a') == (reap indent-level.c ' ') (reap char-count.c char.c) "\0a" == :: ++ link-ref-def |= [l=link-ref-def:leaf:m] ^- tape ;: weld "[" (trip label.l) "]: " (urlt:ln urlt.l) "\0a" == :: ++ table => |% ++ cell |= [width=@ c=contents:inline:m] ^- tape =/ contents-txt (contents:inline c) ;: weld " " contents-txt (reap (sub width (add 1 (lent contents-txt))) ' ') "|" == ++ row |= [widths=(list @) cells=(list contents:inline:m)] ^- tape ;: weld "|" |- ^- tape ?~ widths ~ %+ weld (cell (head widths) (head cells)) $(widths (tail widths), cells (tail cells)) "\0a" == ++ delimiter-row |= [widths=(list @) align=(list ?(%l %c %r %n))] ^- tape ;: weld "|" |- ^- tape ?~ align ~ ;: weld " " ?- (head align) %l (weld ":" (reap ;:(sub (head widths) 3) '-')) %r (weld (reap ;:(sub (head widths) 3) '-') ":") %c ;:(weld ":" (reap ;:(sub (head widths) 4) '-') ":") %n (reap ;:(sub (head widths) 2) '-') == " |" $(align (tail align), widths (tail widths)) == "\0a" == -- |= [t=table:leaf:m] ^- tape ;: weld (row widths.t head.t) (delimiter-row widths.t align.t) =/ rows rows.t |- ^- tape ?~ rows ~ %+ weld (row widths.t (head rows)) $(rows (tail rows)) == :: ++ paragraph |= [p=paragraph:leaf:m] ^- tape (contents:inline contents.p) -- :: ++ container => |% ++ line %+ cook snoc ;~ plug (star ;~(less (just '\0a') prn)) (just '\0a') == -- |% ++ node |= [n=node:container:m] ?- -.n %block-quote (block-quote n) %ul (ul n) %ol (ol n) %tl (tl n) == :: ++ block-quote |= [b=block-quote:container:m] ^- tape %+ scan (markdown markdown.b) :: First, render the contents %+ cook zing %- plus :: Many lines %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " ^- tape ;: weld ">" ?~(a "" " ") :: If the line is blank, no trailing space a "\0a" == ;~ plug :: Break into lines (star ;~(less (just '\0a') prn)) (just '\0a') == :: ++ ul |= [u=ul:container:m] ^- tape %- zing %+ turn contents.u :: Each bullet point... |= [item=markdown:m] ^- tape %+ scan (markdown item) :: First, render bullet point contents %+ cook zing ;~ plug %+ cook |= [a=tape] :: Prepend 1st line with indent + bullet char ;: weld (reap indent-level.u ' ') (trip marker-char.u) " " a == line :: first line %- star %+ cook |= [a=tape] :: Subsequent lines just get indent ?: ?|(=("" a) =("\0a" a)) a ;: weld (reap indent-level.u ' ') " " :: 2 spaces, to make it even with the 1st line a == line :: second and thereafter lines == ++ tl |= [t=tl:container:m] ^- tape %- zing %+ turn contents.t :: Each bullet point... |= [is-checked=? item=markdown:m] ^- tape %+ scan (markdown item) :: First, render bullet point contents %+ cook zing ;~ plug %+ cook |= [a=tape] :: Prepend 1st line with indent, bullet char, checkbox ;: weld (reap indent-level.t ' ') (trip marker-char.t) " [" ?:(is-checked "x" " ") "] " a == line :: first line %- star %+ cook |= [a=tape] :: Subsequent lines just get indent ?: ?|(=("" a) =("\0a" a)) a ;: weld (reap indent-level.t ' ') " " :: 2 spaces, to make it even with the 1st line a == line :: second and thereafter lines == :: ++ ol |= [o=ol:container:m] ^- tape %- zing %+ turn contents.o :: Each item... |= [item=markdown:m] ^- tape %+ scan (markdown item) :: First, render item contents %+ cook zing ;~ plug %+ cook |= [a=tape] :: Prepend 1st line with indent + item number ;: weld (reap indent-level.o ' ') (a-co:co start-num.o) (trip marker-char.o) " " a == line :: first line %- star %+ cook |= [a=tape] :: Subsequent lines just get indent ?: ?|(=("" a) =("\0a" a)) a ;: weld (reap indent-level.o ' ') (reap (lent (a-co:co start-num.o)) ' ') " " :: 2 spaces, to make it even with the 1st line a == line :: second and thereafter lines == -- :: ++ markdown |= [a=markdown:m] ^- tape %- zing %+ turn a |= [item=node:markdown:m] ?- -.item %leaf (node:leaf +.item) %container (node:container +.item) == -- -- :: :: Enserialize as Sail (manx and marl) ++ sail-en =< |= [document=markdown:m] =/ link-ref-defs (all-link-ref-definitions document) ^- manx ;div ;* (~(markdown sail-en link-ref-defs) document) == :: |_ [reference-links=(map @t urlt:ln:m)] ++ inline |% ++ contents |= [=contents:inline:m] ^- marl %+ turn contents element ++ element |= [e=element:inline:m] ^- manx ?+ -.e !! %text (text e) %link (link e) %code-span (code e) %escape (escape e) %entity (entity e) %strong (strong e) %emphasis (emphasis e) %soft-line-break (softbrk e) %line-break (hardbrk e) %image (image e) %autolink (autolink e) :: ...etc == ++ text |= [t=text:inline:m] ^- manx [[%$ [%$ (trip text.t)] ~] ~] :: Magic; look up the structure of a `manx` if you want ++ escape |= [e=escape:inline:m] ^- manx [[%$ [%$ (trip char.e)] ~] ~] :: Magic; look up the structure of a `manx` if you want ++ entity |= [e=entity:inline:m] ^- manx =/ fulltext (crip ;:(weld "&" (trip code.e) ";")) [[%$ [%$ `tape`[fulltext ~]] ~] ~] :: We do a little sneaky ++ softbrk |= [s=softbrk:inline:m] ^- manx (text [%text ' ']) ++ hardbrk |= [h=hardbrk:inline:m] ^- manx ;br; ++ code |= [c=code:inline:m] ^- manx ;code: {(trip text.c)} ++ link |= [l=link:inline:m] ^- manx =/ target target.l =/ urlt ?- -.target %direct urlt.target :: Direct link; use it %ref :: Ref link; look it up ~| "reflink not found: {}" (~(got by reference-links) label.target) == ;a(href (trip text.url.urlt), title (trip (fall title-text.urlt ''))) ;* (contents contents.l) == ++ image |= [i=image:inline:m] ^- manx =/ target target.i =/ urlt ?- -.target %direct urlt.target :: Direct link; use it %ref :: Ref link; look it up ~| "reflink not found: {}" (~(got by reference-links) label.target) == ;img(src (trip text.url.urlt), alt (trip alt-text.i)); ++ autolink |= [a=autolink:inline:m] ^- manx ;a(href (trip text.a)): {(trip text.a)} ++ emphasis |= [e=emphasis:inline:m] ^- manx ;em ;* (contents contents.e) == ++ strong |= [s=strong:inline:m] ^- manx ;strong ;* (contents contents.s) == -- ++ leaf |% ++ node |= [n=node:leaf:m] ^- manx ?+ -.n !! %blank-line (blank-line n) %break (break n) %heading (heading n) %indent-codeblock (codeblk-indent n) %fenced-codeblock (codeblk-fenced n) %table (table n) %paragraph (paragraph n) %link-ref-definition (text:inline [%text ' ']) :: Link ref definitions don't render as anything :: ...etc == ++ heading |= [h=heading:leaf:m] ^- manx :- :_ ~ ?+ level.h !! :: Tag and attributes; attrs are empty (~) %1 %h1 %2 %h2 %3 %h3 %4 %h4 %5 %h5 %6 %h6 == (contents:inline contents.h) ++ blank-line |= [b=blank-line:leaf:m] ^- manx (text:inline [%text ' ']) ++ break |= [b=break:leaf:m] ^- manx ;hr; ++ codeblk-indent |= [c=codeblk-indent:leaf:m] ^- manx ;pre ;code: {(trip text.c)} == ++ codeblk-fenced |= [c=codeblk-fenced:leaf:m] ^- manx ;pre ;+ ?: =(info-string.c '') ;code: {(trip text.c)} ;code(class (weld "language-" (trip info-string.c))): {(trip text.c)} == ++ table |= [t=table:leaf:m] ^- manx ;table ;thead ;tr ;* =/ hdr head.t =/ align align.t |- ?~ hdr ~ :- ;th(align ?-((head align) %c "center", %r "right", %l "left", %n "")) ;* (contents:inline (head hdr)) == $(hdr (tail hdr), align (tail align)) == == ;tbody ;* %+ turn rows.t |= [r=(list contents:inline:m)] ^- manx ;tr ;* =/ row r =/ align align.t |- ?~ row ~ :- ;td(align ?-((head align) %c "center", %r "right", %l "left", %n "")) ;* (contents:inline (head row)) == $(row (tail row), align (tail align)) == == == ++ paragraph |= [p=paragraph:leaf:m] ^- manx ;p ;* (contents:inline contents.p) == -- :: ++ container |% ++ node |= [n=node:container:m] ^- manx ?- -.n %block-quote (block-quote n) %ul (ul n) %ol (ol n) %tl (tl n) == :: ++ block-quote |= [b=block-quote:container:m] ^- manx ;blockquote ;* (~(. markdown reference-links) markdown.b) == :: ++ ul |= [u=ul:container:m] ^- manx ;ul ;* %+ turn contents.u |= [a=markdown:m] ^- manx ;li ;* (~(. markdown reference-links) a) == == :: ++ ol |= [o=ol:container:m] ^- manx ;ol(start (a-co:co start-num.o)) ;* %+ turn contents.o |= [a=markdown:m] ^- manx ;li ;* (~(. markdown reference-links) a) == == ++ tl |= [t=tl:container:m] ^- manx ;ul.task-list ;* %+ turn contents.t |= [is-checked=? a=markdown:m] ^- manx ;li ;+ ?: is-checked ;input(type "checkbox", checked "true"); ;input(type "checkbox"); ;* (~(. markdown reference-links) a) == == -- :: ++ markdown |= [a=markdown:m] ^- marl %+ turn a |= [item=node:markdown:m] ?- -.item %leaf (node:leaf +.item) %container (node:container +.item) == -- --