|
|
|
@@ -33,7 +33,7 @@ data MdToken
|
|
|
|
|
| Blockquote [MdToken]
|
|
|
|
|
| UnordList [MdToken]
|
|
|
|
|
| OrdList [MdToken]
|
|
|
|
|
| Code String
|
|
|
|
|
| Code MdToken
|
|
|
|
|
| Codeblock String
|
|
|
|
|
| Link MdToken URL
|
|
|
|
|
| Image MdToken ImgPath
|
|
|
|
@@ -51,11 +51,11 @@ instance Show MdToken where
|
|
|
|
|
show (Line tokens) = concatMap show tokens
|
|
|
|
|
show Linebreak = "<br>"
|
|
|
|
|
show SingleNewline = " "
|
|
|
|
|
show HorizontalRule = "---------"
|
|
|
|
|
show HorizontalRule = "<hr>"
|
|
|
|
|
show (Blockquote tokens) = "<blockquote>" ++ concatMap show tokens ++ "</blockquote>"
|
|
|
|
|
show (UnordList tokens) = "<ul>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ul>"
|
|
|
|
|
show (OrdList tokens) = "<ol>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ol>"
|
|
|
|
|
show (Code code) = show code
|
|
|
|
|
show (Code code) = "<code>" ++ show code ++ "</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>"
|
|
|
|
@@ -88,7 +88,9 @@ leftmostLongestParse parser input =
|
|
|
|
|
Nothing -> (mempty, mempty)
|
|
|
|
|
Just x -> x
|
|
|
|
|
|
|
|
|
|
specialChars = "\\#*_[\n"
|
|
|
|
|
specialChars = "\\#*_[\n`"
|
|
|
|
|
|
|
|
|
|
escapableChars = '~' : specialChars
|
|
|
|
|
|
|
|
|
|
-- Makes a parser greedy. Instead of returning all possible parses, only the longest one is returned.
|
|
|
|
|
greedyParse :: ReadP a -> ReadP [a]
|
|
|
|
@@ -118,6 +120,16 @@ fallthroughParser :: [ReadP a] -> ReadP a
|
|
|
|
|
fallthroughParser [x] = x
|
|
|
|
|
fallthroughParser (x : xs) = x <++ fallthroughParser xs
|
|
|
|
|
|
|
|
|
|
myMany :: (Monoid a) => ReadP a -> ReadP [a]
|
|
|
|
|
myMany p = do
|
|
|
|
|
remaining <- look
|
|
|
|
|
case remaining of
|
|
|
|
|
[] -> return []
|
|
|
|
|
_ -> return [] +++ myMany1 p
|
|
|
|
|
|
|
|
|
|
myMany1 :: (Monoid a) => ReadP a -> ReadP [a]
|
|
|
|
|
myMany1 p = liftM2 (:) p (myMany p)
|
|
|
|
|
|
|
|
|
|
-- ---------------
|
|
|
|
|
|
|
|
|
|
-- Parse a markdown header, denoted by 1-6 #'s followed by some text, followed by EOL.
|
|
|
|
@@ -141,19 +153,25 @@ parseBold = parseBoldWith "**" <|> parseBoldWith "__"
|
|
|
|
|
where
|
|
|
|
|
parseBoldWith delim = do
|
|
|
|
|
string delim
|
|
|
|
|
inside <- greedyParse1 parseLineToken
|
|
|
|
|
inside <- myMany1 parseLineToken
|
|
|
|
|
string delim
|
|
|
|
|
return (Bold (Line inside))
|
|
|
|
|
|
|
|
|
|
-- Parse italic text
|
|
|
|
|
parseItalic :: ReadP MdToken
|
|
|
|
|
parseItalic = parseItalicWith "*" <|> parseItalicWith "_"
|
|
|
|
|
parseItalic = parseItalicWith '*' <|> parseItalicWith '_'
|
|
|
|
|
where
|
|
|
|
|
parseItalicWith delim = do
|
|
|
|
|
string delim
|
|
|
|
|
inside <- greedyParse1 parseLineToken
|
|
|
|
|
string delim
|
|
|
|
|
exactlyOnce delim
|
|
|
|
|
inside <- myMany1 parseLineToken
|
|
|
|
|
exactlyOnce delim
|
|
|
|
|
return (Italic (Line inside))
|
|
|
|
|
exactlyOnce ch = do
|
|
|
|
|
char ch
|
|
|
|
|
remaining <- look
|
|
|
|
|
case remaining of
|
|
|
|
|
[] -> return ch
|
|
|
|
|
x : xs -> if x == ch then pfail else return ch
|
|
|
|
|
|
|
|
|
|
-- Parse strikethrough text
|
|
|
|
|
parseStrikethrough :: ReadP MdToken
|
|
|
|
@@ -163,6 +181,14 @@ parseStrikethrough = do
|
|
|
|
|
string "~~"
|
|
|
|
|
return (Strikethrough (Line inside))
|
|
|
|
|
|
|
|
|
|
-- Parse code
|
|
|
|
|
parseCode :: ReadP MdToken
|
|
|
|
|
parseCode = do
|
|
|
|
|
string "`"
|
|
|
|
|
inside <- many1 get
|
|
|
|
|
string "`"
|
|
|
|
|
return (Code (Unit inside))
|
|
|
|
|
|
|
|
|
|
-- Parse a link
|
|
|
|
|
parseLink :: ReadP MdToken
|
|
|
|
|
parseLink = do
|
|
|
|
@@ -188,27 +214,22 @@ parseSingleNewline = do
|
|
|
|
|
parseEscapedChar :: ReadP MdToken
|
|
|
|
|
parseEscapedChar = do
|
|
|
|
|
char '\\'
|
|
|
|
|
escapedChar <- choice (map char specialChars) -- Parse any of the special chars.
|
|
|
|
|
escapedChar <- choice (map char escapableChars) -- Parse any of the special chars.
|
|
|
|
|
return (Unit [escapedChar])
|
|
|
|
|
|
|
|
|
|
-- Parse a character as a Unit.
|
|
|
|
|
parseUnit :: ReadP MdToken
|
|
|
|
|
parseUnit = do
|
|
|
|
|
text <- satisfy (`notElem` specialChars)
|
|
|
|
|
-- text <- satisfy (`notElem` specialChars)
|
|
|
|
|
text <- get
|
|
|
|
|
return (Unit [text])
|
|
|
|
|
|
|
|
|
|
-- Parse a regular string as a Unit.
|
|
|
|
|
parseString :: ReadP MdToken
|
|
|
|
|
parseString = do
|
|
|
|
|
firstChar <- satisfy (/= '\n') -- Must parse at least one non-newline character here
|
|
|
|
|
text <- munch (`notElem` specialChars)
|
|
|
|
|
return (Unit (firstChar : text))
|
|
|
|
|
|
|
|
|
|
lineParsers :: [ReadP MdToken]
|
|
|
|
|
lineParsers =
|
|
|
|
|
[ parseLinebreak,
|
|
|
|
|
parseSingleNewline,
|
|
|
|
|
parseEscapedChar,
|
|
|
|
|
parseCode,
|
|
|
|
|
parseBold,
|
|
|
|
|
parseItalic,
|
|
|
|
|
parseStrikethrough,
|
|
|
|
@@ -220,6 +241,7 @@ listLineParsers :: [ReadP MdToken]
|
|
|
|
|
listLineParsers =
|
|
|
|
|
[ parseLinebreak,
|
|
|
|
|
parseEscapedChar,
|
|
|
|
|
parseCode,
|
|
|
|
|
parseBold,
|
|
|
|
|
parseItalic,
|
|
|
|
|
parseStrikethrough,
|
|
|
|
@@ -244,7 +266,7 @@ parseLine :: ReadP MdToken
|
|
|
|
|
parseLine = do
|
|
|
|
|
skipSpaces
|
|
|
|
|
-- Fail if we have reached the end of the document.
|
|
|
|
|
parsed <- manyTill parseLineToken eof
|
|
|
|
|
parsed <- myMany1 parseLineToken
|
|
|
|
|
return (Line parsed)
|
|
|
|
|
|
|
|
|
|
-- Parse a paragraph, which is a 'Line' (can span multiple actual lines), separated by double-newlines.
|
|
|
|
|