From 4e9f84c2bb8a7a693b0c066de1ae369d2bcd19a9 Mon Sep 17 00:00:00 2001
From: Aadhavan Srinivasan <aadhavan@twomorecents.org>
Date: Tue, 10 Jun 2025 14:01:52 -0400
Subject: [PATCH] Add function to pretty print; commented out my word wrap and
 use a built-in one instead

---
 app/Main.hs         |  2 +-
 src/MdToHTML.hs     | 28 +++++++++++++++++++++++++---
 src/MdToHtmlTest.hs |  2 +-
 3 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 5ca2c2d..71fc7de 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -24,7 +24,7 @@ main = do
     [] -> getContents
     x : _ -> readFile x
   let res = leftmostLongestParse parseDocument fileContents
-  let toPrint = show res
+  let toPrint = prettyPrint res
   case reverse toPrint of
     '\n' : _ -> putStr toPrint
     _ -> putStrLn toPrint
diff --git a/src/MdToHTML.hs b/src/MdToHTML.hs
index 783cc45..70efa25 100644
--- a/src/MdToHTML.hs
+++ b/src/MdToHTML.hs
@@ -55,7 +55,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 +63,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 (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 (Code code) = "<code>" ++ strip (show code) ++ "</code>"
+  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 +74,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 +147,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.
diff --git a/src/MdToHtmlTest.hs b/src/MdToHtmlTest.hs
index 4e05214..0db35ba 100644
--- a/src/MdToHtmlTest.hs
+++ b/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