From 0f8c6f1bac4b42f7e20b33e78b61ed004758a04a Mon Sep 17 00:00:00 2001 From: michaelt Date: Sun, 26 Jan 2014 09:40:23 -0500 Subject: [PATCH 1/1] mirroring Pipes.ByteString complete --- Pipes/Text.hs | 131 ++++++++++++++++++++++++++--------------- Pipes/Text/Parse.hs | 139 -------------------------------------------- pipes-text.cabal | 2 +- 3 files changed, 85 insertions(+), 187 deletions(-) delete mode 100644 Pipes/Text/Parse.hs diff --git a/Pipes/Text.hs b/Pipes/Text.hs index 74576e8..cd63742 100644 --- a/Pipes/Text.hs +++ b/Pipes/Text.hs @@ -129,7 +129,7 @@ module Pipes.Text ( -- * FreeT Splitters , chunksOf , splitsWith - , split + , splits -- , groupsBy -- , groups , lines @@ -155,6 +155,7 @@ module Pipes.Text ( ) where import Control.Exception (throwIO, try) +import Control.Applicative ((<*)) import Control.Monad (liftM, unless, join) import Control.Monad.Trans.State.Strict (StateT(..), modify) import Data.Monoid ((<>)) @@ -181,8 +182,6 @@ import Pipes import qualified Pipes.ByteString as PB import qualified Pipes.Text.Internal as PE import Pipes.Text.Internal (Codec(..)) --- import Pipes.Text.Parse (nextChar, drawChar, unDrawChar, peekChar, isEndOfChars ) - import Pipes.Core (respond, Server') import qualified Pipes.Parse as PP import Pipes.Parse (Parser, concats, intercalates, FreeT(..)) @@ -753,21 +752,6 @@ splitAt n0 k p0 = fmap join (k (go n0 p0)) return (yield suffix >> p') {-# INLINABLE splitAt #-} --- | Split a text stream into 'FreeT'-delimited text streams of fixed size -chunksOf - :: (Monad m, Integral n) - => n -> Lens' (Producer Text m r) - (FreeT (Producer Text m) m r) -chunksOf n k p0 = fmap concats (k (FreeT (go p0))) - where - go p = do - x <- next p - return $ case x of - Left r -> PP.Pure r - Right (txt, p') -> PP.Free $ do - p'' <- (yield txt >> p') ^. splitAt n - return $ PP.FreeT (go p'') -{-# INLINABLE chunksOf #-} {-| Split a text stream in two, where the first text stream is the longest consecutive group of text that satisfy the predicate @@ -892,6 +876,24 @@ packChars = Data.Profunctor.dimap to (fmap from) from p = for p (each . T.unpack) {-# INLINABLE packChars #-} + +-- | Split a text stream into 'FreeT'-delimited text streams of fixed size +chunksOf + :: (Monad m, Integral n) + => n -> Lens' (Producer Text m r) + (FreeT (Producer Text m) m r) +chunksOf n k p0 = fmap concats (k (FreeT (go p0))) + where + go p = do + x <- next p + return $ case x of + Left r -> PP.Pure r + Right (txt, p') -> PP.Free $ do + p'' <- (yield txt >> p') ^. splitAt n + return $ PP.FreeT (go p'') +{-# INLINABLE chunksOf #-} + + {-| Split a text stream into sub-streams delimited by characters that satisfy the predicate -} @@ -922,43 +924,80 @@ splitsWith predicate p0 = PP.FreeT (go0 p0) {-# INLINABLE splitsWith #-} -- | Split a text stream using the given 'Char' as the delimiter -split :: (Monad m) +splits :: (Monad m) => Char - -> Producer Text m r - -> FreeT (Producer Text m) m r -split c = splitsWith (c ==) -{-# INLINABLE split #-} + -> Lens' (Producer Text m r) + (FreeT (Producer Text m) m r) +splits c k p = + fmap (PP.intercalates (yield (T.singleton c))) (k (splitsWith (c ==) p)) +{-# INLINABLE splits #-} + +{-| Isomorphism between a stream of 'Text' and groups of equivalent 'Char's , using the + given equivalence relation +-} +groupsBy + :: Monad m + => (Char -> Char -> Bool) + -> Lens' (Producer Text m x) (FreeT (Producer Text m) m x) +groupsBy equals k p0 = fmap concats (k (PP.FreeT (go p0))) where + go p = do x <- next p + case x of Left r -> return (PP.Pure r) + Right (bs, p') -> case T.uncons bs of + Nothing -> go p' + Just (c, _) -> do return $ PP.Free $ do + p'' <- (yield bs >> p')^.span (equals c) + return $ PP.FreeT (go p'') +{-# INLINABLE groupsBy #-} + + +-- | Like 'groupsBy', where the equality predicate is ('==') +groups + :: Monad m + => Lens' (Producer Text m x) (FreeT (Producer Text m) m x) +groups = groupsBy (==) +{-# INLINABLE groups #-} + {-| Split a text stream into 'FreeT'-delimited lines -} lines - :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r -lines p0 = PP.FreeT (go0 p0) + :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) +lines = Data.Profunctor.dimap _lines (fmap _unlines) where - go0 p = do - x <- next p - case x of - Left r -> return (PP.Pure r) - Right (txt, p') -> - if (T.null txt) - then go0 p' - else return $ PP.Free $ go1 (yield txt >> p') - go1 p = do - p' <- p ^. break ('\n' ==) - return $ PP.FreeT $ do - x <- nextChar p' - case x of - Left r -> return $ PP.Pure r - Right (_, p'') -> go0 p'' + _lines p0 = PP.FreeT (go0 p0) + where + go0 p = do + x <- next p + case x of + Left r -> return (PP.Pure r) + Right (txt, p') -> + if (T.null txt) + then go0 p' + else return $ PP.Free $ go1 (yield txt >> p') + go1 p = do + p' <- p ^. break ('\n' ==) + return $ PP.FreeT $ do + x <- nextChar p' + case x of + Left r -> return $ PP.Pure r + Right (_, p'') -> go0 p'' + -- _unlines + -- :: Monad m + -- => FreeT (Producer Text m) m x -> Producer Text m x + _unlines = PP.concats . PP.transFreeT addNewline + + -- addNewline + -- :: Monad m => Producer Text m r -> Producer Text m r + addNewline p = p <* yield (T.singleton '\n') {-# INLINABLE lines #-} -- | Split a text stream into 'FreeT'-delimited words words - :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r -words = go + :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r) +words = Data.Profunctor.dimap go (fmap _unwords) where go p = PP.FreeT $ do x <- next (p >-> dropWhile isSpace) @@ -967,12 +1006,11 @@ words = go Right (bs, p') -> PP.Free $ do p'' <- (yield bs >> p') ^. break isSpace return (go p'') + _unwords = PP.intercalates (yield $ T.singleton ' ') + {-# INLINABLE words #-} - - - {-| 'intercalate' concatenates the 'FreeT'-delimited text streams after interspersing a text stream in between them -} @@ -1029,11 +1067,10 @@ unwords = intercalate (yield $ T.pack " ") -} {- $reexports - @Pipes.Text.Parse@ re-exports 'nextChar', 'drawChar', 'unDrawChar', 'peekChar', and 'isEndOfChars'. @Data.Text@ re-exports the 'Text' type. - @Pipes.Parse@ re-exports 'input', 'concat', and 'FreeT' (the type). + @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. -} diff --git a/Pipes/Text/Parse.hs b/Pipes/Text/Parse.hs deleted file mode 100644 index 317f85d..0000000 --- a/Pipes/Text/Parse.hs +++ /dev/null @@ -1,139 +0,0 @@ --- | Parsing utilities for texts, in the style of @pipes-parse@ and @Pipes.ByteString.Parse@ - -module Pipes.Text.Parse ( - -- * Parsers - nextChar, - drawChar, - unDrawChar, - peekChar, - isEndOfChars, - take, - takeWhile - ) where - -import Control.Monad.Trans.State.Strict (StateT, modify) -import qualified Data.Text as T -import Data.Text (Text) - -import Pipes -import qualified Pipes.Parse as PP - -import Prelude hiding (take, takeWhile) - -{-| Consume the first character from a 'Text' stream - - 'next' either fails with a 'Left' if the 'Producer' has no more characters or - succeeds with a 'Right' providing the next character and the remainder of the - 'Producer'. --} -nextChar - :: (Monad m) - => Producer Text m r - -> m (Either r (Char, Producer Text m r)) -nextChar = go - where - go p = do - x <- next p - case x of - Left r -> return (Left r) - Right (txt, p') -> case (T.uncons txt) of - Nothing -> go p' - Just (c, txt') -> return (Right (c, yield txt' >> p')) -{-# INLINABLE nextChar #-} - -{-| Draw one 'Char' from the underlying 'Producer', returning 'Nothing' if the - 'Producer' is empty --} -drawChar :: (Monad m) => StateT (Producer Text m r) m (Maybe Char) -drawChar = do - x <- PP.draw - case x of - Nothing -> return Nothing - Just txt -> case (T.uncons txt) of - Nothing -> drawChar - Just (c, txt') -> do - PP.unDraw txt' - return (Just c) -{-# INLINABLE drawChar #-} - --- | Push back a 'Char' onto the underlying 'Producer' -unDrawChar :: (Monad m) => Char -> StateT (Producer Text m r) m () -unDrawChar c = modify (yield (T.singleton c) >>) -{-# INLINABLE unDrawChar #-} - -{-| 'peekChar' checks the first 'Char' in the stream, but uses 'unDrawChar' to - push the 'Char' back - -> peekChar = do -> x <- drawChar -> case x of -> Left _ -> return () -> Right c -> unDrawChar c -> return x --} -peekChar :: (Monad m) => StateT (Producer Text m r) m (Maybe Char) -peekChar = do - x <- drawChar - case x of - Nothing -> return () - Just c -> unDrawChar c - return x -{-# INLINABLE peekChar #-} - -{-| Check if the underlying 'Producer' has no more characters - - Note that this will skip over empty 'Text' chunks, unlike - 'PP.isEndOfInput' from @pipes-parse@. - -> isEndOfChars = liftM isLeft peekChar --} -isEndOfChars :: (Monad m) => StateT (Producer Text m r) m Bool -isEndOfChars = do - x <- peekChar - return (case x of - Nothing -> True - Just _-> False ) -{-# INLINABLE isEndOfChars #-} - -{-| @(take n)@ only allows @n@ characters to pass - - Unlike 'take', this 'PP.unDraw's unused characters --} -take :: (Monad m, Integral a) => a -> Pipe Text Text (StateT (Producer Text m r) m) () -take n0 = go n0 where - go n - | n <= 0 = return () - | otherwise = do - txt <- await - let len = fromIntegral (T.length txt) - if (len > n) - then do - let n' = fromIntegral n - lift . PP.unDraw $ T.drop n' txt - yield $ T.take n' txt - else do - yield txt - go (n - len) -{-# INLINABLE take #-} - -{-| Take characters until they fail the predicate - - Unlike 'takeWhile', this 'PP.unDraw's unused characters --} -takeWhile - :: (Monad m) - => (Char -> Bool) - -> Pipe Text Text (StateT (Producer Text m r) m) () -takeWhile predicate = go - where - go = do - txt <- await - let (prefix, suffix) = T.span predicate txt - if (T.null suffix) - then do - yield txt - go - else do - lift $ PP.unDraw suffix - yield prefix -{-# INLINABLE takeWhile #-} diff --git a/pipes-text.cabal b/pipes-text.cabal index 1a3e437..15928f7 100644 --- a/pipes-text.cabal +++ b/pipes-text.cabal @@ -14,7 +14,7 @@ cabal-version: >=1.10 library c-sources: cbits/cbits.c include-dirs: include - exposed-modules: Pipes.Text, Pipes.Text.Parse, Pipes.Text.Internal + exposed-modules: Pipes.Text, Pipes.Text.Internal -- other-modules: other-extensions: RankNTypes build-depends: base >= 4 && < 5 , -- 2.41.0