Implementation and test for horizontal rule

app/Main.hs

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

md-to-html.cabal

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

src/MdToHTML.hs

@@ -33,10 +33,11 @@ data MdToken
   | Blockquote [MdToken]
   | UnordList [MdToken]
   | OrdList [MdToken]
-  | Code String
+  | Code MdToken
   | Codeblock String
   | Link MdToken URL
   | Image MdToken ImgPath
+  | Figure MdToken ImgPath
   | Bold MdToken
   | Italic MdToken
   | Strikethrough MdToken
@@ -51,14 +52,15 @@ instance Show MdToken where
   show (Line tokens) = concatMap show tokens
   show Linebreak = "<br>"
   show SingleNewline = " "
-  show HorizontalRule = "---------"
+  show HorizontalRule = "<hr>"
   show (Blockquote tokens) = "<blockquote>" ++ concatMap show tokens ++ "</blockquote>"
   show (UnordList tokens) = "<ul>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ul>"
   show (OrdList tokens) = "<ol>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ol>"
-  show (Code code) = show code
+  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,7 +90,9 @@ leftmostLongestParse parser input =
         Nothing -> (mempty, mempty)
         Just x -> x
 
-specialChars = "\\#*_[\n"
+specialChars = "\n\\`*_{}[]()<>#+|"
+
+escapableChars = "-~!." ++ specialChars
 
 -- Makes a parser greedy. Instead of returning all possible parses, only the longest one is returned.
 greedyParse :: ReadP a -> ReadP [a]
@@ -163,6 +167,14 @@ parseStrikethrough = do
   string "~~"
   return (Strikethrough (Line inside))
 
+-- Parse code
+parseCode :: ReadP MdToken
+parseCode = do
+  string "`"
+  inside <- many1 get
+  string "`"
+  return (Code (Unit inside))
+
 -- Parse a link
 parseLink :: ReadP MdToken
 parseLink = do
@@ -182,13 +194,34 @@ 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
 parseEscapedChar = do
   char '\\'
-  escapedChar <- choice (map char specialChars) -- Parse any of the special chars.
+  escapedChar <- choice (map char escapableChars) -- Parse any of the special chars.
   return (Unit [escapedChar])
 
 -- Parse a character as a Unit.
@@ -197,18 +230,13 @@ parseUnit = do
   text <- satisfy (`notElem` specialChars)
   return (Unit [text])
 
--- Parse a regular string as a Unit.
-parseString :: ReadP MdToken
-parseString = do
-  firstChar <- satisfy (/= '\n') -- Must parse at least one non-newline character here
-  text <- munch (`notElem` specialChars)
-  return (Unit (firstChar : text))
-
 lineParsers :: [ReadP MdToken]
 lineParsers =
   [ parseLinebreak,
     parseSingleNewline,
     parseEscapedChar,
+    parseCode,
+    parseImage,
     parseBold,
     parseItalic,
     parseStrikethrough,
@@ -220,6 +248,8 @@ listLineParsers :: [ReadP MdToken]
 listLineParsers =
   [ parseLinebreak,
     parseEscapedChar,
+    parseCode,
+    parseImage,
     parseBold,
     parseItalic,
     parseStrikethrough,
@@ -256,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 '>'.
@@ -376,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
   ]
 

src/MdToHtmlTest.hs

@@ -93,6 +93,27 @@ orderedListTests =
       check_equal "Unordered list in ordered list" "<ol><li>Item 1</li><li>Item 2<ul><li>Item 1</li><li>Item 2</li></ul></li><li>Item 3</li></ol>" (convert "1. Item 1\n2. Item 2\n    - Item 1\n    * Item 2\n4. Item 3")
     ]
 
+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></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_"),
@@ -127,6 +148,10 @@ tests =
       blockquoteTests,
       unorderedListTests,
       orderedListTests,
+      imageTests,
+      figureTests,
+      codeTests,
+      horizontalRuleTests,
       integrationTests
     ]