Rockingcool/md-to-html
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Aadhavan Srinivasan
2025-04-30 16:01:34 -04:00
parent cbdcfcfea7
commit 626eb71097
1 changed files with 20 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
app/Main.hs
View File

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