mirroring Pipes.ByteString complete

3 files changed, 85 insertions, 187 deletions

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  ,