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