diff --git a/app/Main.hs b/app/Main.hs index d78c4b6..05d1fd1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -56,14 +56,14 @@ instance Show MdToken where mustBeHash :: ReadP Char mustBeHash = satisfy (\x -> x == '#') -lengthCmp :: (a,[b]) -> (a, [b]) -> Ordering -lengthCmp (i,j) (k,l) = compare (length l) (length j) - -leftmostLongest :: [(a, [b])] -> a -leftmostLongest tupleLst = (sortBy lengthCmp tupleLst) - - - +leftmostLongest :: (Foldable t) => [(a, t b)] -> (a, t b) +leftmostLongest xs = + let lastElem = (last xs) + filteredLst = (filter (\val -> (length $ snd val) == (length $ snd lastElem)) xs) + in head filteredLst + +leftmostLongestParse :: ReadP a -> String -> (a, String) +leftmostLongestParse parser input = leftmostLongest $ readP_to_S parser input -- --------------- parseHeader :: ReadP MdToken @@ -74,9 +74,7 @@ parseHeader = do _ <- string " " 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 + let parsedText = fst $ leftmostLongestParse parseLine text return (Header (length headers) parsedText) parseBold :: ReadP MdToken @@ -88,7 +86,7 @@ parseBold = do -- text <- munch1 (\x -> x /= '_' && x /= '*') -- Parse until first asterisk/underscore -- traceM text -- _ <- char '_' <|> char '*' -- Throw away the second asterisk/underscore - let parsedText = fst . last $ readP_to_S parsePara text + let parsedText = fst $ leftmostLongestParse parseLine text return (Bold parsedText) parseItalic :: ReadP MdToken @@ -97,27 +95,27 @@ parseItalic = do (between (string "_") (string "_") (munch1 (/= '_'))), (between (string "*") (string "*") (munch1 (/= '*'))) ] - let parsedText = fst . last $ readP_to_S parsePara text + let parsedText = fst $ leftmostLongestParse parseLine text return (Italic parsedText) parseString :: ReadP MdToken parseString = do - -- firstChar <- get -- Must parse at least one character here - text <- munch1 (\x -> not (elem x "#*_[")) - --return (Unit (firstChar:text)) - return (Unit text) + firstChar <- get -- Must parse at least one character here + text <- munch (\x -> not (elem x "#*_[\n")) + return (Unit (firstChar:text)) + --return (Unit text) -parseLine :: ReadP MdToken -parseLine = choice [parseHeader, parseBold, parseItalic, parseString] +parseToken :: ReadP MdToken +parseToken = choice [parseHeader, parseBold, parseItalic, parseString] -parsePara :: ReadP MdToken -parsePara = do - parsed <- parseMany parseLine +parseLine :: ReadP MdToken +parseLine = do + parsed <- parseMany parseToken -- traceM $ show parsed return (Para parsed) main :: IO () main = do - let res = readP_to_S parsePara "## Hello __world__" + let res = leftmostLongestParse parseLine "## Hello __world_*" putStrLn (show res)