diff --git a/src/MdToHTML.hs b/src/MdToHTML.hs index 0b5604e..e1f0919 100644 --- a/src/MdToHTML.hs +++ b/src/MdToHTML.hs @@ -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) = "" show (OrdList tokens) = "
    " ++ concatMap (prepend "
  1. " . append "
  2. " . show) tokens ++ "
" show (Code code) = "" ++ show code ++ "" - show (Codeblock code) = show code + show (Table (thead : tokenGrid)) = "\n\n\n" ++ concatMap (\x -> "\n") thead ++ "\n\n" ++ "\n" ++ concatMap (\x -> "\n" ++ concatMap (\y -> "\n") x ++ "\n") tokenGrid ++ "\n
" ++ rstrip (show x) ++ "
" ++ rstrip (show y) ++ "
\n" + show (Codeblock code) = "
" ++ show code ++ "
" show (Link txt url) = "" ++ show txt ++ "" show (Image txt url cssClasses) = "\"" " class=\"" ++ unwords classes ++ "\"") cssClasses ++ "/>" show (Figure txt url cssClasses) = "
\"" " class=\"" ++ unwords classes ++ "\"") cssClasses ++ "/>
" ++ show txt ++ "
" @@ -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,