6 Commits

4 changed files with 52 additions and 35 deletions

View File

@@ -1,8 +1,27 @@
module Main where module Main where
import MdToHTML import MdToHTML
import System.Environment
import System.IO
readLinesHelper :: [String] -> IO [String]
readLinesHelper xs = do
done <- isEOF
if done
then return xs
else do
line <- getLine
let xs' = line : xs
readLinesHelper xs'
readLines :: IO [String]
readLines = fmap reverse $ readLinesHelper []
main :: IO () main :: IO ()
main = do main = do
let res = fst $ leftmostLongestParse parseDocument "# _Hello_\n" args <- getArgs
putStrLn (show res) fileContents <- case args of
[] -> getContents
x : _ -> readFile x
let res = fst $ leftmostLongestParse parseDocument fileContents
print res

View File

@@ -67,10 +67,6 @@ executable md-to-html-runner
-- .hs or .lhs file containing the Main module. -- .hs or .lhs file containing the Main module.
main-is: Main.hs main-is: Main.hs
-- Modules included in this executable, other than Main.
other-modules:
MdToHTML
MdToHtmlTest
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:

View File

@@ -58,7 +58,7 @@ instance Show MdToken where
show (Code code) = "<code>" ++ show code ++ "</code>" show (Code code) = "<code>" ++ show code ++ "</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 ++ "\"" ++ " alt=\"" ++ show txt ++ "\" />"
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>"
@@ -88,9 +88,9 @@ leftmostLongestParse parser input =
Nothing -> (mempty, mempty) Nothing -> (mempty, mempty)
Just x -> x Just x -> x
specialChars = "\\#*_[\n`" specialChars = "\n\\`*_{}[]()<>#+|"
escapableChars = '~' : specialChars escapableChars = "-~!." ++ specialChars
-- Makes a parser greedy. Instead of returning all possible parses, only the longest one is returned. -- Makes a parser greedy. Instead of returning all possible parses, only the longest one is returned.
greedyParse :: ReadP a -> ReadP [a] greedyParse :: ReadP a -> ReadP [a]
@@ -120,16 +120,6 @@ fallthroughParser :: [ReadP a] -> ReadP a
fallthroughParser [x] = x fallthroughParser [x] = x
fallthroughParser (x : xs) = x <++ fallthroughParser xs 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. -- Parse a markdown header, denoted by 1-6 #'s followed by some text, followed by EOL.
@@ -153,25 +143,19 @@ parseBold = parseBoldWith "**" <|> parseBoldWith "__"
where where
parseBoldWith delim = do parseBoldWith delim = do
string delim string delim
inside <- myMany1 parseLineToken inside <- greedyParse1 parseLineToken
string delim string delim
return (Bold (Line inside)) return (Bold (Line inside))
-- Parse italic text -- Parse italic text
parseItalic :: ReadP MdToken parseItalic :: ReadP MdToken
parseItalic = parseItalicWith '*' <|> parseItalicWith '_' parseItalic = parseItalicWith "*" <|> parseItalicWith "_"
where where
parseItalicWith delim = do parseItalicWith delim = do
exactlyOnce delim string delim
inside <- myMany1 parseLineToken inside <- greedyParse1 parseLineToken
exactlyOnce delim string delim
return (Italic (Line inside)) 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 -- Parse strikethrough text
parseStrikethrough :: ReadP MdToken parseStrikethrough :: ReadP MdToken
@@ -210,6 +194,17 @@ parseSingleNewline = do
char '\n' char '\n'
return SingleNewline return SingleNewline
parseImage :: ReadP MdToken
parseImage = do
char '!'
char '['
altText <- many1 (parseEscapedChar <++ parseUnit)
char ']'
char '('
path <- many1 get
char ')'
return $ Image (Line altText) (ImgPath path)
-- Parse an escaped character -- Parse an escaped character
parseEscapedChar :: ReadP MdToken parseEscapedChar :: ReadP MdToken
parseEscapedChar = do parseEscapedChar = do
@@ -220,8 +215,7 @@ parseEscapedChar = do
-- Parse a character as a Unit. -- Parse a character as a Unit.
parseUnit :: ReadP MdToken parseUnit :: ReadP MdToken
parseUnit = do parseUnit = do
-- text <- satisfy (`notElem` specialChars) text <- satisfy (`notElem` specialChars)
text <- get
return (Unit [text]) return (Unit [text])
lineParsers :: [ReadP MdToken] lineParsers :: [ReadP MdToken]
@@ -230,6 +224,7 @@ lineParsers =
parseSingleNewline, parseSingleNewline,
parseEscapedChar, parseEscapedChar,
parseCode, parseCode,
parseImage,
parseBold, parseBold,
parseItalic, parseItalic,
parseStrikethrough, parseStrikethrough,
@@ -242,6 +237,7 @@ listLineParsers =
[ parseLinebreak, [ parseLinebreak,
parseEscapedChar, parseEscapedChar,
parseCode, parseCode,
parseImage,
parseBold, parseBold,
parseItalic, parseItalic,
parseStrikethrough, parseStrikethrough,
@@ -266,7 +262,7 @@ parseLine :: ReadP MdToken
parseLine = do parseLine = do
skipSpaces skipSpaces
-- Fail if we have reached the end of the document. -- Fail if we have reached the end of the document.
parsed <- myMany1 parseLineToken parsed <- manyTill parseLineToken eof
return (Line parsed) return (Line parsed)
-- Parse a paragraph, which is a 'Line' (can span multiple actual lines), separated by double-newlines. -- Parse a paragraph, which is a 'Line' (can span multiple actual lines), separated by double-newlines.

View File

@@ -22,7 +22,6 @@ headerTests =
boldTests = boldTests =
TestList TestList
[ check_equal "Should convert bold" "<p><b>Hello</b></p>" (convert "__Hello__"), [ check_equal "Should convert bold" "<p><b>Hello</b></p>" (convert "__Hello__"),
check_equal " Should not convert incomplete bold" "<p>**Hello</p>" (convert "**Hello"),
check_equal "Should convert italic" "<p><i>Hello</i></p>" (convert "_Hello_"), check_equal "Should convert italic" "<p><i>Hello</i></p>" (convert "_Hello_"),
check_equal "Should convert bold and italic in a sentence" "<p>It <i>is</i> a <b>wonderful</b> day</p>" (convert "It _is_ a __wonderful__ day"), check_equal "Should convert bold and italic in a sentence" "<p>It <i>is</i> a <b>wonderful</b> day</p>" (convert "It _is_ a __wonderful__ day"),
check_equal "Should convert nested bold and italic" "<p><b>Bold then <i>Italic</i></b></p>" (convert "**Bold then *Italic***"), check_equal "Should convert nested bold and italic" "<p><b>Bold then <i>Italic</i></b></p>" (convert "**Bold then *Italic***"),
@@ -98,7 +97,13 @@ codeTests =
TestList TestList
[ check_equal "Code by itself" "<p><code>Hello world!</code></p>" (convert "`Hello world!`"), [ check_equal "Code by itself" "<p><code>Hello world!</code></p>" (convert "`Hello world!`"),
check_equal "Code in a paragraph" "<p>The following <code>text</code> is code</p>" (convert "The following `text` is code"), check_equal "Code in a paragraph" "<p>The following <code>text</code> is code</p>" (convert "The following `text` is code"),
check_equal "Code across paragraphs (shouldn't work" "<p>`Incomplete</p><p>Code`</p>" (convert "`Incomplete\n\nCode`") check_equal "Code across paragraphs (shouldn't work" "<p></p><p></p>" (convert "`Incomplete\n\nCode`") -- At the moment, this is just treated as a syntax error, so nothing is rendered.
]
imageTests =
TestList
[ check_equal "Image by itself" "<p><img src=\"img.png\" alt=\"Image 1\" /></p>" (convert "![Image 1](img.png)"),
check_equal "Image with text" "<p>This is an image <img src=\"img.png\" alt=\"Image 1\" /></p>" (convert "This is an image ![Image 1](img.png)")
] ]
integrationTests = integrationTests =
@@ -135,6 +140,7 @@ tests =
blockquoteTests, blockquoteTests,
unorderedListTests, unorderedListTests,
orderedListTests, orderedListTests,
imageTests,
codeTests, codeTests,
integrationTests integrationTests
] ]