Compare commits

...

10 Commits

@ -1,8 +1,27 @@
module Main where
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 = do
let res = fst $ leftmostLongestParse parseDocument "# _Hello_\n"
putStrLn (show res)
args <- getArgs
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.
main-is: Main.hs
-- Modules included in this executable, other than Main.
other-modules:
MdToHTML
MdToHtmlTest
-- LANGUAGE extensions used by modules in this package.
-- other-extensions:

@ -37,6 +37,7 @@ data MdToken
| Codeblock String
| Link MdToken URL
| Image MdToken ImgPath
| Figure MdToken ImgPath
| Bold MdToken
| Italic MdToken
| Strikethrough MdToken
@ -58,7 +59,8 @@ instance Show MdToken where
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>"
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 (Italic token) = "<i>" ++ show token ++ "</i>"
show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
@ -88,9 +90,9 @@ leftmostLongestParse parser input =
Nothing -> (mempty, mempty)
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.
greedyParse :: ReadP a -> ReadP [a]
@ -192,7 +194,28 @@ parseLinebreak = do
parseSingleNewline :: ReadP MdToken
parseSingleNewline = do
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
parseEscapedChar :: ReadP MdToken
@ -213,6 +236,7 @@ lineParsers =
parseSingleNewline,
parseEscapedChar,
parseCode,
parseImage,
parseBold,
parseItalic,
parseStrikethrough,
@ -225,6 +249,7 @@ listLineParsers =
[ parseLinebreak,
parseEscapedChar,
parseCode,
parseImage,
parseBold,
parseItalic,
parseStrikethrough,
@ -261,6 +286,7 @@ parsePara = do
text <- manyTill get (string "\n\n" <|> (eof >> return ""))
when (null text) pfail
let parsedText = fst $ leftmostLongestParse parseLine text -- Parse a line
parseMany (char '\n')
return (Para parsedText)
-- Parse a line starting with '>', return the line except for the '>'.
@ -381,12 +407,17 @@ parseOrderedList = do
void (char '\n') <++ eof
return $ OrdList (firstLine : lineItems)
parseHorizontalRule :: ReadP MdToken
parseHorizontalRule = string "---" *> (void (string "\n\n") <++ eof) *> return HorizontalRule
documentParsers :: [ReadP MdToken]
documentParsers =
[ parseHeader,
[ parseHorizontalRule,
parseHeader,
parseBlockquote,
parseUnorderedList,
parseOrderedList,
parseFigure,
parsePara
]

@ -97,9 +97,23 @@ codeTests =
TestList
[ 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 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 =
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_"),
@ -134,7 +148,10 @@ tests =
blockquoteTests,
unorderedListTests,
orderedListTests,
imageTests,
figureTests,
codeTests,
horizontalRuleTests,
integrationTests
]

Loading…
Cancel
Save