diff --git a/app/Main.hs b/app/Main.hs
index f1bb30e..3e8a743 100644
--- a/app/Main.hs
+++ b/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
diff --git a/project-cis552.cabal b/project-cis552.cabal
index cb65573..c4dea66 100644
--- a/project-cis552.cabal
+++ b/project-cis552.cabal
@@ -28,7 +28,6 @@ library
HTMLHUnitTests
HTMLParser
HTMLPrettyPrinter
- Lib
MarkdownParser
MarkdownPrettyPrinter
MDHUnitTests
diff --git a/src/HTMLParser.hs b/src/HTMLParser.hs
index f418d48..f4811d5 100644
--- a/src/HTMLParser.hs
+++ b/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"
- ]
\ No newline at end of file
+wsP p = p <* many (satisfy isSpace)
\ No newline at end of file
diff --git a/src/HTMLPrettyPrinter.hs b/src/HTMLPrettyPrinter.hs
index 1f27e78..bcc5d54 100644
--- a/src/HTMLPrettyPrinter.hs
+++ b/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 "
"
pp S.Br = PP.text "
"
diff --git a/src/MarkdownParser.hs b/src/MarkdownParser.hs
index 0fbb616..6409582 100644
--- a/src/MarkdownParser.hs
+++ b/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
diff --git a/src/QCTests.hs b/src/QCTests.hs
index a89ef49..82dd557 100644
--- a/src/QCTests.hs
+++ b/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 =
diff --git a/src/Syntax.hs b/src/Syntax.hs
index 297ff37..24bef56 100644
--- a/src/Syntax.hs
+++ b/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"
+ ]
\ No newline at end of file