Applied lots of hints, mostly redundant brackets
This commit is contained in:
@@ -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)
|
||||||
|
Reference in New Issue
Block a user