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

Applied lots of hints, mostly redundant brackets

Browse Source
This commit is contained in:
Aadhavan Srinivasan
2025-05-06 17:09:54 -05:00
parent ca0d09dfab
commit ef132791a1
1 changed files with 15 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
src/MdToHTML.hs
View File

@@ -1,3 +1,5 @@
{-# LANGUAGE InstanceSigs #-}
module MdToHTML where
import Control.Applicative
@@ -38,20 +40,21 @@ data MdToken
-- Deriving Show for MdToken
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 (Para token) = "<p>" ++ show token ++ "</p>"
show (Line tokens) = concat (map show tokens)
show (Line tokens) = concatMap show tokens
show Linebreak = "<br>"
show SingleNewline = " "
show HorizontalRule = "---------"
show (Blockquote token) = "BLOCK" ++ show token
show (UnordList tokens) = "UNORD" ++ concat (map show tokens)
show (OrdList tokens) = "ORD" ++ concat (map show tokens)
show (UnordList tokens) = "UNORD" ++ concatMap show tokens
show (OrdList tokens) = "ORD" ++ concatMap show tokens
show (Code code) = show code
show (Codeblock code) = show code
show (Link txt url) = "<a href=" ++ (getUrl url) ++ ">" ++ show txt ++ "</a>"
show (Image txt imgPath) = "<img src=" ++ (getPath imgPath) ++ ">" ++ show txt ++ "</img>"
show (Link txt url) = "<a href=" ++ getUrl url ++ ">" ++ show txt ++ "</a>"
show (Image txt imgPath) = "<img src=" ++ getPath imgPath ++ ">" ++ show txt ++ "</img>"
show (Bold token) = "<b>" ++ show token ++ "</b>"
show (Italic token) = "<i>" ++ show token ++ "</i>"
show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
@@ -61,8 +64,8 @@ instance Show MdToken where
-- Helpers
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)
let lastElem = last xs
filteredLst = filter (\val -> length (snd val) == length (snd lastElem)) xs
in head filteredLst
-- Get the first parse returned by readP_to_S that consumed the most input
@@ -88,7 +91,7 @@ parseHeader = do
skipSpaces
headers <- munch1 (== '#')
when
((length headers) > 6)
(length headers > 6)
pfail
skipSpaces
text <- munch1 (/= '\n')
@@ -135,7 +138,7 @@ parseSingleNewline = do
parseString :: ReadP MdToken
parseString = do
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))
lineParsers :: [ReadP MdToken]
@@ -164,7 +167,7 @@ parsePara = do
parseMany (char '\n')
-- 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.
text <- (manyTill get ((string "\n\n") <|> (eof >> return "")))
text <- manyTill get (string "\n\n" <|> (eof >> return ""))
when (null text) pfail
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.
@@ -175,5 +178,5 @@ parsePara = do
-- Parse a document, which is multiple paragraphs.
parseDocument :: ReadP MdToken
parseDocument = do
res <- manyTill (parseHeader <++ parsePara) (eof)
res <- manyTill (parseHeader <++ parsePara) eof
return (Document res)