Clean

app/Main.hs

@@ -1,7 +1,7 @@
 module Main where
 
 import HTMLPrettyPrinter (htmlPretty)
-import Lib
+-- import Lib
 import MarkdownParser
 import qualified System.IO as IO
 import qualified System.IO.Error as IO

project-cis552.cabal

@@ -28,7 +28,6 @@ library
       HTMLHUnitTests
       HTMLParser
       HTMLPrettyPrinter
-      Lib
       MarkdownParser
       MarkdownPrettyPrinter
       MDHUnitTests

src/HTMLParser.hs

@@ -3,17 +3,11 @@ module HTMLParser where
 import qualified Control.Monad as Monad
 import Data.Char (isSpace)
 import Data.Functor (($>))
-import Syntax (Block (..), Doc (Doc), Line, TableBody (..), TableCell (..), TableHead (..), TableRow (..), Text (..))
+import Syntax (Block (..), Doc (Doc), Line, TableBody (..), TableCell (..), TableHead (..), TableRow (..), Text (..), htmlTags)
 import qualified Syntax as S
 import Text.Parsec.Token
 import Text.ParserCombinators.Parsec
 
--- for testing (again LOL)
-p3 :: Parser a -> String -> Either String a
-p3 parser str = case parse parser "" str of
-  Left err -> Left "No parses"
-  Right x -> Right x
-
 {- HTML parsers -}
 
 parseHtml :: String -> Either ParseError Doc
@@ -218,39 +212,4 @@ many1Till p end = do
 
 -- | Removes trailing whitespace
 wsP :: Parser a -> Parser a
-wsP p = p <* many (satisfy isSpace)
-
--- TODO: move to Syntax.hs?
--- | Reserved HTML tags
-htmlTags :: [String]
-htmlTags =
-  [ "html",
-    "blockquote",
-    "code",
-    "pre",
-    "img",
-    "h1",
-    "h2",
-    "h3",
-    "h4",
-    "h5",
-    "h6",
-    "hr",
-    "br",
-    "ol",
-    "ul",
-    "li",
-    "p",
-    "i",
-    "b",
-    "a",
-    "del",
-    "table",
-    "tbody",
-    "thead",
-    "tfoot",
-    "tbody",
-    "td",
-    "th",
-    "tr"
-  ]
+wsP p = p <* many (satisfy isSpace)

src/HTMLPrettyPrinter.hs

@@ -22,7 +22,6 @@ instance PP S.Block where
   pp (S.UnorderedList ls) = tag "ul" (PP.hcat $ map (tag "li" . pp) ls)
   pp (S.Image alt src) = tagWithAttrs "img" [("alt", alt), ("src", src)] mempty
   pp (S.BlockQuote ls) = tag "blockquote" (PP.hcat $ map (tag "p" . pp) ls)
-  -- TODO: refactor?
   pp (S.CodeBlock str) = tag "pre" $ tag "code" (PP.text str)
   pp S.Hr = PP.text "<hr>"
   pp S.Br = PP.text "<br>"

src/MarkdownParser.hs

@@ -3,21 +3,15 @@ module MarkdownParser where
 import qualified Control.Monad as Monad
 import Data.Char (isSpace)
 import Data.Functor (($>))
-import Syntax (Block (..), Doc (Doc), Line, TableBody, TableCell, TableHead, TableRow, Text (..))
+import Syntax (Block (..), Doc (Doc), Line, TableBody, TableCell, TableHead, TableRow, Text (..), reservedMarkdownChars)
 import qualified Syntax as S
 import Text.Parsec.Token
 import Text.ParserCombinators.Parsec as Parsec
 
--- TODO: delete this. for testing......
-p2 :: Parser a -> String -> Either String a
-p2 parser str = case parse parser "" str of
-  Left err -> Left "No parses"
-  Right x -> Right x
 
 {- Markdown parsers -}
 
 -- | Parses the complete file or text into a Doc type.
--- TODO: add error filepath arg to parse
 parseMarkdown :: String -> Either ParseError Doc
 parseMarkdown = parse markdownP ""
 
@@ -51,7 +45,6 @@ headingP = do
   Monad.guard (length hx < 7)
   Heading (length hx) <$> lineP
 
--- TODO: figure out how to implement sublists?
 -- | Parses for an unordered list (- list item)
 ulListP :: Parser Block
 ulListP =
@@ -200,10 +193,9 @@ bracketsP p = string "[" *> p <* optional (string "]")
 parensP :: Parser a -> Parser a
 parensP p = string "(" *> p <* string ")"
 
--- TODO: add this to syntax?
 -- | Parses for a string until a reserved character is found
 stringP :: Parser String
-stringP = many1 $ noneOf ['*', '~', '`', '>', '_', '[', ']', '|', '\n']
+stringP = many1 $ noneOf reservedMarkdownChars
 
 -- | Removes trailing whitespace
 wsP :: Parser a -> Parser a

src/QCTests.hs

@@ -14,6 +14,11 @@ import qualified Test.QuickCheck as QC
 import Text.Parsec.Token
 import Text.ParserCombinators.Parsec as Parsec
 
+noConsecutiveNormal :: [Text] -> Bool
+noConsecutiveNormal [] = True
+noConsecutiveNormal (Normal _ : Normal _ : _) = False
+noConsecutiveNormal (_ : rest) = noConsecutiveNormal rest
+
 instance Arbitrary Text where
   arbitrary =
     oneof
@@ -30,10 +35,11 @@ instance Arbitrary Text where
         QC.listOf1 arbitrary `QC.suchThat` noInnerLink
 
       noInnerLink :: [Text] -> Bool
-      noInnerLink [] = True
-      noInnerLink (Link _ _ : _) = False
-      noInnerLink (Normal _ : Normal _ : _) = False
-      noInnerLink (_ : xs) = noInnerLink xs
+      noInnerLink l = foldr (\x acc -> not (isLink x) && acc) True l && noConsecutiveNormal l
+
+      isLink :: Text -> Bool
+      isLink (Link _ _) = True
+      isLink _ = False
 
       genSafeString :: Gen String
       genSafeString =

src/Syntax.hs

@@ -51,3 +51,42 @@ data Text
   | Link [Text] String -- text, url
   | Normal String
   deriving (Eq, Show)
+
+
+-- | Reserved Markdown characters
+reservedMarkdownChars :: [Char]
+reservedMarkdownChars = ['*', '~', '`', '>', '_', '[', ']', '|', '\n']
+
+-- | Reserved HTML tags
+htmlTags :: [String]
+htmlTags =
+  [ "html",
+    "blockquote",
+    "code",
+    "pre",
+    "img",
+    "h1",
+    "h2",
+    "h3",
+    "h4",
+    "h5",
+    "h6",
+    "hr",
+    "br",
+    "ol",
+    "ul",
+    "li",
+    "p",
+    "i",
+    "b",
+    "a",
+    "del",
+    "table",
+    "tbody",
+    "thead",
+    "tfoot",
+    "tbody",
+    "td",
+    "th",
+    "tr"
+  ]