Skip spaces at beginning of line; parse a line and header separately; add a Document data constructor for MdToken (consists of the entire document

app/Main.hs

@@ -4,5 +4,5 @@ import MdToHTML
 
 main :: IO ()
 main = do
-   let res = leftmostLongestParse parseLine "## Hello ___world___"
+   let res = fst $ leftmostLongestParse parseDocument "# _Hello_\n\n # Hello"
    putStrLn (show res)

src/MdToHTML.hs

@@ -15,7 +15,8 @@ newtype ImgPath = ImgPath {getPath :: String}
 parseMany :: ReadP a -> ReadP [a]
 parseMany = Text.ParserCombinators.ReadP.many
 
-data MdToken = Header HeaderLevel MdToken
+data MdToken = Document [MdToken]
+             | Header HeaderLevel MdToken
              | Para MdToken
              | Line [MdToken]
              | Linebreak
@@ -34,6 +35,7 @@ data MdToken = Header HeaderLevel MdToken
 
 -- Deriving Show for MdToken
 instance Show MdToken where
+    show (Document tokens) = concat(map show tokens)
     show (Header level token) = "<h" ++ show level ++ ">" ++ show token ++ "</h" ++ show level ++ ">"
     show (Para token) = "<p>" ++ show token ++ "</p>"
     show (Line tokens) =  concat(map show tokens)
@@ -83,6 +85,7 @@ lineToList (Line tokens) = tokens
 -- Parse a markdown header, denoted by 1-6 #'s followed by some text, followed by EOL.
 parseHeader :: ReadP MdToken
 parseHeader = do
+        skipSpaces
         headers <- many1 mustBeHash
         when ((length headers) > 6)
             pfail
@@ -125,25 +128,41 @@ parseString = do
          text <- munch (\x -> not (elem x "#*_[\n"))
          return (Unit (firstChar:text))
 
+lineParsers :: [ReadP MdToken]
+lineParsers = [parseHeader, parseLinebreak, parseBold, parseItalic, parseString] -- A 'line' doesn't include a 'header'
+
+-- List of all parsers
+allParsers :: [ReadP MdToken]
+allParsers = parseHeader:lineParsers
+
 -- Parse any of the above tokens.
-parseToken :: ReadP MdToken
+parseLineToken :: ReadP MdToken
-parseToken = choice [parseHeader, parseLinebreak, parseBold, parseItalic, parseString]
+parseLineToken = choice lineParsers
 
 -- Parse a line, consisting of one or more tokens.
 parseLine :: ReadP MdToken
 parseLine =  do
+         skipSpaces
+         -- Fail if we have reached the end of the document.
          remaining <- look
          when (null remaining) pfail
-         parsed <- parseMany parseToken
+         parsed <- parseMany parseLineToken
 --         traceM $ show parsed
          return (Line parsed)
 
 -- Parse a paragraph, which is a 'Line' (can span multiple actual lines), separated by double-newlines.
+-- As a weird special case, a 'Paragraph' can also be a 'Header'.
 parsePara :: ReadP MdToken
 parsePara = do
            parseMany (char '\n')
-           text <- many1 (lookaheadParse (\x -> ((length x) < 2) || (take 2 x) /= "\n\n"))
+           text <- many1 (lookaheadParse (\x -> ((length x) < 2) || (take 2 x) /= "\n\n")) -- Parse until a double-newline.
-           string "\n\n"
+           string "\n\n" <|> (eof >> return "") -- Consume the next double-newline or EOF.
-           -- I don't consume the ending double-newline, because the next paragraph will consume it as part of its starting double-newline.
+           let parsedText = fst $ leftmostLongestParse (parseHeader <|> parseLine) text -- Parse either a line or a header.
-           let parsedText = fst $ leftmostLongestParse parseLine text
+           -- If the paragraph is a header, return a Header token. Otheriwse return a Para token.
-           return (Para parsedText)
+           case parsedText of
+                Header level token -> return (Header level token)
+                _ -> return (Para parsedText)
+
+-- Parse a document, which is multiple paragraphs.
+parseDocument :: ReadP MdToken
+parseDocument = (many1 parsePara) >>= (\res -> return (Document (res)))

src/Test.hs

@@ -3,29 +3,41 @@ module MdToHtmlTest where
 import MdToHTML
 import Test.HUnit
 
-check_equal expected actual
+check_equal :: String -> String -> String -> Test
+check_equal desc expected actual = TestCase (assertEqual desc expected actual)
+
+convert :: String -> String
+convert md = show . fst $ leftmostLongestParse parseDocument md
 
 headerTests = TestList
       [
-         (TestCase (assertEqual "Should convert H1 heading" "<h1>Hello</h1>" (show . fst $ leftmostLongestParse parseLine "# Hello"))),
+         check_equal "Should convert H1 heading" "<h1>Hello</h1>" (convert "# Hello"),
-         (TestCase (assertEqual "Should convert H2 heading" "<h2>Hello</h2>" (show . fst $ leftmostLongestParse parseLine "## Hello"))),
+         check_equal "Should convert H2 heading" "<h2>Hello</h2>" (convert "## Hello"),
-         (TestCase (assertEqual "Should convert H3 heading" "<h3>Hello</h3>" (show . fst $ leftmostLongestParse parseLine "### Hello"))),
+         check_equal "Should convert H3 heading" "<h3>Hello</h3>" (convert "### Hello"),
-         (TestCase (assertEqual "Should convert H4 heading" "<h4>Hello</h4>" (show . fst $ leftmostLongestParse parseLine "#### Hello"))),
+         check_equal "Should convert H4 heading" "<h4>Hello</h4>" (convert "#### Hello"),
-         (TestCase (assertEqual "Should convert H5 heading" "<h5>Hello</h5>" (show . fst $ leftmostLongestParse parseLine "##### Hello"))),
+         check_equal "Should convert H5 heading" "<h5>Hello</h5>" (convert "##### Hello"),
-         (TestCase (assertEqual "Should convert H6 heading" "<h6>Hello</h6>" (show . fst $ leftmostLongestParse parseLine "###### Hello")))
+         check_equal "Should convert H6 heading" "<h6>Hello</h6>" (convert "###### Hello")
       ]
 
 boldTests = TestList
    [
-         (TestCase (assertEqual "Should convert bold" "<b>Hello</b>" (show . fst $ leftmostLongestParse parseLine "__Hello__"))),
+         check_equal "Should convert bold" "<p><b>Hello</b></p>" (convert "__Hello__"),
-         (TestCase (assertEqual "Should convert italic" "<i>Hello</i>" (show . fst $ leftmostLongestParse parseLine "_Hello_"))),
+         check_equal "Should convert italic" "<p><i>Hello</i></p>" (convert "_Hello_"),
-         (TestCase (assertEqual "Should convert bold and italic in a sentence" "It <i>is</i> a <b>wonderful</b> day" (show . fst $ leftmostLongestParse parseLine "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")
    ]
 
+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_")
+        -- Add a test for single-newlines.
+    ]
+
+
 tests = TestList
    [
       headerTests,
-      boldTests
+      boldTests,
+      integrationTests
    ]
 
 runTests = runTestTT tests