Got recursive parsing working

master
Aadhavan Srinivasan 2 weeks ago
parent bc43f75a28
commit 1a838e343e

@ -3,12 +3,17 @@ module Main where
import Text.ParserCombinators.ReadP import Text.ParserCombinators.ReadP
import Control.Monad import Control.Monad
import Control.Applicative import Control.Applicative
import Text.Printf
import Debug.Trace
type HeaderLevel = Int type HeaderLevel = Int
newtype URL = URL {getUrl :: String} newtype URL = URL {getUrl :: String}
newtype ImgPath = ImgPath {getPath :: String} newtype ImgPath = ImgPath {getPath :: String}
parseMany :: ReadP a -> ReadP [a]
parseMany = Text.ParserCombinators.ReadP.many
data MdToken = Header HeaderLevel MdToken data MdToken = Header HeaderLevel MdToken
| Para [MdToken] | Para [MdToken]
| Linebreak | Linebreak
@ -18,11 +23,11 @@ data MdToken = Header HeaderLevel MdToken
| OrdList [MdToken] | OrdList [MdToken]
| Code String | Code String
| Codeblock String | Codeblock String
| Link [MdToken] URL | Link MdToken URL
| Image [MdToken] ImgPath | Image MdToken ImgPath
| Bold [MdToken] | Bold MdToken
| Italic [MdToken] | Italic MdToken
| Strikethrough [MdToken] | Strikethrough MdToken
| Unit String | Unit String
-- Deriving Show for MdToken -- Deriving Show for MdToken
@ -34,14 +39,14 @@ instance Show MdToken where
show (Blockquote token) = "BLOCK" ++ show token show (Blockquote token) = "BLOCK" ++ show token
show (UnordList tokens) = "UNORD" ++ concat(map show tokens) show (UnordList tokens) = "UNORD" ++ concat(map show tokens)
show (OrdList tokens) = "ORD" ++ concat(map show tokens) show (OrdList tokens) = "ORD" ++ concat(map show tokens)
show (Code code) = concat(map show code) show (Code code) = show code
show (Codeblock code) = concat(map show code) show (Codeblock code) = show code
show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ concat(map show txt) ++ "</a>" show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ show txt ++ "</a>"
show (Image txt path) = "<img src=" ++ (getPath path) ++ ">" ++ concat(map show txt) ++ "</img>" show (Image txt path) = "<img src=" ++ (getPath path) ++ ">" ++ show txt ++ "</img>"
show (Bold tokens) = "<b>" ++ concat(map show tokens) ++ "</b>" show (Bold token) = "<b>" ++ show token ++ "</b>"
show (Italic tokens) = "<i>" ++ concat(map show tokens) ++ "</i>" show (Italic token) = "<i>" ++ show token ++ "</i>"
show (Strikethrough tokens) = "<s>" ++ concat (map show tokens) ++ "</s>" show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
show (Unit unit) = show unit show (Unit unit) = printf "%s" unit
@ -61,21 +66,38 @@ parseHeader = do
when ((length headers) > 6) when ((length headers) > 6)
pfail pfail
_ <- string " " _ <- string " "
text <- munch1 (const True) -- Parse until EOL text <- munch1 (\x -> x /= '\n') -- Parse until EOL
return (Header (length headers) text) -- traceM text
let allParsedText = readP_to_S parsePara text
let parsedText = fst . last $ allParsedText
return (Header (length headers) parsedText)
parseBold :: ReadP MdToken parseBold :: ReadP MdToken
parseBold = do parseBold = do
_ <- string "__" <|> string "**" _ <- string "__" <|> string "**"
text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore
-- traceM text
_ <- char '_' <|> char '*' -- Throw away the second asterisk/underscore _ <- char '_' <|> char '*' -- Throw away the second asterisk/underscore
return (Bold text) let parsedText = fst . last $ readP_to_S parsePara text
return (Bold parsedText)
parseMain :: String -> []MdToken parseString :: ReadP MdToken
parseString = do
parseMain text <- munch1 (\x -> not (elem x "#*_["))
-- traceM text
return (Unit text)
parseLine :: ReadP MdToken
parseLine = choice [parseHeader,parseBold,parseString]
parsePara :: ReadP MdToken
parsePara = do
parsed <- parseMany parseLine
-- traceM $ show parsed
return (Para parsed)
main :: IO () main :: IO ()
main = putStrLn "Hello, Haskell!" main = do
let res = readP_to_S parsePara "## Hello **world**"
putStrLn (show res)

Loading…
Cancel
Save