{-| This module provides @pipes@ utilities for \"text streams\", which are
streams of 'Text' chunks. The individual chunks are uniformly @strict@, but
- can interact lazy 'Text's and 'IO.Handle's.
+ a 'Producer' can be converted to and from lazy 'Text's; an 'IO.Handle' can
+ be associated with a 'Producer' or 'Consumer' according as it is read or written to.
- To stream to or from 'IO.Handle's, use 'fromHandle' or 'toHandle'. For
+ To stream to or from 'IO.Handle's, one can use 'fromHandle' or 'toHandle'. For
example, the following program copies a document from one file to another:
> import Pipes
filter,
scan,
encodeUtf8,
+#if MIN_VERSION_text(0,11,4)
+ pipeDecodeUtf8,
+ pipeDecodeUtf8With,
+#endif
pack,
unpack,
+ toCaseFold,
+ toLower,
+ toUpper,
stripStart,
-- * Folds
minimum,
find,
index,
--- elemIndex,
--- findIndex,
count,
-- * Splitters
words,
#if MIN_VERSION_text(0,11,4)
decodeUtf8,
+ decodeUtf8With,
#endif
-- * Transformations
intersperse,
import Control.Exception (throwIO, try)
import Control.Monad (liftM, unless)
-import Control.Monad.Trans.State.Strict (StateT)
+import Control.Monad.Trans.State.Strict (StateT(..))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as TE
+import qualified Data.Text.Encoding.Error as TE
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.IO as TL
import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
-import Data.Char (ord)
+import Data.Char (ord, isSpace)
import Data.Functor.Identity (Identity)
import qualified Data.List as List
import Foreign.C.Error (Errno(Errno), ePIPE)
import qualified GHC.IO.Exception as G
import Pipes
import qualified Pipes.ByteString.Parse as PBP
-import Data.Text.Pipes.Parse (
+import Pipes.Text.Parse (
nextChar, drawChar, unDrawChar, peekChar, isEndOfChars )
import Pipes.Core (respond, Server')
import qualified Pipes.Parse as PP
import qualified Pipes.Prelude as P
import qualified System.IO as IO
import Data.Char (isSpace)
+import Data.Word (Word8)
import Prelude hiding (
all,
any,
fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
{-# INLINABLE fromLazy #-}
--- | Stream bytes from 'stdin'
+-- | Stream text from 'stdin'
stdin :: MonadIO m => Producer' Text m ()
stdin = fromHandle IO.stdin
{-# INLINABLE stdin #-}
toHandle h = for cat (liftIO . T.hPutStr h)
{-# INLINABLE toHandle #-}
+{-# RULES "p >-> toHandle h" forall p h .
+ p >-> toHandle h = for p (\txt -> liftIO (T.hPutStr h txt))
+ #-}
+
+
-- | Stream text into a file. Uses @pipes-safe@.
writeFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Consumer' Text m ()
writeFile file = Safe.withFile file IO.WriteMode toHandle
map f = P.map (T.map f)
{-# INLINABLE map #-}
+{-# RULES "p >-> map f" forall p f .
+ p >-> map f = for p (\txt -> yield (T.map f txt))
+ #-}
+
-- | Map a function over the characters of a text stream and concatenate the results
concatMap
:: (Monad m) => (Char -> Text) -> Pipe Text Text m r
concatMap f = P.map (T.concatMap f)
{-# INLINABLE concatMap #-}
+{-# RULES "p >-> concatMap f" forall p f .
+ p >-> concatMap f = for p (\txt -> yield (T.concatMap f txt))
+ #-}
-- | Transform a Pipe of 'Text' into a Pipe of 'ByteString's using UTF-8
--- encoding
+-- encoding; @encodeUtf8 = Pipes.Prelude.map TE.encodeUtf8@ so more complex
+-- encoding pipes can easily be constructed with the functions in @Data.Text.Encoding@
encodeUtf8 :: Monad m => Pipe Text ByteString m r
encodeUtf8 = P.map TE.encodeUtf8
{-# INLINEABLE encodeUtf8 #-}
---| Transform a Pipe of 'String's into one of 'Text' chunks
+{-# RULES "p >-> encodeUtf8" forall p .
+ p >-> encodeUtf8 = for p (\txt -> yield (TE.encodeUtf8 txt))
+ #-}
+
+-- | Transform a Pipe of 'String's into one of 'Text' chunks
pack :: Monad m => Pipe String Text m r
pack = P.map T.pack
{-# INLINEABLE pack #-}
---| Transforma a Pipes of 'Text' chunks into one of 'String's
+{-# RULES "p >-> pack" forall p .
+ p >-> pack = for p (\txt -> yield (T.pack txt))
+ #-}
+
+-- | Transform a Pipes of 'Text' chunks into one of 'String's
unpack :: Monad m => Pipe Text String m r
-unpack = P.map T.unpack
+unpack = for cat (\t -> yield (T.unpack t))
{-# INLINEABLE unpack #-}
---| @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utility,
+{-# RULES "p >-> unpack" forall p .
+ p >-> unpack = for p (\txt -> yield (T.unpack txt))
+ #-}
+
+-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utility,
-- here acting on a 'Text' pipe, rather as they would on a lazy text
toCaseFold :: Monad m => Pipe Text Text m ()
toCaseFold = P.map T.toCaseFold
{-# INLINEABLE toCaseFold #-}
---| lowercase incoming 'Text'
+{-# RULES "p >-> toCaseFold" forall p .
+ p >-> toCaseFold = for p (\txt -> yield (T.toCaseFold txt))
+ #-}
+
+
+-- | lowercase incoming 'Text'
toLower :: Monad m => Pipe Text Text m ()
toLower = P.map T.toLower
{-# INLINEABLE toLower #-}
---| uppercase incoming 'Text'
+{-# RULES "p >-> toLower" forall p .
+ p >-> toLower = for p (\txt -> yield (T.toLower txt))
+ #-}
+
+-- | uppercase incoming 'Text'
toUpper :: Monad m => Pipe Text Text m ()
toUpper = P.map T.toUpper
{-# INLINEABLE toUpper #-}
---| Remove leading white space from an incoming succession of 'Text's
+{-# RULES "p >-> toUpper" forall p .
+ p >-> toUpper = for p (\txt -> yield (T.toUpper txt))
+ #-}
+
+-- | Remove leading white space from an incoming succession of 'Text's
stripStart :: Monad m => Pipe Text Text m r
stripStart = do
chunk <- await
filter predicate = P.map (T.filter predicate)
{-# INLINABLE filter #-}
-
+{-# RULES "p >-> filter q" forall p q .
+ p >-> filter q = for p (\txt -> yield (T.filter q txt))
+ #-}
+
-- | Strict left scan over the characters
scan
:: (Monad m)
null = P.all T.null
{-# INLINABLE null #-}
--- | Count the number of bytes
+-- | Count the number of characters in the stream
length :: (Monad m, Num n) => Producer Text m () -> m n
length = P.fold (\n txt -> n + fromIntegral (T.length txt)) 0 id
{-# INLINABLE length #-}
all predicate = P.all (T.all predicate)
{-# INLINABLE all #-}
--- | Return the maximum 'Char' within a byte stream
+-- | Return the maximum 'Char' within a text stream
maximum :: (Monad m) => Producer Text m () -> m (Maybe Char)
maximum = P.fold step Nothing id
where
Just c -> max c (T.maximum txt)
{-# INLINABLE maximum #-}
--- | Return the minimum 'Char' within a byte stream
+-- | Return the minimum 'Char' within a text stream (surely very useful!)
minimum :: (Monad m) => Producer Text m () -> m (Maybe Char)
minimum = P.fold step Nothing id
where
find predicate p = head (p >-> filter predicate)
{-# INLINABLE find #-}
--- | Index into a byte stream
+-- | Index into a text stream
index
:: (Monad m, Integral a)
=> a-> Producer Text m () -> m (Maybe Char)
index n p = head (p >-> drop n)
{-# INLINABLE index #-}
--- | Find the index of an element that matches the given 'Char'
--- elemIndex
--- :: (Monad m, Num n) => Char -> Producer Text m () -> m (Maybe n)
--- elemIndex w8 = findIndex (w8 ==)
--- {-# INLINABLE elemIndex #-}
-
--- | Store the first index of an element that satisfies the predicate
--- findIndex
--- :: (Monad m, Num n)
--- => (Char -> Bool) -> Producer Text m () -> m (Maybe n)
--- findIndex predicate p = P.head (p >-> findIndices predicate)
--- {-# INLINABLE findIndex #-}
---
+
-- | Store a tally of how many segments match the given 'Text'
count :: (Monad m, Num n) => Text -> Producer Text m () -> m n
count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c))
yield l
p'
{-# INLINEABLE decodeUtf8 #-}
+
+-- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
+-- into a Pipe of Text with a replacement function of type @String -> Maybe Word8 -> Maybe Char@
+-- E.g. 'Data.Text.Encoding.Error.lenientDecode', which simply replaces bad bytes with \"�\"
+decodeUtf8With
+ :: Monad m
+ => TE.OnDecodeError
+ -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
+decodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
+ where go dec p = do
+ x <- lift (next p)
+ case x of
+ Left r -> return (return r)
+ Right (chunk, p') -> do
+ let TE.Some text l dec' = dec chunk
+ if B.null l
+ then do
+ yield text
+ go dec' p'
+ else return $ do
+ yield l
+ p'
+{-# INLINEABLE decodeUtf8With #-}
+
+-- | A simple pipe from 'ByteString' to 'Text'; a decoding error will arise
+-- with any chunk that contains a sequence of bytes that is unreadable. Otherwise
+-- only few bytes will only be moved from one chunk to the next before decoding.
+pipeDecodeUtf8 :: Monad m => Pipe ByteString Text m r
+pipeDecodeUtf8 = go TE.streamDecodeUtf8
+ where go dec = do chunk <- await
+ case dec chunk of
+ TE.Some text l dec' -> do yield text
+ go dec'
+{-# INLINEABLE pipeDecodeUtf8 #-}
+
+-- | A simple pipe from 'ByteString' to 'Text' using a replacement function.
+pipeDecodeUtf8With
+ :: Monad m
+ => TE.OnDecodeError
+ -> Pipe ByteString Text m r
+pipeDecodeUtf8With onErr = go (TE.streamDecodeUtf8With onErr)
+ where go dec = do chunk <- await
+ case dec chunk of
+ TE.Some text l dec' -> do yield text
+ go dec'
+{-# INLINEABLE pipeDecodeUtf8With #-}
#endif
-- | Splits a 'Producer' after the given number of characters
return (yield suffix >> p')
{-# INLINABLE span #-}
-{-| Split a byte stream in two, where the first byte stream is the longest
- consecutive group of bytes that don't satisfy the predicate
+{-| Split a text stream in two, where the first text stream is the longest
+ consecutive group of characters that don't satisfy the predicate
-}
break
:: (Monad m)
break predicate = span (not . predicate)
{-# INLINABLE break #-}
-{-| Split a byte stream into sub-streams delimited by bytes that satisfy the
+{-| Split a text stream into sub-streams delimited by characters that satisfy the
predicate
-}
splitWith
split c = splitWith (c ==)
{-# INLINABLE split #-}
-{-| Group a text stream into 'FreeT'-delimited byte streams using the supplied
+{-| Group a text stream into 'FreeT'-delimited text streams using the supplied
equality predicate
-}
groupBy
return $ PP.FreeT (go p'')
{-# INLINABLE groupBy #-}
--- | Group a byte stream into 'FreeT'-delimited byte streams of identical bytes
+-- | Group a text stream into 'FreeT'-delimited text streams of identical characters
group
:: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
group = groupBy (==)
{-# INLINABLE group #-}
-{-| Split a byte stream into 'FreeT'-delimited lines
-
- Note: This function is purely for demonstration purposes since it assumes a
- particular encoding. You should prefer the 'Data.Text.Text' equivalent of
- this function from the upcoming @pipes-text@ library.
+{-| Split a text stream into 'FreeT'-delimited lines
-}
lines
:: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
else return $ PP.Free $ go1 (yield txt >> p')
go1 p = do
p' <- break ('\n' ==) p
- return $ PP.FreeT (go2 p')
- go2 p = do
- x <- nextChar p
- return $ case x of
- Left r -> PP.Pure r
- Right (_, p') -> PP.Free (go1 p')
+ return $ PP.FreeT $ do
+ x <- nextChar p'
+ case x of
+ Left r -> return $ PP.Pure r
+ Right (_, p'') -> go0 p''
{-# INLINABLE lines #-}
-- | Split a text stream into 'FreeT'-delimited words
words
:: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
-words p0 = removeEmpty (splitWith isSpace p0)
+words = go
where
- removeEmpty f = PP.FreeT $ do
- x <- PP.runFreeT f
- case x of
- PP.Pure r -> return (PP.Pure r)
- PP.Free p -> do
- y <- next p
- case y of
- Left f' -> PP.runFreeT (removeEmpty f')
- Right (bs, p') -> return $ PP.Free $ do
- yield bs
- f' <- p'
- return (removeEmpty f')
+ go p = PP.FreeT $ do
+ x <- next (p >-> dropWhile isSpace)
+ return $ case x of
+ Left r -> PP.Pure r
+ Right (bs, p') -> PP.Free $ do
+ p'' <- break isSpace (yield bs >> p')
+ return (go p'')
{-# INLINABLE words #-}
--- | Intersperse a 'Char' in between the bytes of the byte stream
+
+-- | Intersperse a 'Char' in between the characters of the text stream
intersperse
:: (Monad m) => Char -> Producer Text m r -> Producer Text m r
intersperse c = go0
go1 f'
{-# INLINABLE intercalate #-}
-{-| Join 'FreeT'-delimited lines into a byte stream
+{-| Join 'FreeT'-delimited lines into a text stream
-}
unlines
:: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
projects / github / fretlink / text-pipes.git / blobdiff