Compare commits
10 Commits
4101767aff
...
master
Author | SHA1 | Date | |
---|---|---|---|
1d9ac86a2a | |||
0320402957 | |||
8696a185a7 | |||
da38ac226f | |||
1fcce32ef6 | |||
e50081614a | |||
b98a8cc44f | |||
90c7a585d2 | |||
4a15330874 | |||
c14112d3e4 |
23
app/Main.hs
23
app/Main.hs
@@ -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 ")
|
||||||
|
]
|
||||||
|
|
||||||
|
figureTests =
|
||||||
|
TestList
|
||||||
|
[ check_equal "Image by itself" "<figure><img src=\"img.png\" alt=\"Image 1\"/><figcaption aria-hidden=\"true\">Image 1</figcaption></figure>" (convert "")
|
||||||
|
]
|
||||||
|
|
||||||
|
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
|
||||||
]
|
]
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user