5 Commits

2 changed files with 46 additions and 8 deletions

View File

@@ -40,6 +40,7 @@ data MdToken
| Blockquote [MdToken]
| UnordList [MdToken]
| OrdList [MdToken]
| Checkbox Bool
| Code MdToken
| Table [[MdToken]]
| Codeblock MdToken
@@ -66,6 +67,7 @@ instance Show MdToken where
show (Blockquote tokens) = "<blockquote>" ++ concatMap show tokens ++ "</blockquote>"
show (UnordList tokens) = "<ul>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ul>"
show (OrdList tokens) = "<ol>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ol>"
show (Checkbox isChecked) = "<input type=\"checkbox\"" ++ (if isChecked then " checked=\"\"" else "") ++ " />"
show (Code code) = "<code>" ++ strip (show code) ++ "</code>"
show (Table (thead : tokenGrid)) = "<table><thead><tr>" ++ concatMap (\x -> "<th>" ++ rstrip (show x) ++ "</th>") thead ++ "</tr></thead>" ++ "<tbody>" ++ concatMap (\x -> "<tr>" ++ concatMap (\y -> "<td>" ++ rstrip (show y) ++ "</td>") x ++ "</tr>") tokenGrid ++ "</tbody></table>"
show (Codeblock code) = "<pre><code>" ++ show code ++ "</code></pre>"
@@ -143,7 +145,7 @@ parseTillEol = manyTill anySingle (void (char '\n') <|> eof)
-- Takes a list of parsers. Returns a parser that will try them in
-- order, moving to the next one only if the current one fails.
fallthroughParser :: [Parser a] -> Parser a
fallthroughParser [x] = x
fallthroughParser [x] = try x
fallthroughParser (x : xs) = try x <|> fallthroughParser xs
escapeChar :: Char -> String
@@ -425,6 +427,15 @@ parseBlockquote = do
let parsedQuotedLines = leftmostLongestParse (some (parseBlockquote <|> parsePara)) (init $ unlines quotedLines) -- unlines joins the lines together with a newline, and adds a trailing newline. init removes the trailing newline.
return (Blockquote parsedQuotedLines)
-- Parse a checkbox
parseCheckbox :: Parser MdToken
parseCheckbox = do
char '['
inside <- char ' ' <|> char 'x'
char ']'
space
return (if inside == 'x' then Checkbox True else Checkbox False)
-- Parse a nested list item.
parseListNested :: Parser MdToken
parseListNested = do
@@ -460,9 +471,12 @@ parseOListLineItem = do
parseListLineItemCommon :: Parser MdToken
parseListLineItemCommon = do
space
checkbox <- optional $ try parseCheckbox
restOfLine <- manyTill parseListLineToken (void (char '\n') <|> eof)
nestedList <- try parseListNested <|> return (Unit "")
return $ Line [Line restOfLine, nestedList]
case checkbox of
Just box -> return $ Line [box, Line restOfLine, nestedList]
Nothing -> return $ Line [Line restOfLine, nestedList]
-- Parse an unordered list paragraph item.
parseUListParaItem :: Parser MdToken
@@ -528,11 +542,15 @@ doubleNewlineText :: T.Text
doubleNewlineText = T.pack "\n\n"
parseHorizontalRule :: Parser MdToken
parseHorizontalRule = string horizontalRuleText *> (void (string doubleNewlineText) <|> eof) *> return HorizontalRule
parseHorizontalRule = parseHorizontalRuleLine *> (void (string doubleNewlineText) <|> eof) *> return HorizontalRule
where
parseHorizontalRuleLine = fallthroughParser (map (string . T.pack) ["---", "***", "___", "- - -", "* * *", "_ _ _"])
parseCodeblock :: Parser MdToken
parseCodeblock = do
string (T.pack "```\n")
string (T.pack "```")
_ <- many $ satisfy (/= '\n') -- Language name
char '\n'
inside <- someTill anySingle (string (T.pack "\n```"))
return $ Codeblock (Unit (concatMap escapeChar inside))
@@ -552,5 +570,8 @@ documentParsers =
-- Parse a document, which is multiple paragraphs.
parseDocument :: Parser MdToken
parseDocument = do
res <- manyTill (fallthroughParser documentParsers) eof
-- res <- manyTill (fallthroughParser documentParsers <|> (char '\n' *> return $ Unit "")) eof
res <- sepEndBy (fallthroughParser documentParsers) (many $ char '\n')
-- many $ char '\n'
eof
return (Document res)

View File

@@ -76,7 +76,15 @@ unorderedListTests =
check_equal "Nested list then back" "<ul><li>Item 1</li><li>Item 2<ul><li>Item 3</li><li>Item 4</li></ul></li><li>Item 5</li></ul>" (convert "- Item 1\n- Item 2\n - Item 3\n - Item 4\n- Item 5"),
check_equal "Triply nested list" "<ul><li>Item 1</li><li>Item 2<ul><li>Item 3<ul><li>Item 4</li></ul></li></ul></li><li>Item 5</li></ul>" (convert "- Item 1\n- Item 2\n - Item 3\n - Item 4\n- Item 5"),
check_equal "Blockquote in list" "<ul><li>Item 1</li><li><p>Item 2</p><blockquote><p>Quote</p></blockquote></li><li>Item 3</li></ul>" (convert "- Item 1\n- Item 2\n\n > Quote\n\n- Item 3"),
check_equal "Ordered list in unordered list" "<ul><li>Item 1</li><li>Item 2<ol><li>Item 1</li><li>Item 2</li></ol></li><li>Item 3</li></ul>" (convert "- Item 1\n- Item 2\n 1. Item 1\n 2. Item 2\n- Item 3")
check_equal "Ordered list in unordered list" "<ul><li>Item 1</li><li>Item 2<ol><li>Item 1</li><li>Item 2</li></ol></li><li>Item 3</li></ul>" (convert "- Item 1\n- Item 2\n 1. Item 1\n 2. Item 2\n- Item 3"),
check_equal
"Checkbox in unordered list"
"<ul>\
\<li><input type=\"checkbox\" />Not checked</li>\
\<li><input type=\"checkbox\" checked=\"\" />Checked</li>\
\<li>Normal list item</li></ul>"
(convert "- [ ] Not checked\n- [x] Checked\n- Normal list item"),
check_equal "List with link at the start" "<ul><li><a href=\"b\">a</a></li><li><a href=\"d\">c</a></li></ul>" (convert "- [a](b)\n- [c](d)")
]
orderedListTests =
@@ -92,7 +100,14 @@ orderedListTests =
check_equal "Nested list then back" "<ol><li>Item 1</li><li>Item 2<ol><li>Item 3</li><li>Item 4</li></ol></li><li>Item 5</li></ol>" (convert "1. Item 1\n2. Item 2\n 1. Item 3\n 3. Item 4\n5. Item 5"),
check_equal "Blockquote in list" "<ol><li>Item 1</li><li><p>Item 2</p><blockquote><p>Quote</p></blockquote></li><li>Item 3</li></ol>" (convert "1. Item 1\n2. Item 2\n\n > Quote\n\n3. Item 3"),
check_equal "Unordered list in ordered list" "<ol><li>Item 1</li><li>Item 2<ul><li>Item 1</li><li>Item 2</li></ul></li><li>Item 3</li></ol>" (convert "1. Item 1\n2. Item 2\n - Item 1\n * Item 2\n4. Item 3"),
check_equal "List with just 1 item" "<ol><li>Item 1</li></ol>" (convert "1. Item 1")
check_equal "List with just 1 item" "<ol><li>Item 1</li></ol>" (convert "1. Item 1"),
check_equal
"Checkbox in ordered list"
"<ol>\
\<li><input type=\"checkbox\" />Not checked</li>\
\<li><input type=\"checkbox\" checked=\"\" />Checked</li>\
\<li>Normal list item</li></ol>"
(convert "1. [ ] Not checked\n2. [x] Checked\n3. Normal list item")
]
htmlTests =
@@ -103,7 +118,9 @@ codeTests =
TestList
[ check_equal "Code by itself" "<p><code>Hello world!</code></p>" (convert "`Hello world!`"),
check_equal "Code in a paragraph" "<p>The following <code>text</code> is code</p>" (convert "The following `text` is code"),
check_equal "Code across paragraphs (shouldn't work)" "<p>`Incomplete</p><p>Code`</p>" (convert "`Incomplete\n\nCode`") -- At the moment, this is just treated as a syntax error, so nothing is rendered.
check_equal "Code across paragraphs (shouldn't work)" "<p>`Incomplete</p><p>Code`</p>" (convert "`Incomplete\n\nCode`"), -- At the moment, this is just treated as a syntax error, so nothing is rendered.
check_equal "Code block" "<pre><code>Test code block</code></pre>" (convert "```\nTest code block\n```"),
check_equal "Multiple code blocks" "<pre><code>Test code block</code></pre><pre><code>Next block</code></pre>" (convert "```\nTest code block\n```\n\n```\nNext block\n```")
]
imageTests =