markdown 0.1.1.2 → 0.1.2
raw patch · 13 files changed
+327/−124 lines, 13 filesdep ~xss-sanitizePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: xss-sanitize
API changes (from Hackage documentation)
- Text.Markdown: instance Default MarkdownSettings
+ Text.Markdown: FHParsed :: ([Block Text] -> [Block Text]) -> FencedHandler
+ Text.Markdown: FHRaw :: (Text -> [Block Text]) -> FencedHandler
+ Text.Markdown: codeFencedHandler :: Text -> Map Text (Text -> FencedHandler)
+ Text.Markdown: data FencedHandler
+ Text.Markdown: htmlFencedHandler :: Text -> (Text -> Text) -> (Text -> Text) -> Map Text (Text -> FencedHandler)
+ Text.Markdown: msFencedHandlers :: MarkdownSettings -> Map Text (Text -> FencedHandler)
+ Text.Markdown: msStandaloneHtml :: MarkdownSettings -> Set Text
Files
- Text/Markdown.hs +16/−17
- Text/Markdown/Block.hs +144/−100
- Text/Markdown/Types.hs +119/−0
- markdown.cabal +4/−2
- test/Block.hs +3/−2
- test/examples/fence-whitespace.html +1/−0
- test/examples/fence-whitespace.md +4/−0
- test/examples/lazy.html +3/−0
- test/examples/lazy.md +6/−0
- test/examples/list-blocks.md +3/−2
- test/examples/sublists.html +1/−0
- test/examples/sublists.md +4/−0
- test/main.hs +19/−1
Text/Markdown.hs view
@@ -7,14 +7,21 @@ -- * Settings , MarkdownSettings , msXssProtect+ , msStandaloneHtml+ , msFencedHandlers -- * Newtype , Markdown (..)+ -- * Fenced handlers+ , FencedHandler (..)+ , codeFencedHandler+ , htmlFencedHandler -- * Convenience re-exports , def ) where import Text.Markdown.Inline import Text.Markdown.Block+import Text.Markdown.Types import Prelude hiding (sequence, takeWhile) import Data.Default (Default (..)) import Data.Text (Text)@@ -31,20 +38,6 @@ import qualified Data.Map as Map import Data.String (IsString) --- | A settings type providing various configuration options.------ See <http://www.yesodweb.com/book/settings-types> for more information on--- settings types. In general, you can use @def@.-data MarkdownSettings = MarkdownSettings- { msXssProtect :: Bool- -- ^ Whether to automatically apply XSS protection to embedded HTML. Default: @True@.- }--instance Default MarkdownSettings where- def = MarkdownSettings- { msXssProtect = True- }- -- | A newtype wrapper providing a @ToHtml@ instance. newtype Markdown = Markdown TL.Text deriving(Monoid, IsString)@@ -62,11 +55,16 @@ -- >>> renderHtml $ markdown def { msXssProtect = False } "<script>alert('evil')</script>" -- "<script>alert('evil')</script>" markdown :: MarkdownSettings -> TL.Text -> Html-markdown ms tl = runIdentity+markdown ms tl =+ sanitize+ $ runIdentity $ CL.sourceList blocksH $= toHtmlB ms $$ CL.fold mappend mempty where+ sanitize+ | msXssProtect ms = preEscapedToMarkup . sanitizeBalance . TL.toStrict . renderHtml+ | otherwise = id fixBlock :: Block Text -> Block Html fixBlock = fmap $ toHtmlI ms . toInline refs @@ -76,7 +74,7 @@ blocks :: [Block Text] blocks = runIdentity $ CL.sourceList (TL.toChunks tl)- $$ toBlocks+ $$ toBlocks ms =$ CL.consume refs =@@ -115,9 +113,10 @@ getState state@(InList _) _ = closeState state >> return NoState go (BlockPara h) = H.p h+ go (BlockPlainText h) = h go (BlockList _ (Left h)) = H.li h go (BlockList _ (Right bs)) = H.li $ blocksToHtml bs- go (BlockHtml t) = escape $ (if msXssProtect ms then sanitizeBalance else id) t+ go (BlockHtml t) = escape t go (BlockCode Nothing t) = H.pre $ H.code $ toMarkup t go (BlockCode (Just lang) t) = H.pre $ H.code H.! HA.class_ (H.toValue lang) $ toMarkup t go (BlockQuote bs) = H.blockquote $ blocksToHtml bs
Text/Markdown/Block.hs view
@@ -17,35 +17,13 @@ import qualified Data.Text as T import Data.Functor.Identity (runIdentity) import Data.Char (isDigit)--data ListType = Ordered | Unordered- deriving (Show, Eq)--data Block inline- = BlockPara inline- | BlockList ListType (Either inline [Block inline])- | BlockCode (Maybe Text) Text- | BlockQuote [Block inline]- | BlockHtml Text- | BlockRule- | BlockHeading Int inline- | BlockReference Text Text- deriving (Show, Eq)--instance Functor Block where- fmap f (BlockPara i) = BlockPara (f i)- fmap f (BlockList lt (Left i)) = BlockList lt $ Left $ f i- fmap f (BlockList lt (Right bs)) = BlockList lt $ Right $ map (fmap f) bs- fmap _ (BlockCode a b) = BlockCode a b- fmap f (BlockQuote bs) = BlockQuote $ map (fmap f) bs- fmap _ (BlockHtml t) = BlockHtml t- fmap _ BlockRule = BlockRule- fmap f (BlockHeading level i) = BlockHeading level (f i)- fmap _ (BlockReference x y) = BlockReference x y+import Text.Markdown.Types+import qualified Data.Set as Set+import qualified Data.Map as Map -toBlocks :: Monad m => Conduit Text m (Block Text)-toBlocks =- mapOutput fixWS CT.lines =$= toBlocksLines+toBlocks :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)+toBlocks ms =+ mapOutput fixWS CT.lines =$= toBlocksLines ms where fixWS = T.pack . go 0 . T.unpack @@ -57,8 +35,8 @@ j = 4 - (i `mod` 4) go i (c:cs) = c : go (i + 1) cs -toBlocksLines :: Monad m => Conduit Text m (Block Text)-toBlocksLines = awaitForever start =$= tightenLists+toBlocksLines :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)+toBlocksLines ms = awaitForever (start ms) =$= tightenLists tightenLists :: Monad m => GLInfConduit (Either Blank (Block Text)) m (Block Text) tightenLists =@@ -97,62 +75,160 @@ data Blank = Blank -start :: Monad m => Text -> GLConduit Text m (Either Blank (Block Text))-start t- | T.null $ T.strip t = yield $ Left Blank- | Just lang <- T.stripPrefix "~~~" t = do- (finished, ls) <- takeTill (== "~~~") >+> withUpstream CL.consume- case finished of- Just _ -> yield $ Right $ BlockCode (if T.null lang then Nothing else Just lang) $ T.intercalate "\n" ls- Nothing -> mapM_ leftover (reverse $ T.cons ' ' t : ls)- | Just lang <- T.stripPrefix "```" t = do- (finished, ls) <- takeTill (== "```") >+> withUpstream CL.consume+data LineType = LineList ListType Text+ | LineCode Text+ | LineFenced Text FencedHandler -- ^ terminator, language+ | LineBlockQuote Text+ | LineHeading Int Text+ | LineBlank+ | LineText Text+ | LineRule+ | LineHtml Text+ | LineReference Text Text -- ^ name, destination++lineType :: MarkdownSettings -> Text -> LineType+lineType ms t+ | T.null $ T.strip t = LineBlank+ | Just (term, fh) <- getFenced (Map.toList $ msFencedHandlers ms) t = LineFenced term fh+ | Just t' <- T.stripPrefix "> " t = LineBlockQuote t'+ | Just (level, t') <- stripHeading t = LineHeading level t'+ | Just t' <- T.stripPrefix " " t = LineCode t'+ | isRule t = LineRule+ | isHtmlStart t = LineHtml t+ | Just (ltype, t') <- listStart t = LineList ltype t'+ | Just (name, dest) <- getReference t = LineReference name dest+ | otherwise = LineText t+ where+ getFenced [] _ = Nothing+ getFenced ((x, fh):xs) t'+ | Just rest <- T.stripPrefix x t' = Just (x, fh $ T.strip rest)+ | otherwise = getFenced xs t'++ isRule :: Text -> Bool+ isRule =+ go . T.strip+ where+ go "* * *" = True+ go "***" = True+ go "*****" = True+ go "- - -" = True+ go "---" = True+ go "___" = True+ go "_ _ _" = True+ go t' = T.length (T.takeWhile (== '-') t') >= 5++ stripHeading :: Text -> Maybe (Int, Text)+ stripHeading t'+ | T.null x = Nothing+ | otherwise = Just (T.length x, T.strip $ T.dropWhileEnd (== '#') y)+ where+ (x, y) = T.span (== '#') t'++ getReference :: Text -> Maybe (Text, Text)+ getReference a = do+ b <- T.stripPrefix "[" $ T.dropWhile (== ' ') a+ let (name, c) = T.break (== ']') b+ d <- T.stripPrefix "]:" c+ Just (name, T.strip d)++start :: Monad m => MarkdownSettings -> Text -> GLConduit Text m (Either Blank (Block Text))+start ms t =+ go $ lineType ms t+ where+ go LineBlank = yield $ Left Blank+ go (LineFenced term fh) = do+ (finished, ls) <- takeTill (== term) >+> withUpstream CL.consume case finished of- Just _ -> yield $ Right $ BlockCode (if T.null lang then Nothing else Just lang) $ T.intercalate "\n" ls+ Just _ -> do+ let block =+ case fh of+ FHRaw fh' -> fh' $ T.intercalate "\n" ls+ FHParsed fh' -> fh' $ runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume+ mapM_ (yield . Right) block Nothing -> mapM_ leftover (reverse $ T.cons ' ' t : ls)- | Just t' <- T.stripPrefix "> " t = do+ go (LineBlockQuote t') = do ls <- takeQuotes >+> CL.consume- let blocks = runIdentity $ mapM_ yield (t' : ls) $$ toBlocksLines =$ CL.consume+ let blocks = runIdentity $ mapM_ yield (t' : ls) $$ toBlocksLines ms =$ CL.consume yield $ Right $ BlockQuote blocks- | Just (level, t') <- stripHeading t = yield $ Right $ BlockHeading level t'- | Just t' <- T.stripPrefix " " t = do+ go (LineHeading level t') = yield $ Right $ BlockHeading level t'+ go (LineCode t') = do ls <- getIndented 4 >+> CL.consume yield $ Right $ BlockCode Nothing $ T.intercalate "\n" $ t' : ls- | isRule t = yield $ Right BlockRule- | isHtmlStart t = do- ls <- takeTill (T.null . T.strip) >+> CL.consume- yield $ Right $ BlockHtml $ T.intercalate "\n" $ t : ls- | Just (ltype, t') <- listStart t = do- let t'' = T.dropWhile (== ' ') t'- let leader = T.length t - T.length t''- ls <- getIndented leader >+> CL.consume- let blocks = runIdentity $ mapM_ yield (t'' : ls) $$ toBlocksLines =$ CL.consume- yield $ Right $ BlockList ltype $ Right blocks-- | Just (x, y) <- getReference t = yield $ Right $ BlockReference x y-- | otherwise = do+ go LineRule = yield $ Right BlockRule+ go (LineHtml t') = do+ if t' `Set.member` msStandaloneHtml ms+ then yield $ Right $ BlockHtml t'+ else do+ ls <- takeTill (T.null . T.strip) >+> CL.consume+ yield $ Right $ BlockHtml $ T.intercalate "\n" $ t' : ls+ go (LineList ltype t') = do+ t2 <- CL.peek+ case fmap (lineType ms) t2 of+ -- If the next line is a non-indented text line, then we have a+ -- lazy list.+ Just (LineText t2') | T.null (T.takeWhile (== ' ') t2') -> do+ CL.drop 1+ -- Get all of the non-indented lines.+ let loop front = do+ x <- await+ case x of+ Nothing -> return $ front []+ Just y ->+ case lineType ms y of+ LineText z -> loop (front . (z:))+ _ -> leftover y >> return (front [])+ ls <- loop (\rest -> T.dropWhile (== ' ') t' : t2' : rest)+ yield $ Right $ BlockList ltype $ Right [BlockPara $ T.intercalate "\n" ls]+ -- If the next line is an indented list, then we have a sublist. I+ -- disagree with this interpretation of Markdown, but it's the way+ -- that Github implements things, so we will too.+ _ | Just t2' <- t2+ , Just t2'' <- T.stripPrefix " " t2'+ , LineList _ltype' _t2''' <- lineType ms t2'' -> do+ ls <- getIndented 4 >+> CL.consume+ let blocks = runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume+ let addPlainText+ | T.null $ T.strip t' = id+ | otherwise = (BlockPlainText (T.strip t'):)+ yield $ Right $ BlockList ltype $ Right $ addPlainText blocks+ _ -> do+ let t'' = T.dropWhile (== ' ') t'+ let leader = T.length t - T.length t''+ ls <- getIndented leader >+> CL.consume+ let blocks = runIdentity $ mapM_ yield (t'' : ls) $$ toBlocksLines ms =$ CL.consume+ yield $ Right $ BlockList ltype $ Right blocks+ go (LineReference x y) = yield $ Right $ BlockReference x y+ go (LineText t') = do -- Check for underline headings+ let getUnderline :: Text -> Maybe Int+ getUnderline s+ | T.length s < 2 = Nothing+ | T.all (== '=') s = Just 1+ | T.all (== '-') s = Just 2+ | otherwise = Nothing t2 <- CL.peek case t2 >>= getUnderline of+ Just level -> do+ CL.drop 1+ yield $ Right $ BlockHeading level t' Nothing -> do let listStartIndent x = case listStart x of Just (_, y) -> T.take 2 y == " " Nothing -> False- (mfinal, ls) <- takeTill (\x -> T.null (T.strip x) || listStartIndent x) >+> withUpstream CL.consume+ isNonPara LineBlank = True+ isNonPara LineFenced{} = True+ isNonPara _ = False+ (mfinal, ls) <- takeTill (\x -> isNonPara (lineType ms x) || listStartIndent x) >+> withUpstream CL.consume maybe (return ()) leftover mfinal- yield $ Right $ BlockPara $ T.intercalate "\n" $ t : ls- Just level -> do- CL.drop 1- yield $ Right $ BlockHeading level t+ yield $ Right $ BlockPara $ T.intercalate "\n" $ t' : ls isHtmlStart :: T.Text -> Bool isHtmlStart t = case T.stripPrefix "<" t of Nothing -> False Just t' ->- let (name, rest) = T.break (\c -> c `elem` " >/") t'+ let (name, rest) = T.break (\c -> c `elem` " >") t' in T.all isValidTagName name && not (T.null name) && (not ("/" `T.isPrefixOf` rest) || ("/>" `T.isPrefixOf` rest))@@ -164,6 +240,7 @@ ('0' <= c && c <= '9') || (c == '-') || (c == '_') ||+ (c == '/') || (c == '!') takeTill :: Monad m => (i -> Bool) -> Pipe l i i u m (Maybe i)@@ -217,41 +294,8 @@ takeQuotes = await >>= maybe (return ()) go where+ go "" = return () go ">" = yield "" >> takeQuotes go t | Just t' <- T.stripPrefix "> " t = yield t' >> takeQuotes- | otherwise = leftover t--isRule :: Text -> Bool-isRule =- go . T.strip- where- go "* * *" = True- go "***" = True- go "*****" = True- go "- - -" = True- go "---" = True- go "___" = True- go "_ _ _" = True- go t = T.length (T.takeWhile (== '-') t) >= 5--stripHeading :: Text -> Maybe (Int, Text)-stripHeading t- | T.null x = Nothing- | otherwise = Just (T.length x, T.strip $ T.dropWhileEnd (== '#') y)- where- (x, y) = T.span (== '#') t--getUnderline :: Text -> Maybe Int-getUnderline t- | T.length t < 2 = Nothing- | T.all (== '=') t = Just 1- | T.all (== '-') t = Just 2- | otherwise = Nothing--getReference :: Text -> Maybe (Text, Text)-getReference a = do- b <- T.stripPrefix "[" $ T.dropWhile (== ' ') a- let (name, c) = T.break (== ']') b- d <- T.stripPrefix "]:" c- Just (name, T.strip d)+ | otherwise = yield t >> takeQuotes
+ Text/Markdown/Types.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE OverloadedStrings #-}+module Text.Markdown.Types where++import Data.Text (Text)+import qualified Data.Text as T+import Data.Default (Default (def))+import Data.Set (Set, empty)+import Data.Map (Map, singleton)+import Data.Monoid (mappend)++-- | A settings type providing various configuration options.+--+-- See <http://www.yesodweb.com/book/settings-types> for more information on+-- settings types. In general, you can use @def@.+data MarkdownSettings = MarkdownSettings+ { msXssProtect :: Bool+ -- ^ Whether to automatically apply XSS protection to embedded HTML. Default: @True@.+ , msStandaloneHtml :: Set Text+ -- ^ HTML snippets which stand on their own. We do not require a blank line following these pieces of HTML.+ --+ -- Default: empty set.+ --+ -- Since: 0.1.2+ , msFencedHandlers :: Map Text (Text -> FencedHandler)+ -- ^ Handlers for the special \"fenced\" format. This is most commonly+ -- used for fenced code, e.g.:+ --+ -- > ```haskell+ -- > main = putStrLn "Hello"+ -- > ```+ --+ -- This is an extension of Markdown, but a fairly commonly used one.+ --+ -- This setting allows you to create new kinds of fencing. Fencing goes+ -- into two categories: parsed and raw. Code fencing would be in the raw+ -- category, where the contents are not treated as Markdown. Parsed will+ -- treat the contents as Markdown and allow you to perform some kind of+ -- modifcation to it.+ --+ -- For example, to create a new @\@\@\@@ fencing which wraps up the+ -- contents in an @article@ tag, you could use:+ --+ -- > def { msFencedHandlers = htmlFencedHandler "@@@" (const "<article>") (const "</article")+ -- > `Map.union` msFencedHandlers def+ -- > }+ --+ -- Default: code fencing for @```@ and @~~~@.+ --+ -- Since: 0.1.2+ }++-- | See 'msFencedHandlers.+--+-- Since 0.1.2+data FencedHandler = FHRaw (Text -> [Block Text])+ -- ^ Wrap up the given raw content.+ | FHParsed ([Block Text] -> [Block Text])+ -- ^ Wrap up the given parsed content.++instance Default MarkdownSettings where+ def = MarkdownSettings+ { msXssProtect = True+ , msStandaloneHtml = empty+ , msFencedHandlers = codeFencedHandler "```" `mappend` codeFencedHandler "~~~"+ }++-- | Helper for creating a 'FHRaw'.+--+-- Since 0.1.2+codeFencedHandler :: Text -- ^ Delimiter+ -> Map Text (Text -> FencedHandler)+codeFencedHandler key = singleton key $ \lang -> FHRaw $+ return . BlockCode (if T.null lang then Nothing else Just lang)++-- | Helper for creating a 'FHParsed'.+--+-- Note that the start and end parameters take a @Text@ parameter; this is the+-- text following the delimiter. For example, with the markdown:+--+-- > @@@ foo+--+-- @foo@ would be passed to start and end.+--+-- Since 0.1.2+htmlFencedHandler :: Text -- ^ Delimiter+ -> (Text -> Text) -- ^ start HTML+ -> (Text -> Text) -- ^ end HTML+ -> Map Text (Text -> FencedHandler)+htmlFencedHandler key start end = singleton key $ \lang -> FHParsed $ \blocks ->+ BlockHtml (start lang)+ : blocks+ ++ [BlockHtml $ end lang]++data ListType = Ordered | Unordered+ deriving (Show, Eq)++data Block inline+ = BlockPara inline+ | BlockList ListType (Either inline [Block inline])+ | BlockCode (Maybe Text) Text+ | BlockQuote [Block inline]+ | BlockHtml Text+ | BlockRule+ | BlockHeading Int inline+ | BlockReference Text Text+ | BlockPlainText inline+ deriving (Show, Eq)++instance Functor Block where+ fmap f (BlockPara i) = BlockPara (f i)+ fmap f (BlockList lt (Left i)) = BlockList lt $ Left $ f i+ fmap f (BlockList lt (Right bs)) = BlockList lt $ Right $ map (fmap f) bs+ fmap _ (BlockCode a b) = BlockCode a b+ fmap f (BlockQuote bs) = BlockQuote $ map (fmap f) bs+ fmap _ (BlockHtml t) = BlockHtml t+ fmap _ BlockRule = BlockRule+ fmap f (BlockHeading level i) = BlockHeading level (f i)+ fmap _ (BlockReference x y) = BlockReference x y+ fmap f (BlockPlainText x) = BlockPlainText (f x)
markdown.cabal view
@@ -1,5 +1,5 @@ Name: markdown-Version: 0.1.1.2+Version: 0.1.2 Synopsis: Convert Markdown to HTML, with XSS protection Description: This library leverages existing high-performance libraries (attoparsec, blaze-html, text, and conduit), and should integrate well with existing codebases. Homepage: https://github.com/snoyberg/markdown@@ -19,6 +19,7 @@ Exposed-modules: Text.Markdown Text.Markdown.Block Text.Markdown.Inline+ other-modules: Text.Markdown.Types Build-depends: base >= 4 && < 5 , blaze-html >= 0.4 , attoparsec >= 0.10@@ -27,7 +28,7 @@ , conduit >= 0.5.2.1 && < 0.6 , text , data-default >= 0.3- , xss-sanitize+ , xss-sanitize >= 0.3.3 , containers ghc-options: -Wall @@ -48,6 +49,7 @@ , system-filepath , transformers , conduit+ , containers source-repository head type: git
test/Block.hs view
@@ -6,11 +6,12 @@ import Data.Text (Text) import Data.Conduit import qualified Data.Conduit.List as CL+import Text.Markdown (def) import Text.Markdown.Block import Data.Functor.Identity (runIdentity) check :: Text -> [Block Text] -> Expectation-check md blocks = runIdentity (yield md $$ toBlocks =$ CL.consume) `shouldBe` blocks+check md blocks = runIdentity (yield md $$ toBlocks def =$ CL.consume) `shouldBe` blocks blockSpecs :: Spec blockSpecs = do@@ -31,7 +32,7 @@ , BlockList Unordered (Right [BlockPara "bar"]) ] it "nested" $ check- "* foo\n* 1. bar\n 2. baz"+ "* foo\n* \n 1. bar\n 2. baz" [ BlockList Unordered (Left "foo") , BlockList Unordered (Right [ BlockList Ordered $ Left "bar"
+ test/examples/fence-whitespace.html view
@@ -0,0 +1,1 @@+<p>foo</p><pre><code>bar</code></pre>
+ test/examples/fence-whitespace.md view
@@ -0,0 +1,4 @@+foo+```+bar+```
+ test/examples/lazy.html view
@@ -0,0 +1,3 @@+<blockquote><p>this is+lazy</p></blockquote><ol><li>This is+a list</li><li>Another item</li></ol>
+ test/examples/lazy.md view
@@ -0,0 +1,6 @@+> this is+lazy++1. This is+a list+2. Another item
test/examples/list-blocks.md view
@@ -7,5 +7,6 @@ * Item. * Sublist item.- * 1. Item 1- 2. Item 2+ * + 1. Item 1+ 2. Item 2
+ test/examples/sublists.html view
@@ -0,0 +1,1 @@+<ol><li>No encounters</li><li>Encounters<ol><li>First kind</li><li>Second kind</li></ol></li></ol>
+ test/examples/sublists.md view
@@ -0,0 +1,4 @@+1. No encounters+2. Encounters+ 1. First kind+ 2. Second kind
test/main.hs view
@@ -6,6 +6,8 @@ import qualified Data.Text.Lazy as TL import Text.Blaze.Html.Renderer.Text (renderHtml) import Control.Monad (forM_)+import qualified Data.Set as Set+import qualified Data.Map as Map import qualified Filesystem.Path.CurrentOS as F import qualified Filesystem as F@@ -16,6 +18,9 @@ check :: Text -> Text -> Expectation check html md = renderHtml (markdown def md) `shouldBe` html +checkSet :: MarkdownSettings -> Text -> Text -> Expectation+checkSet set html md = renderHtml (markdown set md) `shouldBe` html+ check' :: Text -> Text -> Expectation check' html md = renderHtml (markdown def { msXssProtect = False } md) `shouldBe` html @@ -85,7 +90,7 @@ let close2 = "<div>foo\nbar\nbaz\n\nparagraph" it "autoclose 2"- $ check "<div>foo\nbar\nbaz</div><p>paragraph</p>" close2+ $ check "<div>foo\nbar\nbaz<p>paragraph</p></div>" close2 describe "inline code" $ do it "simple" $ check "<p>foo <code>bar</code> baz</p>" "foo `bar` baz"@@ -184,6 +189,19 @@ it "block" $ check "<div>hello world</div>" "<div>hello world</div>" it "block xss" $ check "alert('evil')" "<script>alert('evil')</script>" it "should be escaped" $ check "<p>1 < 2</p>" "1 < 2"+ it "standalone" $ checkSet+ def { msStandaloneHtml = Set.fromList ["<hidden>", "</hidden>"], msXssProtect = False }+ "<hidden><pre><code class=\"haskell\">foo\nbar</code></pre></hidden>"+ "<hidden>\n```haskell\nfoo\nbar\n```\n</hidden>\n"+ describe "fencing" $ do+ it "custom fencing" $ checkSet+ def+ { msFencedHandlers = Map.union+ (htmlFencedHandler "@@@" (\clazz -> T.concat ["<article class=\"", clazz, "\">"]) (const "</article>"))+ (msFencedHandlers def)+ }+ "<article class=\"someclass\"><p>foo</p><blockquote><p>bar</p></blockquote></article>"+ "@@@ someclass\nfoo\n\n> bar\n@@@" describe "examples" $ sequence_ examples describe "John Gruber's test suite" $ sequence_ gruber