Updated show definitions for some tokens; add HTML syntax

added by the LSP

md-to-html.cabal

@@ -56,6 +56,7 @@ common warnings
 library
    hs-source-dirs:   src
    exposed-modules: MdToHTML
+   other-modules: MdToHtmlTest
    build-depends:    base ^>=4.19.1.0,
                       HUnit
 
@@ -67,7 +68,9 @@ executable md-to-html-runner
     main-is:          Main.hs
 
     -- Modules included in this executable, other than Main.
-    -- other-modules:
+    other-modules:
+        MdToHTML
+        MdToHtmlTest
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:

src/MdToHTML.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE InstanceSigs #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use lambda-case" #-}
 
 module MdToHTML where
 
@@ -40,7 +42,6 @@ data MdToken
 
 -- Deriving Show for MdToken
 instance Show MdToken where
-  show :: MdToken -> String
   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>"
@@ -48,9 +49,9 @@ instance Show MdToken where
   show Linebreak = "<br>"
   show SingleNewline = " "
   show HorizontalRule = "---------"
-  show (Blockquote token) = "<blockquote>" ++ show token ++ "</blockquote>"
+  show (Blockquote tokens) = "<blockquote>" ++ concatMap show tokens ++ "</blockquote>"
-  show (UnordList tokens) = "UNORD" ++ concatMap show tokens
+  show (UnordList tokens) = "<ul>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ul>"
-  show (OrdList tokens) = "ORD" ++ concatMap show tokens
+  show (OrdList tokens) = "<ol>" ++ concatMap (prepend "<li>" . append "</li>" . show) tokens ++ "</ol>"
   show (Code code) = show code
   show (Codeblock code) = show code
   show (Link txt url) = "<a href=\"" ++ getUrl url ++ "\">" ++ show txt ++ "</a>"
@@ -60,17 +61,29 @@ instance Show MdToken where
   show (Strikethrough token) = "<s>" ++ show token ++ "</s>"
   show (Unit unit) = printf "%s" unit
 
+instance Semigroup MdToken where
+  a <> b = Document [a, b]
+
+instance Monoid MdToken where
+  mempty = Unit ""
+
 -- ---------------
 -- Helpers
-leftmostLongest :: (Foldable t) => [(a, t b)] -> (a, t b)
+leftmostLongest :: (Foldable t) => [(a, t b)] -> Maybe (a, t b)
 leftmostLongest xs =
   let lastElem = last xs
       filteredLst = filter (\val -> length (snd val) == length (snd lastElem)) xs
-   in head filteredLst
+   in case filteredLst of
+        [] -> Nothing
+        (x : xs) -> Just x
 
 -- Get the first parse returned by readP_to_S that consumed the most input
-leftmostLongestParse :: ReadP a -> String -> (a, String)
+leftmostLongestParse :: (Monoid a) => ReadP a -> String -> (a, String)
-leftmostLongestParse parser input = leftmostLongest $ readP_to_S parser input
+leftmostLongestParse parser input =
+  let res = leftmostLongest $ readP_to_S parser input
+   in case res of
+        Nothing -> (mempty, mempty)
+        Just x -> x
 
 -- Parse if the string that's left matches the string comparator function
 lookaheadParse :: (String -> Bool) -> ReadP Char
@@ -196,6 +209,24 @@ parsePara = do
   let parsedText = fst $ leftmostLongestParse parseLine text -- Parse a line
   return (Para parsedText)
 
+-- Parse a line starting with '>', return the line except for the '>'.
+parseQuotedLine :: ReadP String
+parseQuotedLine = do
+  char '>'
+  greedyParse (char ' ' +++ char '\t')
+  restOfLine <- munch (/= '\n')
+  Text.ParserCombinators.ReadP.optional (char '\n') >> return ""
+  return restOfLine
+
+-- Parse many 'quoted lines' until I see a non-quoted line.
+parseQuotedLines :: ReadP [String]
+parseQuotedLines =
+  greedyParse1 $ do
+    look >>= \line ->
+      case line of
+        ('>' : _) -> parseQuotedLine
+        _ -> pfail
+
 -- Parse a blockquote, which is a greater-than sign followed by a paragraph.
 parseBlockquote :: ReadP MdToken
 parseBlockquote = do

src/MdToHtmlTest.hs

@@ -56,6 +56,11 @@ blockquoteTests =
         )
     ]
 
+orderedListTests =
+  TestList
+    [ check_equal "Basic ordered list" "<ol><li>Item 1</li><li>Item 2</li><li>Item 3</li></ol" (convert "1. Item 1\n2. Item2\n3. Item3")
+    ]
+
 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_"),
@@ -73,6 +78,7 @@ tests =
       linkTests,
       escapedCharTests,
       blockquoteTests,
+      orderedListTests,
       integrationTests
     ]