Added support for tables and codeblocks
Defined the types, defined 'show', created the parsers, added them to parser list
This commit is contained in:
@@ -40,7 +40,8 @@ data MdToken
|
||||
| UnordList [MdToken]
|
||||
| OrdList [MdToken]
|
||||
| Code MdToken
|
||||
| Codeblock String
|
||||
| Table [[MdToken]]
|
||||
| Codeblock MdToken
|
||||
| Link MdToken URL
|
||||
| Image MdToken URL (Maybe [CssClass])
|
||||
| Figure MdToken URL (Maybe [CssClass])
|
||||
@@ -63,7 +64,8 @@ instance Show MdToken where
|
||||
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 (Code code) = "<code>" ++ show code ++ "</code>"
|
||||
show (Codeblock code) = show code
|
||||
show (Table (thead : tokenGrid)) = "<table>\n<thead>\n<tr>\n" ++ concatMap (\x -> "<th>" ++ rstrip (show x) ++ "</th>\n") thead ++ "</tr>\n</thead>\n" ++ "<tbody>\n" ++ concatMap (\x -> "<tr>\n" ++ concatMap (\y -> "<td>" ++ rstrip (show y) ++ "</td>\n") x ++ "</tr>\n") tokenGrid ++ "</tbody>\n</table>\n"
|
||||
show (Codeblock code) = "<pre><code>" ++ show code ++ "</code></pre>"
|
||||
show (Link txt url) = "<a href=\"" ++ getUrl url ++ "\">" ++ show txt ++ "</a>"
|
||||
show (Image txt url cssClasses) = "<img src=\"" ++ getUrl url ++ "\"" ++ " alt=\"" ++ show txt ++ "\"" ++ maybe "" (\classes -> " class=\"" ++ unwords classes ++ "\"") cssClasses ++ "/>"
|
||||
show (Figure txt url cssClasses) = "<figure><img src=\"" ++ getUrl url ++ "\" alt=\"" ++ show txt ++ "\"" ++ maybe "" (\classes -> " class=\"" ++ unwords classes ++ "\"") cssClasses ++ "/><figcaption aria-hidden=\"true\">" ++ show txt ++ "</figcaption></figure>"
|
||||
@@ -204,6 +206,22 @@ parseLinebreak = do
|
||||
char '\n'
|
||||
return Linebreak
|
||||
|
||||
parseTableRow :: Parser [MdToken]
|
||||
parseTableRow = do
|
||||
char '|'
|
||||
row <- some (many (satisfy (\x -> x == ' ' || x == '\t')) *> someTill parseListLineToken (char '|'))
|
||||
return (map Line row)
|
||||
|
||||
parseTable :: Parser MdToken
|
||||
parseTable = do
|
||||
tableHead <- parseTableRow
|
||||
char '\n'
|
||||
char '|'
|
||||
sepEndBy1 (some (char '-')) (char '|') *> char '\n'
|
||||
tableBody <- sepEndBy parseTableRow (char '\n')
|
||||
many (char '\n') -- Parse trailing newlines, if any
|
||||
return $ Table (tableHead : tableBody)
|
||||
|
||||
parseSingleNewline :: Parser MdToken
|
||||
parseSingleNewline = do
|
||||
char '\n'
|
||||
@@ -427,9 +445,17 @@ doubleNewlineText = T.pack "\n\n"
|
||||
parseHorizontalRule :: Parser MdToken
|
||||
parseHorizontalRule = string horizontalRuleText *> (void (string doubleNewlineText) <|> eof) *> return HorizontalRule
|
||||
|
||||
parseCodeblock :: Parser MdToken
|
||||
parseCodeblock = do
|
||||
string (T.pack "```\n")
|
||||
inside <- someTill anySingle (string (T.pack "\n```"))
|
||||
return $ Codeblock (Unit (concatMap escapeChar inside))
|
||||
|
||||
documentParsers :: [Parser MdToken]
|
||||
documentParsers =
|
||||
[ parseHorizontalRule,
|
||||
parseCodeblock,
|
||||
parseTable,
|
||||
parseHeader,
|
||||
parseBlockquote,
|
||||
parseUnorderedList,
|
||||
|
Reference in New Issue
Block a user