Import module for word wrapping; add package to cabal file

built-in one instead

app/Main.hs

@@ -24,4 +24,7 @@ main = do
     [] -> getContents
     x : _ -> readFile x
   let res = leftmostLongestParse parseDocument fileContents
-  print res
+  let toPrint = prettyPrint res
+  case reverse toPrint of
+    '\n' : _ -> putStr toPrint
+    _ -> putStrLn toPrint

md-to-html.cabal

@@ -60,7 +60,10 @@ library
    build-depends:    base ^>=4.19.1.0,
                       HUnit,
                       megaparsec,
-                      text
+                      parser-combinators,
+                      text,
+                      MissingH,
+                      word-wrap
 
 executable md-to-html-runner
     -- Import common warning flags.

src/MdToHTML.hs

@@ -17,6 +17,7 @@ import Debug.Trace
 import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Printf
+import Text.Wrap
 
 type Parser = Parsec Void T.Text
 
@@ -55,7 +56,7 @@ data MdToken
 instance Show MdToken where
   show (Document tokens) = concatMap show tokens
   show (Header level token) = "<h" ++ show level ++ ">" ++ show token ++ "</h" ++ show level ++ ">"
-  show (Para token) = "<p>" ++ show token ++ "</p>\n"
+  show (Para token) = "<p>" ++ show token ++ "</p>"
   show (Line tokens) = concatMap show tokens
   show Linebreak = "<br>"
   show SingleNewline = " "
@@ -63,8 +64,8 @@ instance Show MdToken where
   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) = "<code>" ++ show code ++ "</code>"
+  show (Code code) = "<code>" ++ strip (show code) ++ "</code>"
-  show (Table (thead : tokenGrid)) = "<table>\n<thead>\n<tr>\n" ++ concatMap (\x -> "<th>" ++ rstrip (show x) ++ "</th>\n") thead ++ "</tr>\n</thead>\n" ++ "<tbody>\n" ++ concatMap (\x -> "<tr>\n" ++ concatMap (\y -> "<td>" ++ rstrip (show y) ++ "</td>\n") x ++ "</tr>\n") tokenGrid ++ "</tbody>\n</table>\n"
+  show (Table (thead : tokenGrid)) = "<table><thead><tr>" ++ concatMap (\x -> "<th>" ++ rstrip (show x) ++ "</th>") thead ++ "</tr></thead>" ++ "<tbody>" ++ concatMap (\x -> "<tr>" ++ concatMap (\y -> "<td>" ++ rstrip (show y) ++ "</td>") x ++ "</tr>") tokenGrid ++ "</tbody></table>"
   show (Codeblock code) = "<pre><code>" ++ show code ++ "</code></pre>"
   show (Link txt url) = "<a href=\"" ++ getUrl url ++ "\">" ++ show txt ++ "</a>"
   show (Image txt url cssClasses) = "<img src=\"" ++ getUrl url ++ "\"" ++ " alt=\"" ++ show txt ++ "\"" ++ maybe "" (\classes -> " class=\"" ++ unwords classes ++ "\"") cssClasses ++ "/>"
@@ -74,6 +75,15 @@ instance Show MdToken where
   show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
   show (Unit unit) = printf "%s" unit
 
+-- Pretty print the given token into a string.
+-- This is the same as calling 'show' for most tokens, but is different for paragraphs and tables,
+-- which have newlines inserted into them.
+prettyPrint :: MdToken -> String
+prettyPrint (Para token) = "<p>" ++ T.unpack (wrapText defaultWrapSettings 70 (T.pack $ prettyPrint token)) ++ "</p>\n"
+prettyPrint (Table (thead : tokenGrid)) = "<table>\n<thead>\n<tr>\n" ++ concatMap (\x -> "<th>" ++ rstrip (prettyPrint x) ++ "</th>\n") thead ++ "</tr>\n</thead>\n" ++ "<tbody>\n" ++ concatMap (\x -> "<tr>\n" ++ concatMap (\y -> "<td>" ++ rstrip (prettyPrint y) ++ "</td>\n") x ++ "</tr>\n") tokenGrid ++ "</tbody>\n</table>\n"
+prettyPrint (Document tokens) = concatMap prettyPrint tokens
+prettyPrint token = show token
+
 instance Semigroup MdToken where
   a <> b = Document [a, b]
 
@@ -138,6 +148,19 @@ escapeChar x = [x]
 htmlEscapeChars :: T.Text -> T.Text
 htmlEscapeChars = T.concatMap (T.pack . escapeChar)
 
+-- -- Wraps a list of words after (at most) the given number of characters, trying to prevent word-breaks
+-- wordwrap :: Int -> String -> String
+-- wordwrap wraplength str = if (length str) < wraplength
+--     then str
+--     else
+--         let spaceIndex = lastgtSpaceIndex 0 (takeRev (length str) - wraplength str)
+--
+--     where
+--         takeRev n = (reverse . take n . reverse)
+--         lastSpaceIndex counter str = case str of
+--             [] -> counter
+--             x:xs -> if (isSpace x) counter else lastSpaceIndex counter+1 xs
+
 -- ---------------
 
 -- Parse a markdown header, denoted by 1-6 #'s followed by some text, followed by EOL.

src/MdToHtmlTest.hs

@@ -4,7 +4,7 @@ import MdToHTML
 import Test.HUnit
 
 check_equal :: String -> String -> String -> Test
-check_equal desc expected actual = TestCase (assertEqual desc expected (filter (/= '\n') actual))
+check_equal desc expected actual = TestCase (assertEqual desc expected actual)
 
 convert :: String -> String
 convert md = show $ leftmostLongestParse parseDocument md