markdown 0.1.16 → 0.1.17
raw patch · 6 files changed
+42/−49 lines, 6 filesdep +call-stackdep ~basedep ~conduitPVP ok
version bump matches the API change (PVP)
Dependencies added: call-stack
Dependency ranges changed: base, conduit
API changes (from Hackage documentation)
+ Text.Markdown: instance Data.Semigroup.Semigroup Text.Markdown.Markdown
Files
- Text/Markdown.hs +11/−13
- Text/Markdown/Block.hs +23/−26
- Text/Markdown/Inline.hs +1/−4
- markdown.cabal +4/−3
- test/Block.hs +1/−2
- test/main.hs +2/−1
Text/Markdown.hs view
@@ -43,17 +43,17 @@ import Text.Blaze.Html.Renderer.Text (renderHtml) import Data.Conduit import qualified Data.Conduit.List as CL-import Data.Monoid (Monoid (mappend, mempty, mconcat))-import Data.Functor.Identity (runIdentity)+import Data.Monoid (Monoid (mappend, mempty, mconcat), (<>)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as HA import Text.HTML.SanitizeXSS (sanitizeBalance) import qualified Data.Map as Map import Data.String (IsString)+import Data.Semigroup (Semigroup) -- | A newtype wrapper providing a @ToHtml@ instance. newtype Markdown = Markdown TL.Text- deriving(Eq, Ord, Monoid, IsString, Show)+ deriving(Eq, Ord, Monoid, Semigroup, IsString, Show) instance ToMarkup Markdown where toMarkup (Markdown t) = markdown def t@@ -70,10 +70,10 @@ markdown :: MarkdownSettings -> TL.Text -> Html markdown ms tl = sanitize- $ runIdentity+ $ runConduitPure $ CL.sourceList blocksH- $= toHtmlB ms- $$ CL.fold mappend mempty+ .| toHtmlB ms+ .| CL.fold mappend mempty where sanitize | msXssProtect ms = preEscapedToMarkup . sanitizeBalance . TL.toStrict . renderHtml@@ -82,10 +82,10 @@ blocksH = processBlocks blocks blocks :: [Block Text]- blocks = runIdentity+ blocks = runConduitPure $ CL.sourceList (TL.toChunks tl)- $$ toBlocks ms- =$ CL.consume+ .| toBlocks ms+ .| CL.consume processBlocks :: [Block Text] -> [Block Html] processBlocks = map (fmap $ toHtmlI ms)@@ -102,7 +102,7 @@ data MState = NoState | InList ListType -toHtmlB :: Monad m => MarkdownSettings -> Conduit (Block Html) m Html+toHtmlB :: Monad m => MarkdownSettings -> ConduitM (Block Html) Html m () toHtmlB ms = loop NoState where@@ -156,7 +156,7 @@ go BlockReference{} = return () - blocksToHtml bs = runIdentity $ mapM_ yield bs $$ toHtmlB ms =$ CL.fold mappend mempty+ blocksToHtml bs = runConduitPure $ mapM_ yield bs .| toHtmlB ms .| CL.fold mappend mempty escape :: Text -> Html escape = preEscapedToMarkup@@ -184,11 +184,9 @@ go (InlineImage url (Just title) content) = H.img H.! HA.src (H.toValue url) H.! HA.alt (H.toValue content) H.! HA.title (H.toValue title) go (InlineHtml t) = escape t go (InlineFootnoteRef x) = let ishown = TL.pack (show x)- (<>) = mappend in H.a H.! HA.href (H.toValue $ "#footnote-" <> ishown) H.! HA.id (H.toValue $ "ref-" <> ishown) $ H.toHtml $ "[" <> ishown <> "]" go (InlineFootnote x) = let ishown = TL.pack (show x)- (<>) = mappend in H.a H.! HA.href (H.toValue $ "#ref-" <> ishown) H.! HA.id (H.toValue $ "footnote-" <> ishown) $ H.toHtml $ "[" <> ishown <> "]"
Text/Markdown/Block.hs view
@@ -16,32 +16,26 @@ #if MIN_VERSION_conduit(1, 0, 0) import Data.Conduit #else-import Data.Conduit hiding ((=$=))+import Data.Conduit hiding ((.|)) import Data.Conduit.Internal (pipeL) #endif import qualified Data.Conduit.Text as CT import qualified Data.Conduit.List as CL import Data.Text (Text) import qualified Data.Text as T-import Data.Functor.Identity (runIdentity) import Data.Char (isDigit) import Text.Markdown.Types import qualified Data.Set as Set import qualified Data.Map as Map -#if !MIN_VERSION_conduit(1, 0, 0)-(=$=) :: Monad m => Pipe a a b x m y -> Pipe b b c y m z -> Pipe a a c x m z-(=$=) = pipeL-#endif- toBlockLines :: Block Text -> Block [Text] toBlockLines = fmap $ map T.stripEnd . concatMap (T.splitOn " \r\n") . T.splitOn " \n" -toBlocks :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)+toBlocks :: Monad m => MarkdownSettings -> ConduitM Text (Block Text) m () toBlocks ms =- mapOutput fixWS CT.lines =$= toBlocksLines ms+ mapOutput fixWS CT.lines .| toBlocksLines ms where fixWS = T.pack . go 0 . T.unpack @@ -53,10 +47,10 @@ j = 4 - (i `mod` 4) go i (c:cs) = c : go (i + 1) cs -toBlocksLines :: Monad m => MarkdownSettings -> Conduit Text m (Block Text)-toBlocksLines ms = awaitForever (start ms) =$= tightenLists+toBlocksLines :: Monad m => MarkdownSettings -> ConduitM Text (Block Text) m ()+toBlocksLines ms = awaitForever (start ms) .| tightenLists -tightenLists :: Monad m => Conduit (Either Blank (Block Text)) m (Block Text)+tightenLists :: Monad m => ConduitM (Either Blank (Block Text)) (Block Text) m () tightenLists = go Nothing where@@ -149,7 +143,7 @@ d <- T.stripPrefix "]:" c Just (name, T.strip d) -start :: Monad m => MarkdownSettings -> Text -> Conduit Text m (Either Blank (Block Text))+start :: Monad m => MarkdownSettings -> Text -> ConduitM Text (Either Blank (Block Text)) m () start ms t = go $ lineType ms t where@@ -161,23 +155,23 @@ let block = case fh of FHRaw fh' -> fh' $ T.intercalate "\n" ls- FHParsed fh' -> fh' $ runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume+ FHParsed fh' -> fh' $ runConduitPure $ mapM_ yield ls .| toBlocksLines ms .| CL.consume mapM_ (yield . Right) block Nothing -> mapM_ leftover (reverse $ T.cons ' ' t : ls) go (LineBlockQuote t') = do- ls <- takeQuotes =$= CL.consume- let blocks = runIdentity $ mapM_ yield (t' : ls) $$ toBlocksLines ms =$ CL.consume+ ls <- takeQuotes .| CL.consume+ let blocks = runConduitPure $ mapM_ yield (t' : ls) .| toBlocksLines ms .| CL.consume yield $ Right $ BlockQuote blocks go (LineHeading level t') = yield $ Right $ BlockHeading level t' go (LineCode t') = do- ls <- getIndented 4 =$= CL.consume+ ls <- getIndented 4 .| CL.consume yield $ Right $ BlockCode Nothing $ T.intercalate "\n" $ t' : ls 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+ ls <- takeTill (T.null . T.strip) .| CL.consume yield $ Right $ BlockHtml $ T.intercalate "\n" $ t' : ls go (LineList ltype t') = do t2 <- CL.peek@@ -203,8 +197,8 @@ _ | 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+ ls <- getIndented 4 .| CL.consume+ let blocks = runConduitPure $ mapM_ yield ls .| toBlocksLines ms .| CL.consume let addPlainText | T.null $ T.strip t' = id | otherwise = (BlockPlainText (T.strip t'):)@@ -212,8 +206,8 @@ _ -> 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+ ls <- getIndented leader .| CL.consume+ let blocks = runConduitPure $ 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@@ -272,13 +266,16 @@ isPI = ("?" `T.isPrefixOf`) isCommentCData = ("!" `T.isPrefixOf`) -takeTill :: Monad m => (i -> Bool) -> Conduit i m i+takeTill :: Monad m => (i -> Bool) -> ConduitM i i m () takeTill f = loop where loop = await >>= maybe (return ()) (\x -> if f x then return () else yield x >> loop) ---takeTillConsume :: Monad m => (i -> Bool) -> Consumer i m (Maybe i, [i])+takeTillConsume+ :: Monad m+ => (i -> Bool)+ -> ConduitM i o m (Maybe i, [i]) takeTillConsume f = loop id where@@ -319,7 +316,7 @@ stripPrefixChoice :: [Text] -> Text -> Maybe Text stripPrefixChoice xs x = msum $ map (flip T.stripPrefix x) xs -getIndented :: Monad m => Int -> Conduit Text m Text+getIndented :: Monad m => Int -> ConduitM Text Text m () getIndented leader = go [] where@@ -335,7 +332,7 @@ where (x, y) = T.splitAt leader t -takeQuotes :: Monad m => Conduit Text m Text+takeQuotes :: Monad m => ConduitM Text Text m () takeQuotes = await >>= maybe (return ()) go where
Text/Markdown/Inline.hs view
@@ -11,7 +11,7 @@ import qualified Data.Text as T import Data.Attoparsec.Text import Control.Applicative-import Data.Monoid (Monoid, mappend)+import Data.Monoid ((<>)) import qualified Data.Map as Map import Text.Markdown.Types (Inline(..)) import Data.XML.Types (Content (..))@@ -24,9 +24,6 @@ case parseOnly (inlineParser refmap) t of Left s -> [InlineText $ T.pack s] Right is -> is--(<>) :: Monoid m => m -> m -> m-(<>) = mappend inlineParser :: RefMap -> Parser [Inline]
markdown.cabal view
@@ -1,5 +1,5 @@ Name: markdown-Version: 0.1.16+Version: 0.1.17 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@@ -20,12 +20,12 @@ Text.Markdown.Block Text.Markdown.Inline other-modules: Text.Markdown.Types- Build-depends: base >= 4 && < 5+ Build-depends: base >= 4.9 && < 5 , blaze-markup >= 0.6 , blaze-html >= 0.4 , attoparsec >= 0.10 , transformers >= 0.2.2- , conduit >= 1.1+ , conduit >= 1.2.8 , conduit-extra >= 1.1 , text , data-default >= 0.3@@ -47,6 +47,7 @@ , base >= 4 && < 5 , hspec >= 1.3 , blaze-html+ , call-stack , text , transformers , conduit
test/Block.hs view
@@ -8,10 +8,9 @@ import qualified Data.Conduit.List as CL import Text.Markdown (def, MarkdownSettings(..)) import Text.Markdown.Block-import Data.Functor.Identity (runIdentity) checkWith :: MarkdownSettings -> Text -> [Block Text] -> Expectation-checkWith ms md blocks = runIdentity (yield md $$ toBlocks ms =$ CL.consume) `shouldBe` blocks+checkWith ms md blocks = runConduitPure (yield md .| toBlocks ms .| CL.consume) `shouldBe` blocks check :: Text -> [Block Text] -> Expectation check = checkWith def
test/main.hs view
@@ -13,6 +13,7 @@ import qualified Data.Map as Map import Data.List (isInfixOf, isSuffixOf) import Data.Maybe (fromMaybe)+import Data.CallStack import System.Directory (getDirectoryContents) import System.FilePath ((</>), replaceExtension)@@ -20,7 +21,7 @@ import Block import Inline -check :: Text -> Text -> Expectation+check :: HasCallStack => Text -> Text -> Expectation check html md = renderHtml (markdown def md) `shouldBe` html checkSet :: MarkdownSettings -> Text -> Text -> Expectation