Update to latest markdown parser.

This commit is contained in:
Dillon Kearns 2019-08-30 17:16:44 +05:30
parent f3f43c58e7
commit 7f4631ade1
2 changed files with 81 additions and 18 deletions

View File

@ -4,7 +4,7 @@ import Markdown.CodeBlock
import Markdown.Inlines as Inlines exposing (StyledString)
import Markdown.List
import Parser
import Parser.Advanced as Advanced exposing ((|.), (|=), Nestable(..), Step(..), andThen, chompUntil, chompWhile, getChompedString, inContext, int, lazy, loop, map, multiComment, oneOf, problem, succeed, symbol, token)
import Parser.Advanced as Advanced exposing ((|.), (|=), Nestable(..), Step(..), andThen, chompIf, chompUntil, chompWhile, getChompedString, inContext, int, lazy, loop, map, multiComment, oneOf, problem, succeed, symbol, token)
import XmlParser exposing (Node(..))
@ -62,19 +62,21 @@ type alias Renderer view =
, italic : String -> view
-- TODO make this a `Result` so users can validate links
, link : { title : Maybe String, destination : String } -> String -> view
, link : { title : Maybe String, destination : String } -> String -> Result String view
, list : List view -> view
, codeBlock : { body : String, language : Maybe String } -> view
, thematicBreak : view
}
renderStyled : Renderer view -> List StyledString -> List view
renderStyled : Renderer view -> List StyledString -> Result String (List view)
renderStyled renderer styledStrings =
styledStrings
|> List.foldr (foldThing renderer) []
|> combineResults
foldThing : Renderer view -> StyledString -> List view -> List view
foldThing : Renderer view -> StyledString -> List (Result String view) -> List (Result String view)
foldThing renderer { style, string } soFar =
case style.link of
Just link ->
@ -83,19 +85,19 @@ foldThing renderer { style, string } soFar =
Nothing ->
if style.isBold then
renderer.bold string
(renderer.bold string |> Ok)
:: soFar
else if style.isItalic then
renderer.italic string
(renderer.italic string |> Ok)
:: soFar
else if style.isCode then
renderer.code string
(renderer.code string |> Ok)
:: soFar
else
renderer.plain string
(renderer.plain string |> Ok)
:: soFar
@ -108,13 +110,12 @@ renderHelper renderer blocks =
(\block ->
case block of
Heading level content ->
renderer.heading level (renderStyled renderer content)
|> Ok
renderStyled renderer content
|> Result.map (renderer.heading level)
Body content ->
renderStyled renderer content
|> renderer.raw
|> Ok
|> Result.map renderer.raw
Html tag attributes children ->
renderHtmlNode renderer tag attributes children
@ -122,14 +123,17 @@ renderHelper renderer blocks =
ListBlock items ->
items
|> List.map (renderStyled renderer)
|> List.map renderer.raw
|> renderer.list
|> Ok
|> combineResults
|> Result.map (List.map renderer.raw)
|> Result.map renderer.list
CodeBlock codeBlock ->
codeBlock
|> renderer.codeBlock
|> Ok
ThematicBreak ->
Ok renderer.thematicBreak
)
blocks
@ -244,6 +248,7 @@ type Block
| Html String (List Attribute) (List Block)
| ListBlock (List (List Inlines.StyledString))
| CodeBlock Markdown.CodeBlock.CodeBlock
| ThematicBreak
type alias Attribute =
@ -400,12 +405,12 @@ statementsHelp revStmts =
)
|= Advanced.getOffset
|= oneOf
[ listBlock |> map List.singleton
[ thematicBreak |> map List.singleton
, listBlock |> map List.singleton
, blankLine |> map List.singleton
, heading |> map List.singleton
, Markdown.CodeBlock.parser |> map CodeBlock |> map List.singleton
, htmlParser |> map List.singleton
, htmlParser |> map List.singleton
, plainLine
]
|= Advanced.getOffset
@ -424,6 +429,47 @@ statementsHelp revStmts =
]
spaceOrTab =
\c -> c == ' ' || c == '\t'
oneOrMore condition =
chompIf condition (Parser.Problem "Expected one or more character")
|. chompWhile condition
zeroOrMore condition =
chompWhile condition
thematicBreak : Parser Block
thematicBreak =
succeed ThematicBreak
|. oneOf
[ symbol (Advanced.Token " " (Parser.Problem "Expecting 3 spaces"))
, symbol (Advanced.Token " " (Parser.Problem "Expecting 2 spaces"))
, symbol (Advanced.Token " " (Parser.Problem "Expecting space"))
, succeed ()
]
|. oneOf
[ symbol (Advanced.Token "---" (Parser.Expecting "---"))
|. chompWhile (\c -> c == '-')
, symbol (Advanced.Token "***" (Parser.Expecting "***"))
|. chompWhile (\c -> c == '*')
, symbol (Advanced.Token "___" (Parser.Expecting "___"))
|. chompWhile (\c -> c == '_')
]
|. zeroOrMore spaceOrTab
|. oneOf
[ Advanced.end (Parser.Problem "Expecting end")
, chompIf (\c -> c == '\n') (Parser.Problem "Expecting newline")
]
-- |. chompIf (\c -> c == '\n') (Parser.Problem "Expecting newline")
heading : Parser Block
heading =
succeed Heading
@ -456,6 +502,7 @@ heading =
let
result =
headingText
|> dropTrailingHashes
|> Advanced.run Inlines.parse
in
case result of
@ -468,6 +515,16 @@ heading =
)
dropTrailingHashes headingString =
if headingString |> String.endsWith "#" then
String.dropRight 1 headingString
|> String.trimRight
|> dropTrailingHashes
else
headingString
parse : String -> Result (List (Advanced.DeadEnd String Parser.Problem)) (List Block)
parse input =
Advanced.run multiParser input

View File

@ -20,11 +20,17 @@ view markdown =
|> Markdown.Parser.render
{ heading = heading
, raw = Element.paragraph []
-- TODO
, thematicBreak = Element.none
, plain = Element.text
, bold = \content -> Element.row [ Font.bold ] [ Element.text content ]
, italic = \content -> Element.row [ Font.italic ] [ Element.text content ]
, code = code
, link = \link body -> Element.link [] { url = link.destination, label = Element.text body }
, link =
\link body ->
Element.link [] { url = link.destination, label = Element.text body }
|> Ok
, list =
\items ->
Element.column [ Element.spacing 15 ]