Compare commits

...

10 Commits

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

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

@ -37,6 +37,7 @@ data MdToken
| Codeblock String | Codeblock String
| Link MdToken URL | Link MdToken URL
| Image MdToken ImgPath | Image MdToken ImgPath
| Figure MdToken ImgPath
| Bold MdToken | Bold MdToken
| Italic MdToken | Italic MdToken
| Strikethrough MdToken | Strikethrough MdToken
@ -58,7 +59,8 @@ 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 (Figure txt imgPath) = "<figure><img src=\"" ++ getPath imgPath ++ "\" alt=\"" ++ show txt ++ "\"/><figcaption aria-hidden=\"true\">" ++ show txt ++ "</figcaption></figure>"
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 +90,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]
@ -192,7 +194,28 @@ parseLinebreak = do
parseSingleNewline :: ReadP MdToken parseSingleNewline :: ReadP MdToken
parseSingleNewline = do parseSingleNewline = do
char '\n' char '\n'
return SingleNewline remaining <- look
case remaining of
[] -> return $ Unit ""
_ -> 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)
parseFigure = do
img <- parseImage
void (string "\n\n") <++ eof
case img of
Image text path -> return $ Figure text path
_ -> return img
-- Parse an escaped character -- Parse an escaped character
parseEscapedChar :: ReadP MdToken parseEscapedChar :: ReadP MdToken
@ -213,6 +236,7 @@ lineParsers =
parseSingleNewline, parseSingleNewline,
parseEscapedChar, parseEscapedChar,
parseCode, parseCode,
parseImage,
parseBold, parseBold,
parseItalic, parseItalic,
parseStrikethrough, parseStrikethrough,
@ -225,6 +249,7 @@ listLineParsers =
[ parseLinebreak, [ parseLinebreak,
parseEscapedChar, parseEscapedChar,
parseCode, parseCode,
parseImage,
parseBold, parseBold,
parseItalic, parseItalic,
parseStrikethrough, parseStrikethrough,
@ -261,6 +286,7 @@ parsePara = do
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 a line let parsedText = fst $ leftmostLongestParse parseLine text -- Parse a line
parseMany (char '\n')
return (Para parsedText) return (Para parsedText)
-- Parse a line starting with '>', return the line except for the '>'. -- Parse a line starting with '>', return the line except for the '>'.
@ -381,12 +407,17 @@ parseOrderedList = do
void (char '\n') <++ eof void (char '\n') <++ eof
return $ OrdList (firstLine : lineItems) return $ OrdList (firstLine : lineItems)
parseHorizontalRule :: ReadP MdToken
parseHorizontalRule = string "---" *> (void (string "\n\n") <++ eof) *> return HorizontalRule
documentParsers :: [ReadP MdToken] documentParsers :: [ReadP MdToken]
documentParsers = documentParsers =
[ parseHeader, [ parseHorizontalRule,
parseHeader,
parseBlockquote, parseBlockquote,
parseUnorderedList, parseUnorderedList,
parseOrderedList, parseOrderedList,
parseFigure,
parsePara parsePara
] ]

@ -97,9 +97,23 @@ 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 with text" "<p>This is an image <img src=\"img.png\" alt=\"Image 1\" /></p>" (convert "This is an image ![Image 1](img.png)")
]
figureTests =
TestList
[ check_equal "Image by itself" "<figure><img src=\"img.png\" alt=\"Image 1\"/><figcaption aria-hidden=\"true\">Image 1</figcaption></figure>" (convert "![Image 1](img.png)")
]
horizontalRuleTests =
TestList
[check_equal "Horizontal Rule" "<p>a</p><hr><p>b</p>" (convert "a\n\n---\n\nb")]
integrationTests = integrationTests =
TestList TestList
[ check_equal "Integration 1" "<h1>Sample Markdown</h1><p>This is some basic, sample markdown.</p><h2><b>Second</b> <i>Heading</i></h2>" (convert "# Sample Markdown\n\n This is some basic, sample markdown.\n\n ## __Second__ _Heading_"), [ check_equal "Integration 1" "<h1>Sample Markdown</h1><p>This is some basic, sample markdown.</p><h2><b>Second</b> <i>Heading</i></h2>" (convert "# Sample Markdown\n\n This is some basic, sample markdown.\n\n ## __Second__ _Heading_"),
@ -134,7 +148,10 @@ tests =
blockquoteTests, blockquoteTests,
unorderedListTests, unorderedListTests,
orderedListTests, orderedListTests,
imageTests,
figureTests,
codeTests, codeTests,
horizontalRuleTests,
integrationTests integrationTests
] ]

Loading…
Cancel
Save