-{-# LANGUAGE RankNTypes, TypeFamilies, CPP #-}
-
+{-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, CPP #-}
+#if __GLASGOW_HASKELL__ >= 702
+{-# LANGUAGE Trustworthy #-}
+#endif
{-| 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.
+ streams of 'Text' chunks. The individual chunks are uniformly @strict@, but
+ a 'Producer' can be converted to and from lazy 'Text's, though this is generally
+ unwise. Where pipes IO replaces lazy IO, 'Producer Text m r' replaces lazy 'Text'.
+ 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
Note that functions in this library are designed to operate on streams that
are insensitive to text boundaries. This means that they may freely split
- text into smaller texts and /discard empty texts/. However, they will
- /never concatenate texts/ in order to provide strict upper bounds on memory
- usage.
+ text into smaller texts, /discard empty texts/. However, apart from the
+ special case of 'concatMap', they will /never concatenate texts/ in order
+ to provide strict upper bounds on memory usage -- with the single exception of 'concatMap'.
-}
module Pipes.Text (
-- * Producers
- fromLazy,
- stdin,
- fromHandle,
- readFile,
- stdinLn,
+ fromLazy
+ , stdin
+ , fromHandle
+ , readFile
-- * Consumers
- stdout,
- stdoutLn,
- toHandle,
- writeFile,
+ , stdout
+ , toHandle
+ , writeFile
-- * Pipes
- map,
- concatMap,
- take,
- drop,
- takeWhile,
- dropWhile,
- filter,
- scan,
- encodeUtf8,
- pack,
- unpack,
- toCaseFold,
- toLower,
- toUpper,
- stripStart,
+ , map
+ , concatMap
+ , take
+ , drop
+ , takeWhile
+ , dropWhile
+ , filter
+ , scan
+ , encodeUtf8
+ , pack
+ , unpack
+ , toCaseFold
+ , toLower
+ , toUpper
+ , stripStart
-- * Folds
- toLazy,
- toLazyM,
- fold,
- head,
- last,
- null,
- length,
- any,
- all,
- maximum,
- minimum,
- find,
- index,
--- elemIndex,
--- findIndex,
- count,
+ , toLazy
+ , toLazyM
+ , foldChars
+ , head
+ , last
+ , null
+ , length
+ , any
+ , all
+ , maximum
+ , minimum
+ , find
+ , index
+ , count
+
+ -- * Primitive Character Parsers
+ -- $parse
+ , nextChar
+ , drawChar
+ , unDrawChar
+ , peekChar
+ , isEndOfChars
+
+ -- * Parsing Lenses
+ , splitAt
+ , span
+ , break
+ , groupBy
+ , group
+ , word
+ , line
+
+ -- * Decoding Lenses
+ , decodeUtf8
+ , codec
+
+ -- * Codecs
+ , utf8
+ , utf16_le
+ , utf16_be
+ , utf32_le
+ , utf32_be
+
+ -- * Other Decoding/Encoding Functions
+ , decodeIso8859_1
+ , decodeAscii
+ , encodeIso8859_1
+ , encodeAscii
+
+ -- * FreeT Splitters
+ , chunksOf
+ , splitsWith
+ , splits
+-- , groupsBy
+-- , groups
+ , lines
+ , words
- -- * Splitters
- splitAt,
- chunksOf,
- span,
- break,
- splitWith,
- split,
- groupBy,
- group,
- lines,
- words,
-#if MIN_VERSION_text(0,11,4)
- decodeUtf8,
-#endif
-- * Transformations
- intersperse,
+ , intersperse
+ , packChars
-- * Joiners
- intercalate,
- unlines,
- unwords,
-
- -- * Character Parsers
- -- $parse
- nextChar,
- drawChar,
- unDrawChar,
- peekChar,
- isEndOfChars,
+ , intercalate
+ , unlines
+ , unwords
- -- * Re-exports
+ -- * Re-exports
-- $reexports
- module Data.Text,
- module Pipes.Parse
+ , module Data.ByteString
+ , module Data.Text
+ , module Data.Profunctor
+ , module Data.Word
+ , module Pipes.Parse
+ , module Pipes.Group
+ , module Pipes.Text.Internal
) where
import Control.Exception (throwIO, try)
-import Control.Monad (liftM, unless)
-import Control.Monad.Trans.State.Strict (StateT)
+import Control.Applicative ((<*))
+import Control.Monad (liftM, unless, join)
+import Control.Monad.Trans.State.Strict (StateT(..), modify)
+import Data.Monoid ((<>))
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 qualified Data.ByteString.Char8 as B8
+import Data.Char (ord, isSpace)
+import Data.Functor.Constant (Constant(Constant, getConstant))
import Data.Functor.Identity (Identity)
+import Data.Profunctor (Profunctor)
+import qualified Data.Profunctor
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 Pipes.Text.Parse (
- nextChar, drawChar, unDrawChar, peekChar, isEndOfChars )
+import qualified Pipes.ByteString as PB
+import qualified Pipes.Text.Internal as PI
+import Pipes.Text.Internal
import Pipes.Core (respond, Server')
+import Pipes.Group (concats, intercalates, FreeT(..), FreeF(..))
+import qualified Pipes.Group as PG
import qualified Pipes.Parse as PP
-import Pipes.Parse (input, concat, FreeT)
+import Pipes.Parse (Parser)
import qualified Pipes.Safe.Prelude as Safe
import qualified Pipes.Safe as Safe
import Pipes.Safe (MonadSafe(..), Base(..))
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,
-- | Convert a lazy 'TL.Text' into a 'Producer' of strict 'Text's
fromLazy :: (Monad m) => TL.Text -> Producer' Text m ()
fromLazy = foldrChunks (\e a -> yield e >> a) (return ())
-{-# INLINABLE fromLazy #-}
+{-# INLINE fromLazy #-}
-- | Stream text from 'stdin'
-stdin :: MonadIO m => Producer' Text m ()
+stdin :: MonadIO m => Producer Text m ()
stdin = fromHandle IO.stdin
-{-# INLINABLE stdin #-}
+{-# INLINE stdin #-}
{-| Convert a 'IO.Handle' into a text stream using a text size
- determined by the good sense of the text library.
-
+ determined by the good sense of the text library; note that this
+ is distinctly slower than @decideUtf8 (Pipes.ByteString.fromHandle h)@
+ but uses the system encoding and has other `Data.Text.IO` features
-}
-fromHandle :: MonadIO m => IO.Handle -> Producer' Text m ()
-fromHandle h = go where
- go = do txt <- liftIO (T.hGetChunk h)
- unless (T.null txt) $ do yield txt
- go
+fromHandle :: MonadIO m => IO.Handle -> Producer Text m ()
+fromHandle h = go where
+ go = do txt <- liftIO (T.hGetChunk h)
+ unless (T.null txt) ( do yield txt
+ go )
{-# INLINABLE fromHandle#-}
-{-| Stream text from a file using Pipes.Safe
+
+{-| Stream text from a file in the simple fashion of @Data.Text.IO@
>>> runSafeT $ runEffect $ Text.readFile "hello.hs" >-> Text.map toUpper >-> hoist lift Text.stdout
MAIN = PUTSTRLN "HELLO WORLD"
-}
-readFile :: (MonadSafe m, Base m ~ IO) => FilePath -> Producer' Text m ()
+readFile :: MonadSafe m => FilePath -> Producer Text m ()
readFile file = Safe.withFile file IO.ReadMode fromHandle
-{-# INLINABLE readFile #-}
-
-{-| Stream lines of text from stdin (for testing in ghci etc.)
-
->>> let safely = runSafeT . runEffect
->>> safely $ for Text.stdinLn (lift . lift . print . T.length)
-hello
-5
-world
-5
-
--}
-stdinLn :: MonadIO m => Producer' Text m ()
-stdinLn = go where
- go = do
- eof <- liftIO (IO.hIsEOF IO.stdin)
- unless eof $ do
- txt <- liftIO (T.hGetLine IO.stdin)
- yield txt
- go
+{-# INLINE readFile #-}
{-| Stream text to 'stdout'
Unlike 'toHandle', 'stdout' gracefully terminates on a broken output pipe.
- Note: For best performance, use @(for source (liftIO . putStr))@ instead of
- @(source >-> stdout)@ in suitable cases.
+ Note: For best performance, it might be best just to use @(for source (liftIO . putStr))@
+ instead of @(source >-> stdout)@ .
-}
stdout :: MonadIO m => Consumer' Text m ()
stdout = go
Right () -> go
{-# INLINABLE stdout #-}
-stdoutLn :: (MonadIO m) => Consumer' Text m ()
-stdoutLn = go
- where
- go = do
- str <- await
- x <- liftIO $ try (T.putStrLn str)
- case x of
- Left (G.IOError { G.ioe_type = G.ResourceVanished
- , G.ioe_errno = Just ioe })
- | Errno ioe == ePIPE
- -> return ()
- Left e -> liftIO (throwIO e)
- Right () -> go
-{-# INLINABLE stdoutLn #-}
{-| Convert a text stream into a 'Handle'
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 :: (MonadSafe m) => FilePath -> Consumer' Text m ()
writeFile file = Safe.withFile file IO.WriteMode toHandle
+{-# INLINE writeFile #-}
+
+
+type Lens' a b = forall f . Functor f => (b -> f b) -> (a -> f a)
+
+type Iso' a b = forall f p . (Functor f, Profunctor p) => p b (f b) -> p a (f a)
+
+(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b
+a ^. lens = getConstant (lens Constant a)
+
-- | Apply a transformation to each 'Char' in the stream
map :: (Monad m) => (Char -> Char) -> Pipe Text Text m r
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 #-}
+{-# 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,
--- here acting on a 'Text' pipe, rather as they would on a lazy text
+{-# RULES "p >-> unpack" forall p .
+ p >-> unpack = for p (\txt -> yield (T.unpack txt))
+ #-}
+
+-- | @toCaseFold@, @toLower@, @toUpper@ and @stripStart@ are standard 'Text' utilities,
+-- here acting as 'Text' pipes, rather as they would on a lazy text
toCaseFold :: Monad m => Pipe Text Text m ()
toCaseFold = P.map T.toCaseFold
{-# INLINEABLE toCaseFold #-}
+{-# 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 #-}
+{-# 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 #-}
+{-# 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
let text = T.stripStart chunk
if T.null text
then stripStart
- else cat
+ else do yield text
+ cat
{-# INLINEABLE stripStart #-}
-- | @(take n)@ only allows @n@ individual characters to pass;
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)
{-# INLINABLE toLazyM #-}
-- | Reduce the text stream using a strict left fold over characters
-fold
+foldChars
:: Monad m
=> (x -> Char -> x) -> x -> (x -> r) -> Producer Text m () -> m r
-fold step begin done = P.fold (T.foldl' step) begin done
-{-# INLINABLE fold #-}
+foldChars step begin done = P.fold (T.foldl' step) begin done
+{-# INLINABLE foldChars #-}
-- | Retrieve the first 'Char'
head :: (Monad m) => Producer Text m () -> m (Maybe Char)
Just c -> Just (min c (T.minimum txt))
{-# INLINABLE minimum #-}
+
-- | Find the first element in the stream that matches the predicate
find
:: (Monad m)
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))
{-# INLINABLE count #-}
-#if MIN_VERSION_text(0,11,4)
--- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded
--- into a Pipe of Text
-decodeUtf8
- :: Monad m
- => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
-decodeUtf8 = go TE.streamDecodeUtf8
- 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 decodeUtf8 #-}
-#endif
+
+{-| Consume the first character from a stream of 'Text'
+
+ '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 a stream of 'Text', returning 'Left' if the
+ 'Producer' is empty
+-}
+drawChar :: (Monad m) => Parser Text 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 -> Parser Text 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) => Parser Text 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@, which would consider
+ an empty 'Text' a valid bit of input.
+
+> isEndOfChars = liftM isLeft peekChar
+-}
+isEndOfChars :: (Monad m) => Parser Text m Bool
+isEndOfChars = do
+ x <- peekChar
+ return (case x of
+ Nothing -> True
+ Just _-> False )
+{-# INLINABLE isEndOfChars #-}
+
+
+{- | An improper lens into a stream of 'ByteString' expected to be UTF-8 encoded; the associated
+ stream of Text ends by returning a stream of ByteStrings beginning at the point of failure.
+ -}
+
+decodeUtf8 :: Monad m => Lens' (Producer ByteString m r)
+ (Producer Text m (Producer ByteString m r))
+decodeUtf8 k p0 = fmap (\p -> join (for p (yield . TE.encodeUtf8)))
+ (k (go B.empty PI.streamDecodeUtf8 p0)) where
+ go !carry dec0 p = do
+ x <- lift (next p)
+ case x of Left r -> return (if B.null carry
+ then return r -- all bytestring input was consumed
+ else (do yield carry -- a potentially valid fragment remains
+ return r))
+
+ Right (chunk, p') -> case dec0 chunk of
+ PI.Some text carry2 dec -> do yield text
+ go carry2 dec p'
+ PI.Other text bs -> do yield text
+ return (do yield bs -- an invalid blob remains
+ p')
+{-# INLINABLE decodeUtf8 #-}
+
-- | Splits a 'Producer' after the given number of characters
splitAt
:: (Monad m, Integral n)
=> n
- -> Producer Text m r
- -> Producer' Text m (Producer Text m r)
-splitAt = go
+ -> Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
+splitAt n0 k p0 = fmap join (k (go n0 p0))
where
go 0 p = return p
go n p = do
return (yield suffix >> p')
{-# INLINABLE splitAt #-}
--- | Split a text stream into 'FreeT'-delimited text streams of fixed size
-chunksOf
- :: (Monad m, Integral n)
- => n -> Producer Text m r -> FreeT (Producer Text m) m r
-chunksOf n p0 = PP.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'' <- splitAt n (yield txt >> p')
- 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
span
:: (Monad m)
=> (Char -> Bool)
- -> Producer Text m r
- -> Producer' Text m (Producer Text m r)
-span predicate = go
+ -> Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
+span predicate k p0 = fmap join (k (go p0))
where
go p = do
x <- lift (next p)
break
:: (Monad m)
=> (Char -> Bool)
- -> Producer Text m r
- -> Producer Text m (Producer Text m r)
+ -> Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
break predicate = span (not . predicate)
{-# INLINABLE break #-}
-{-| Split a text stream into sub-streams delimited by characters that satisfy the
- predicate
--}
-splitWith
- :: (Monad m)
- => (Char -> Bool)
- -> Producer Text m r
- -> PP.FreeT (Producer Text m) m r
-splitWith predicate 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 $ do
- p'' <- span (not . predicate) (yield txt >> p')
- return $ PP.FreeT (go1 p'')
- go1 p = do
- x <- nextChar p
- return $ case x of
- Left r -> PP.Pure r
- Right (_, p') -> PP.Free $ do
- p'' <- span (not . predicate) p'
- return $ PP.FreeT (go1 p'')
-{-# INLINABLE splitWith #-}
-
--- | Split a text stream using the given 'Char' as the delimiter
-split :: (Monad m)
- => Char
- -> Producer Text m r
- -> FreeT (Producer Text m) m r
-split c = splitWith (c ==)
-{-# INLINABLE split #-}
-
-{-| Group a text stream into 'FreeT'-delimited text streams using the supplied
- equality predicate
+{-| Improper lens that splits after the first group of equivalent Chars, as
+ defined by the given equivalence relation
-}
groupBy
:: (Monad m)
=> (Char -> Char -> Bool)
- -> Producer Text m r
- -> FreeT (Producer Text m) m r
-groupBy equal p0 = PP.FreeT (go p0)
- where
+ -> Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
+groupBy equals k p0 = fmap join (k ((go p0))) where
go p = do
- x <- next p
+ x <- lift (next p)
case x of
- Left r -> return (PP.Pure r)
- Right (txt, p') -> case (T.uncons txt) of
+ Left r -> return (return r)
+ Right (txt, p') -> case T.uncons txt of
Nothing -> go p'
- Just (c, _) -> do
- return $ PP.Free $ do
- p'' <- span (equal c) (yield txt >> p')
- return $ PP.FreeT (go p'')
+ Just (c, _) -> (yield txt >> p') ^. span (equals c)
{-# INLINABLE groupBy #-}
--- | 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
+-- | Improper lens that splits after the first succession of identical 'Char' s
+group :: Monad m
+ => Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
group = groupBy (==)
{-# INLINABLE group #-}
-{-| Split a text stream into 'FreeT'-delimited lines
+{-| Improper lens that splits a 'Producer' after the first word
+
+ Unlike 'words', this does not drop leading whitespace
-}
-lines
- :: (Monad m) => Producer Text m r -> FreeT (Producer Text m) m r
-lines p0 = PP.FreeT (go0 p0)
+word :: (Monad m)
+ => Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
+word k p0 = fmap join (k (to 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' <- 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')
-{-# INLINABLE lines #-}
+ to p = do
+ p' <- p^.span isSpace
+ p'^.break isSpace
+{-# INLINABLE word #-}
+line :: (Monad m)
+ => Lens' (Producer Text m r)
+ (Producer Text m (Producer Text m r))
+line = break (== '\n')
+
+{-# INLINABLE line #-}
--- | 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)
- 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')
-{-# INLINABLE words #-}
--- | Intersperse a 'Char' in between the characters of the text stream
+-- | Intersperse a 'Char' in between the characters of stream of 'Text'
intersperse
:: (Monad m) => Char -> Producer Text m r -> Producer Text m r
intersperse c = go0
go1 p'
{-# INLINABLE intersperse #-}
+
+
+-- | Improper isomorphism between a 'Producer' of 'ByteString's and 'Word8's
+packChars :: Monad m => Iso' (Producer Char m x) (Producer Text m x)
+packChars = Data.Profunctor.dimap to (fmap from)
+ where
+ -- to :: Monad m => Producer Char m x -> Producer Text m x
+ to p = PG.folds step id done (p^.PG.chunksOf defaultChunkSize)
+
+ step diffAs c = diffAs . (c:)
+
+ done diffAs = T.pack (diffAs [])
+
+ -- from :: Monad m => Producer Text m x -> Producer Char m x
+ 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 -> Pure r
+ Right (txt, p') -> Free $ do
+ p'' <- (yield txt >> p') ^. splitAt n
+ return $ FreeT (go p'')
+{-# INLINABLE chunksOf #-}
+
+
+{-| Split a text stream into sub-streams delimited by characters that satisfy the
+ predicate
+-}
+splitsWith
+ :: (Monad m)
+ => (Char -> Bool)
+ -> Producer Text m r
+ -> FreeT (Producer Text m) m r
+splitsWith predicate p0 = FreeT (go0 p0)
+ where
+ go0 p = do
+ x <- next p
+ case x of
+ Left r -> return (Pure r)
+ Right (txt, p') ->
+ if (T.null txt)
+ then go0 p'
+ else return $ Free $ do
+ p'' <- (yield txt >> p') ^. span (not . predicate)
+ return $ FreeT (go1 p'')
+ go1 p = do
+ x <- nextChar p
+ return $ case x of
+ Left r -> Pure r
+ Right (_, p') -> Free $ do
+ p'' <- p' ^. span (not . predicate)
+ return $ FreeT (go1 p'')
+{-# INLINABLE splitsWith #-}
+
+-- | Split a text stream using the given 'Char' as the delimiter
+splits :: (Monad m)
+ => Char
+ -> Lens' (Producer Text m r)
+ (FreeT (Producer Text m) m r)
+splits c k p =
+ fmap (PG.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 (FreeT (go p0))) where
+ go p = do x <- next p
+ case x of Left r -> return (Pure r)
+ Right (bs, p') -> case T.uncons bs of
+ Nothing -> go p'
+ Just (c, _) -> do return $ Free $ do
+ p'' <- (yield bs >> p')^.span (equals c)
+ return $ 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) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
+lines = Data.Profunctor.dimap _lines (fmap _unlines)
+ where
+ _lines p0 = FreeT (go0 p0)
+ where
+ go0 p = do
+ x <- next p
+ case x of
+ Left r -> return (Pure r)
+ Right (txt, p') ->
+ if (T.null txt)
+ then go0 p'
+ else return $ Free $ go1 (yield txt >> p')
+ go1 p = do
+ p' <- p ^. break ('\n' ==)
+ return $ FreeT $ do
+ x <- nextChar p'
+ case x of
+ Left r -> return $ Pure r
+ Right (_, p'') -> go0 p''
+ -- _unlines
+ -- :: Monad m
+ -- => FreeT (Producer Text m) m x -> Producer Text m x
+ _unlines = concats . PG.maps (<* yield (T.singleton '\n'))
+
+
+{-# INLINABLE lines #-}
+
+
+-- | Split a text stream into 'FreeT'-delimited words
+words
+ :: (Monad m) => Iso' (Producer Text m r) (FreeT (Producer Text m) m r)
+words = Data.Profunctor.dimap go (fmap _unwords)
+ where
+ go p = FreeT $ do
+ x <- next (p >-> dropWhile isSpace)
+ return $ case x of
+ Left r -> Pure r
+ Right (bs, p') -> Free $ do
+ p'' <- (yield bs >> p') ^. break isSpace
+ return (go p'')
+ _unwords = PG.intercalates (yield $ T.singleton ' ')
+
+{-# INLINABLE words #-}
+
+
{-| 'intercalate' concatenates the 'FreeT'-delimited text streams after
interspersing a text stream in between them
-}
intercalate p0 = go0
where
go0 f = do
- x <- lift (PP.runFreeT f)
+ x <- lift (runFreeT f)
case x of
- PP.Pure r -> return r
- PP.Free p -> do
+ Pure r -> return r
+ Free p -> do
f' <- p
go1 f'
go1 f = do
- x <- lift (PP.runFreeT f)
+ x <- lift (runFreeT f)
case x of
- PP.Pure r -> return r
- PP.Free p -> do
+ Pure r -> return r
+ Free p -> do
p0
f' <- p
go1 f'
unlines = go
where
go f = do
- x <- lift (PP.runFreeT f)
+ x <- lift (runFreeT f)
case x of
- PP.Pure r -> return r
- PP.Free p -> do
+ Pure r -> return r
+ Free p -> do
f' <- p
yield $ T.singleton '\n'
go f'
-}
unwords
:: (Monad m) => FreeT (Producer Text m) m r -> Producer Text m r
-unwords = intercalate (yield $ T.pack " ")
+unwords = intercalate (yield $ T.singleton ' ')
{-# INLINABLE unwords #-}
{- $parse
-}
{- $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).
--}
\ No newline at end of file
+ @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym.
+-}
+
+{- | Use a 'Codec' as a pipes-style 'Lens' into a byte stream; the available 'Codec' s are
+ 'utf8', 'utf16_le', 'utf16_be', 'utf32_le', 'utf32_be' . The 'Codec' concept and the
+ individual 'Codec' definitions follow the enumerator and conduit libraries.
+
+ Utf8 is handled differently in this library -- without the use of 'unsafePerformIO' &co
+ to catch 'Text' exceptions; but the same 'mypipe ^. codec utf8' interface can be used.
+ 'mypipe ^. decodeUtf8' should be the same, but has a somewhat more direct and thus perhaps
+ better implementation.
+
+ -}
+codec :: Monad m => Codec -> Lens' (Producer ByteString m r) (Producer Text m (Producer ByteString m r))
+codec (Codec _ enc dec) k p0 = fmap (\p -> join (for p (yield . fst . enc)))
+ (k (decoder (dec B.empty) p0) ) where
+ decoder :: Monad m => PI.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r)
+ decoder !d p0 = case d of
+ PI.Other txt bad -> do yield txt
+ return (do yield bad
+ p0)
+ PI.Some txt extra dec -> do yield txt
+ x <- lift (next p0)
+ case x of Left r -> return (do yield extra
+ return r)
+ Right (chunk,p1) -> decoder (dec chunk) p1
+
+{- | ascii and latin encodings only represent a small fragment of 'Text'; thus we cannot
+ use the pipes 'Lens' style to work with them. Rather we simply define functions
+ each way.
+
+ 'encodeAscii' : Reduce as much of your stream of 'Text' actually is ascii to a byte stream,
+ returning the rest of the 'Text' at the first non-ascii 'Char'
+-}
+encodeAscii :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
+encodeAscii = go where
+ go p = do echunk <- lift (next p)
+ case echunk of
+ Left r -> return (return r)
+ Right (chunk, p') ->
+ if T.null chunk
+ then go p'
+ else let (safe, unsafe) = T.span (\c -> ord c <= 0x7F) chunk
+ in do yield (B8.pack (T.unpack safe))
+ if T.null unsafe
+ then go p'
+ else return $ do yield unsafe
+ p'
+{- | Reduce as much of your stream of 'Text' actually is iso8859 or latin1 to a byte stream,
+ returning the rest of the 'Text' upon hitting any non-latin 'Char'
+ -}
+encodeIso8859_1 :: Monad m => Producer Text m r -> Producer ByteString m (Producer Text m r)
+encodeIso8859_1 = go where
+ go p = do etxt <- lift (next p)
+ case etxt of
+ Left r -> return (return r)
+ Right (txt, p') ->
+ if T.null txt
+ then go p'
+ else let (safe, unsafe) = T.span (\c -> ord c <= 0xFF) txt
+ in do yield (B8.pack (T.unpack safe))
+ if T.null unsafe
+ then go p'
+ else return $ do yield unsafe
+ p'
+
+{- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
+ unused 'ByteString' upon hitting an un-ascii byte.
+ -}
+decodeAscii :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
+decodeAscii = go where
+ go p = do echunk <- lift (next p)
+ case echunk of
+ Left r -> return (return r)
+ Right (chunk, p') ->
+ if B.null chunk
+ then go p'
+ else let (safe, unsafe) = B.span (<= 0x7F) chunk
+ in do yield (T.pack (B8.unpack safe))
+ if B.null unsafe
+ then go p'
+ else return $ do yield unsafe
+ p'
+
+{- | Reduce a byte stream to a corresponding stream of ascii chars, returning the
+ unused 'ByteString' upon hitting the rare un-latinizable byte.
+ -}
+decodeIso8859_1 :: Monad m => Producer ByteString m r -> Producer Text m (Producer ByteString m r)
+decodeIso8859_1 = go where
+ go p = do echunk <- lift (next p)
+ case echunk of
+ Left r -> return (return r)
+ Right (chunk, p') ->
+ if B.null chunk
+ then go p'
+ else let (safe, unsafe) = B.span (<= 0xFF) chunk
+ in do yield (T.pack (B8.unpack safe))
+ if B.null unsafe
+ then go p'
+ else return $ do yield unsafe
+ p'
+
+
+
+
+
\ No newline at end of file