|
|
|
@ -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)
|
|
|
|
|