Compare commits
3 Commits
1fcce32ef6
...
fixingInco
Author | SHA1 | Date | |
---|---|---|---|
09982f4ab1 | |||
4101767aff | |||
234145bcb3 |
23
app/Main.hs
23
app/Main.hs
@@ -1,27 +1,8 @@
|
|||||||
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
|
||||||
args <- getArgs
|
let res = fst $ leftmostLongestParse parseDocument "# _Hello_\n"
|
||||||
fileContents <- case args of
|
putStrLn (show res)
|
||||||
[] -> getContents
|
|
||||||
x : _ -> readFile x
|
|
||||||
let res = fst $ leftmostLongestParse parseDocument fileContents
|
|
||||||
print res
|
|
||||||
|
@@ -67,6 +67,10 @@ 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:
|
||||||
|
@@ -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 ++ "\"" ++ " alt=\"" ++ show txt ++ "\" />"
|
show (Image txt imgPath) = "<img src=" ++ getPath imgPath ++ ">" ++ show txt ++ "</img>"
|
||||||
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,6 +120,16 @@ 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.
|
||||||
@@ -143,19 +153,25 @@ parseBold = parseBoldWith "**" <|> parseBoldWith "__"
|
|||||||
where
|
where
|
||||||
parseBoldWith delim = do
|
parseBoldWith delim = do
|
||||||
string delim
|
string delim
|
||||||
inside <- greedyParse1 parseLineToken
|
inside <- myMany1 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
|
||||||
string delim
|
exactlyOnce delim
|
||||||
inside <- greedyParse1 parseLineToken
|
inside <- myMany1 parseLineToken
|
||||||
string delim
|
exactlyOnce 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
|
||||||
@@ -194,17 +210,6 @@ 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
|
||||||
@@ -215,7 +220,8 @@ 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]
|
||||||
@@ -224,7 +230,6 @@ lineParsers =
|
|||||||
parseSingleNewline,
|
parseSingleNewline,
|
||||||
parseEscapedChar,
|
parseEscapedChar,
|
||||||
parseCode,
|
parseCode,
|
||||||
parseImage,
|
|
||||||
parseBold,
|
parseBold,
|
||||||
parseItalic,
|
parseItalic,
|
||||||
parseStrikethrough,
|
parseStrikethrough,
|
||||||
@@ -237,7 +242,6 @@ listLineParsers =
|
|||||||
[ parseLinebreak,
|
[ parseLinebreak,
|
||||||
parseEscapedChar,
|
parseEscapedChar,
|
||||||
parseCode,
|
parseCode,
|
||||||
parseImage,
|
|
||||||
parseBold,
|
parseBold,
|
||||||
parseItalic,
|
parseItalic,
|
||||||
parseStrikethrough,
|
parseStrikethrough,
|
||||||
@@ -262,7 +266,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 <- manyTill parseLineToken eof
|
parsed <- myMany1 parseLineToken
|
||||||
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.
|
||||||
|
@@ -22,6 +22,7 @@ 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***"),
|
||||||
@@ -97,13 +98,7 @@ 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></p><p></p>" (convert "`Incomplete\n\nCode`") -- At the moment, this is just treated as a syntax error, so nothing is rendered.
|
check_equal "Code across paragraphs (shouldn't work" "<p>`Incomplete</p><p>Code`</p>" (convert "`Incomplete\n\nCode`")
|
||||||
]
|
|
||||||
|
|
||||||
imageTests =
|
|
||||||
TestList
|
|
||||||
[ check_equal "Image by itself" "<p><img src=\"img.png\" alt=\"Image 1\" /></p>" (convert ""),
|
|
||||||
check_equal "Image with text" "<p>This is an image <img src=\"img.png\" alt=\"Image 1\" /></p>" (convert "This is an image ")
|
|
||||||
]
|
]
|
||||||
|
|
||||||
integrationTests =
|
integrationTests =
|
||||||
@@ -140,7 +135,6 @@ tests =
|
|||||||
blockquoteTests,
|
blockquoteTests,
|
||||||
unorderedListTests,
|
unorderedListTests,
|
||||||
orderedListTests,
|
orderedListTests,
|
||||||
imageTests,
|
|
||||||
codeTests,
|
codeTests,
|
||||||
integrationTests
|
integrationTests
|
||||||
]
|
]
|
||||||
|
Reference in New Issue
Block a user