markdown 0.1.2 → 0.1.2.1
raw patch · 3 files changed
+43/−20 lines, 3 filesdep ~attoparsec-conduitdep ~basedep ~conduit
Dependency ranges changed: attoparsec-conduit, base, conduit
Files
- Text/Markdown.hs +3/−3
- Text/Markdown/Block.hs +37/−14
- markdown.cabal +3/−3
Text/Markdown.hs view
@@ -85,12 +85,12 @@ data MState = NoState | InList ListType -toHtmlB :: Monad m => MarkdownSettings -> GInfConduit (Block Html) m Html+toHtmlB :: Monad m => MarkdownSettings -> Conduit (Block Html) m Html toHtmlB ms = loop NoState where- loop state = awaitE >>= either- (\e -> closeState state >> return e)+ loop state = await >>= maybe+ (closeState state) (\x -> do state' <- getState state x yield $ go x
Text/Markdown/Block.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Text.Markdown.Block ( Block (..)@@ -10,7 +11,12 @@ ) where import Prelude+#if MIN_VERSION_conduit(1, 0, 0) import Data.Conduit+#else+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)@@ -21,6 +27,11 @@ 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+ toBlocks :: Monad m => MarkdownSettings -> Conduit Text m (Block Text) toBlocks ms = mapOutput fixWS CT.lines =$= toBlocksLines ms@@ -38,12 +49,12 @@ 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 :: Monad m => Conduit (Either Blank (Block Text)) m (Block Text) tightenLists = go Nothing where go mTightList =- awaitE >>= either return go'+ await >>= maybe (return ()) go' where go' (Left Blank) = go mTightList go' (Right (BlockList ltNew contents)) =@@ -131,13 +142,13 @@ d <- T.stripPrefix "]:" c Just (name, T.strip d) -start :: Monad m => MarkdownSettings -> Text -> GLConduit Text m (Either Blank (Block Text))+start :: Monad m => MarkdownSettings -> Text -> Conduit 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+ (finished, ls) <- takeTillConsume (== term) case finished of Just _ -> do let block =@@ -147,19 +158,19 @@ mapM_ (yield . Right) block Nothing -> mapM_ leftover (reverse $ T.cons ' ' t : ls) go (LineBlockQuote t') = do- ls <- takeQuotes >+> CL.consume+ ls <- takeQuotes =$= CL.consume let blocks = runIdentity $ 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@@ -185,7 +196,7 @@ _ | Just t2' <- t2 , Just t2'' <- T.stripPrefix " " t2' , LineList _ltype' _t2''' <- lineType ms t2'' -> do- ls <- getIndented 4 >+> CL.consume+ ls <- getIndented 4 =$= CL.consume let blocks = runIdentity $ mapM_ yield ls $$ toBlocksLines ms =$ CL.consume let addPlainText | T.null $ T.strip t' = id@@ -194,7 +205,7 @@ _ -> do let t'' = T.dropWhile (== ' ') t' let leader = T.length t - T.length t''- ls <- getIndented leader >+> CL.consume+ 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@@ -219,7 +230,7 @@ isNonPara LineBlank = True isNonPara LineFenced{} = True isNonPara _ = False- (mfinal, ls) <- takeTill (\x -> isNonPara (lineType ms x) || listStartIndent x) >+> withUpstream CL.consume+ (mfinal, ls) <- takeTillConsume (\x -> isNonPara (lineType ms x) || listStartIndent x) maybe (return ()) leftover mfinal yield $ Right $ BlockPara $ T.intercalate "\n" $ t' : ls @@ -243,12 +254,24 @@ (c == '/') || (c == '!') -takeTill :: Monad m => (i -> Bool) -> Pipe l i i u m (Maybe i)+takeTill :: Monad m => (i -> Bool) -> Conduit i m i takeTill f = loop where- loop = await >>= maybe (return Nothing) (\x -> if f x then return (Just x) else yield x >> loop)+ 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 f =+ loop id+ where+ loop front = await >>= maybe+ (return (Nothing, front []))+ (\x ->+ if f x+ then return (Just x, front [])+ else loop (front . (x:))+ )+ listStart :: Text -> Maybe (ListType, Text) listStart t0 | Just t' <- T.stripPrefix "* " t = Just (Unordered, t')@@ -274,7 +297,7 @@ Just (')', y) -> Just y _ -> Nothing -getIndented :: Monad m => Int -> GLConduit Text m Text+getIndented :: Monad m => Int -> Conduit Text m Text getIndented leader = go [] where@@ -290,7 +313,7 @@ where (x, y) = T.splitAt leader t -takeQuotes :: Monad m => GLConduit Text m Text+takeQuotes :: Monad m => Conduit Text m Text takeQuotes = await >>= maybe (return ()) go where
markdown.cabal view
@@ -1,5 +1,5 @@ Name: markdown-Version: 0.1.2+Version: 0.1.2.1 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@@ -23,9 +23,9 @@ Build-depends: base >= 4 && < 5 , blaze-html >= 0.4 , attoparsec >= 0.10- , attoparsec-conduit >= 0.5 && < 0.6+ , attoparsec-conduit >= 0.5 , transformers >= 0.2.2- , conduit >= 0.5.2.1 && < 0.6+ , conduit >= 0.5.2.1 , text , data-default >= 0.3 , xss-sanitize >= 0.3.3