Implement LeftmostLongest, renamed functions, failed parsing works now (see main function for example)

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)
+
+parseToken :: ReadP MdToken
+parseToken = choice [parseHeader, parseBold, parseItalic, parseString]
 
 parseLine :: ReadP MdToken
-parseLine = choice [parseHeader, parseBold, parseItalic, parseString]
-
-parsePara :: ReadP MdToken
-parsePara =  do
-         parsed <- parseMany parseLine
+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)