Trying to get recursive parsing working better
This commit is contained in:
		
							
								
								
									
										40
									
								
								app/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										40
									
								
								app/Main.hs
									
									
									
									
									
								
							@@ -69,35 +69,51 @@ parseHeader = do
 | 
			
		||||
        text <- munch1 (\x -> x /= '\n') -- Parse until EOL
 | 
			
		||||
--        traceM text
 | 
			
		||||
        let allParsedText = readP_to_S parsePara text
 | 
			
		||||
        traceM (show allParsedText)
 | 
			
		||||
        let parsedText = fst . last $ allParsedText
 | 
			
		||||
        return (Header (length headers) parsedText)
 | 
			
		||||
                
 | 
			
		||||
parseBold :: ReadP MdToken
 | 
			
		||||
parseBold = do
 | 
			
		||||
        _ <- string "__" <|> string "**"
 | 
			
		||||
        text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore
 | 
			
		||||
        text <- choice[
 | 
			
		||||
                       (between (string "__") (string "__") (munch1 (/= '_'))), 
 | 
			
		||||
                       (between (string "**") (string "**") (munch1 (/= '*')))
 | 
			
		||||
                       ]
 | 
			
		||||
--        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
 | 
			
		||||
        let parsedText = fst . last $ readP_to_S parsePara text
 | 
			
		||||
        return (Bold parsedText)
 | 
			
		||||
 | 
			
		||||
parseItalic :: ReadP MdToken
 | 
			
		||||
parseItalic = do
 | 
			
		||||
        text <- choice[
 | 
			
		||||
                       (between (string "_") (string "_") (munch1 (/= '_'))), 
 | 
			
		||||
                       (between (string "*") (string "*") (munch1 (/= '*')))
 | 
			
		||||
                       ]
 | 
			
		||||
        let parsedText = fst . last $ readP_to_S parsePara text
 | 
			
		||||
        return (Italic parsedText)
 | 
			
		||||
 | 
			
		||||
parseString :: ReadP MdToken
 | 
			
		||||
parseString = do
 | 
			
		||||
         text <- munch1 (\x -> not (elem x "#*_["))
 | 
			
		||||
   --      traceM text
 | 
			
		||||
         return (Unit text)
 | 
			
		||||
         firstChar <- get -- Must parse at least one character here
 | 
			
		||||
         text <- munch (\x -> not (elem x "#*_["))
 | 
			
		||||
         return (Unit (firstChar:text))
 | 
			
		||||
         --return (Unit text)
 | 
			
		||||
 | 
			
		||||
parseLine :: ReadP MdToken
 | 
			
		||||
parseLine = choice [parseHeader,parseBold,parseString]
 | 
			
		||||
parseLine = choice [parseHeader, parseBold, parseItalic, parseString]
 | 
			
		||||
 | 
			
		||||
parsePara :: ReadP MdToken
 | 
			
		||||
parsePara =  do
 | 
			
		||||
         parsed <- parseMany parseLine
 | 
			
		||||
--         traceM $ show parsed
 | 
			
		||||
         return (Para parsed)
 | 
			
		||||
parsePara = 
 | 
			
		||||
------ parsePara :: ReadP MdToken
 | 
			
		||||
------ parsePara =  do
 | 
			
		||||
------          parsed <- parseMany parseLine
 | 
			
		||||
------ --         traceM $ show parsed
 | 
			
		||||
------          return (Para parsed)
 | 
			
		||||
            
 | 
			
		||||
 | 
			
		||||
main :: IO ()
 | 
			
		||||
main = do
 | 
			
		||||
   let res = readP_to_S parsePara "## Hello **world**"
 | 
			
		||||
   let res = readP_to_S parsePara "## Hello __world_*"
 | 
			
		||||
   putStrLn (show res)
 | 
			
		||||
 
 | 
			
		||||
		Reference in New Issue
	
	Block a user