Applied lots of hints, mostly redundant brackets

This commit is contained in:
2025-05-06 17:09:54 -05:00
parent ca0d09dfab
commit ef132791a1

View File

@@ -1,3 +1,5 @@
{-# LANGUAGE InstanceSigs #-}
module MdToHTML where module MdToHTML where
import Control.Applicative import Control.Applicative
@@ -38,20 +40,21 @@ data MdToken
-- Deriving Show for MdToken -- Deriving Show for MdToken
instance Show MdToken where instance Show MdToken where
show (Document tokens) = concat (map show tokens) show :: MdToken -> String
show (Document tokens) = concatMap show tokens
show (Header level token) = "<h" ++ show level ++ ">" ++ show token ++ "</h" ++ show level ++ ">" show (Header level token) = "<h" ++ show level ++ ">" ++ show token ++ "</h" ++ show level ++ ">"
show (Para token) = "<p>" ++ show token ++ "</p>" show (Para token) = "<p>" ++ show token ++ "</p>"
show (Line tokens) = concat (map show tokens) show (Line tokens) = concatMap show tokens
show Linebreak = "<br>" show Linebreak = "<br>"
show SingleNewline = " " show SingleNewline = " "
show HorizontalRule = "---------" show HorizontalRule = "---------"
show (Blockquote token) = "BLOCK" ++ show token show (Blockquote token) = "BLOCK" ++ show token
show (UnordList tokens) = "UNORD" ++ concat (map show tokens) show (UnordList tokens) = "UNORD" ++ concatMap show tokens
show (OrdList tokens) = "ORD" ++ concat (map show tokens) show (OrdList tokens) = "ORD" ++ concatMap show tokens
show (Code code) = show code show (Code code) = show code
show (Codeblock code) = show code show (Codeblock code) = show code
show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ show txt ++ "</a>" show (Link txt url) = "<a href=" ++ getUrl url ++ ">" ++ show txt ++ "</a>"
show (Image txt imgPath) = "<img src=" ++ (getPath imgPath) ++ ">" ++ show txt ++ "</img>" show (Image txt imgPath) = "<img src=" ++ getPath imgPath ++ ">" ++ show txt ++ "</img>"
show (Bold token) = "<b>" ++ show token ++ "</b>" show (Bold token) = "<b>" ++ show token ++ "</b>"
show (Italic token) = "<i>" ++ show token ++ "</i>" show (Italic token) = "<i>" ++ show token ++ "</i>"
show (Strikethrough token) = "<s>" ++ show token ++ "</s>" show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
@@ -61,8 +64,8 @@ instance Show MdToken where
-- Helpers -- Helpers
leftmostLongest :: (Foldable t) => [(a, t b)] -> (a, t b) leftmostLongest :: (Foldable t) => [(a, t b)] -> (a, t b)
leftmostLongest xs = leftmostLongest xs =
let lastElem = (last xs) let lastElem = last xs
filteredLst = (filter (\val -> (length $ snd val) == (length $ snd lastElem)) xs) filteredLst = filter (\val -> length (snd val) == length (snd lastElem)) xs
in head filteredLst in head filteredLst
-- Get the first parse returned by readP_to_S that consumed the most input -- Get the first parse returned by readP_to_S that consumed the most input
@@ -88,7 +91,7 @@ parseHeader = do
skipSpaces skipSpaces
headers <- munch1 (== '#') headers <- munch1 (== '#')
when when
((length headers) > 6) (length headers > 6)
pfail pfail
skipSpaces skipSpaces
text <- munch1 (/= '\n') text <- munch1 (/= '\n')
@@ -135,7 +138,7 @@ parseSingleNewline = do
parseString :: ReadP MdToken parseString :: ReadP MdToken
parseString = do parseString = do
firstChar <- satisfy (/= '\n') -- Must parse at least one non-newline character here firstChar <- satisfy (/= '\n') -- Must parse at least one non-newline character here
text <- munch (\x -> not (elem x "#*_[\n ")) text <- munch (`notElem` "#*_[\n ")
return (Unit (firstChar : text)) return (Unit (firstChar : text))
lineParsers :: [ReadP MdToken] lineParsers :: [ReadP MdToken]
@@ -164,7 +167,7 @@ parsePara = do
parseMany (char '\n') parseMany (char '\n')
-- text <- many1 (lookaheadParse (\x -> ((length x) < 2) || (take 2 x) /= "\n\n")) -- Parse until a double-newline. -- text <- many1 (lookaheadParse (\x -> ((length x) < 2) || (take 2 x) /= "\n\n")) -- Parse until a double-newline.
-- string "\n\n" <|> (eof >> return "") -- Consume the next double-newline or EOF. -- string "\n\n" <|> (eof >> return "") -- Consume the next double-newline or EOF.
text <- (manyTill get ((string "\n\n") <|> (eof >> return ""))) text <- manyTill get (string "\n\n" <|> (eof >> return ""))
when (null text) pfail when (null text) pfail
let parsedText = fst $ leftmostLongestParse parseLine text -- Parse either a line or a header. let parsedText = fst $ leftmostLongestParse parseLine text -- Parse either a line or a header.
-- If the paragraph is a header, return a Header token. Otheriwse return a Para token. -- If the paragraph is a header, return a Header token. Otheriwse return a Para token.
@@ -175,5 +178,5 @@ parsePara = do
-- Parse a document, which is multiple paragraphs. -- Parse a document, which is multiple paragraphs.
parseDocument :: ReadP MdToken parseDocument :: ReadP MdToken
parseDocument = do parseDocument = do
res <- manyTill (parseHeader <++ parsePara) (eof) res <- manyTill (parseHeader <++ parsePara) eof
return (Document res) return (Document res)