packages feed

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 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 &lt; 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