X-Git-Url: https://git.immae.eu/?a=blobdiff_plain;ds=sidebyside;f=Pipes%2FText.hs;h=d5b93f1e4351f8a445fe9e7fbcccd0c86dc94a3d;hb=e7ad36437caf83c4c25296542764bc4b1c819e24;hp=74576e8e92225985e9a2af2ef13bdf286fbdcad3;hpb=9e9bb0ce4c803486a724b10ad1bc3a76770b5a9f;p=github%2Ffretlink%2Ftext-pipes.git diff --git a/Pipes/Text.hs b/Pipes/Text.hs index 74576e8..d5b93f1 100644 --- a/Pipes/Text.hs +++ b/Pipes/Text.hs @@ -1,78 +1,98 @@ -{-# 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 - 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, one can use 'fromHandle' or 'toHandle'. For - example, the following program copies a document from one file to another: - -> import Pipes -> import qualified Data.Text.Pipes as Text -> import System.IO -> -> main = -> withFile "inFile.txt" ReadMode $ \hIn -> -> withFile "outFile.txt" WriteMode $ \hOut -> -> runEffect $ Text.fromHandle hIn >-> Text.toHandle hOut - -To stream from files, the following is perhaps more Prelude-like (note that it uses Pipes.Safe): - -> import Pipes -> import qualified Data.Text.Pipes as Text -> import Pipes.Safe -> -> main = runSafeT $ runEffect $ Text.readFile "inFile.txt" >-> Text.writeFile "outFile.txt" - - You can stream to and from 'stdin' and 'stdout' using the predefined 'stdin' - and 'stdout' proxies, as with the following \"echo\" program: - -> main = runEffect $ Text.stdin >-> Text.stdout - - You can also translate pure lazy 'TL.Text's to and from proxies: - -> main = runEffect $ Text.fromLazy (TL.pack "Hello, world!\n") >-> Text.stdout +{-# LANGUAGE RankNTypes, TypeFamilies, BangPatterns, Trustworthy #-} + +{-| This package provides @pipes@ utilities for \'text streams\', which are + streams of 'Text' chunks. The individual chunks are uniformly @strict@, and you + will generally want @Data.Text@ in scope. But the type @Producer Text m r@ is + in some ways the pipes equivalent of the lazy @Text@ type. + + This module provides many functions equivalent in one way or another to + the 'pure' functions in + . + They transform, divide, group and fold text streams. Though @Producer Text m r@ + is \'effectful\' Text, functions + in this module are \'pure\' in the sense that they are uniformly monad-independent. + Simple IO operations are defined in @Pipes.Text.IO@ -- as lazy IO @Text@ + operations are in @Data.Text.Lazy.IO@. Interoperation with @ByteString@ + is provided in @Pipes.Text.Encoding@, which parallels @Data.Text.Lazy.Encoding@. + + The Text type exported by @Data.Text.Lazy@ is basically '[Text]'. The implementation + is arranged so that the individual strict 'Text' chunks are kept to a reasonable size; + the user is not aware of the divisions between the connected 'Text' chunks. + So also here: the functions in this module 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, the objective is + that they should /never concatenate texts/ in order to provide strict upper + bounds on memory usage. - In addition, this module provides many functions equivalent to lazy - 'Text' functions so that you can transform or fold text streams. For - example, to stream only the first three lines of 'stdin' to 'stdout' you + For example, to stream only the first three lines of 'stdin' to 'stdout' you might write: > import Pipes > import qualified Pipes.Text as Text -> import qualified Pipes.Parse as Parse -> +> import qualified Pipes.Text.IO as Text +> import Pipes.Group +> import Lens.Family +> > main = runEffect $ takeLines 3 Text.stdin >-> Text.stdout -> where -> takeLines n = Text.unlines . Parse.takeFree n . Text.lines +> where +> takeLines n = Text.unlines . takes' n . view Text.lines +> -- or equivalently: +> -- takeLines n = over Text.lines (takes' n) The above program will never bring more than one chunk of text (~ 32 KB) into memory, no matter how long the lines are. + + As this example shows, one superficial difference from @Data.Text.Lazy@ + is that many of the operations, like 'lines', + are \'lensified\'; this has a number of advantages where it is possible, in particular + it facilitates their use with 'Parser's of Text (in the general + + sense.) + Each such expression, e.g. 'lines', 'chunksOf' or 'splitAt', reduces to the + intuitively corresponding function when used with @view@ or @(^.)@. + + A more important difference the example reveals is in the types closely associated with + the central type, @Producer Text m r@. In @Data.Text@ and @Data.Text.Lazy@ + we find functions like + +> splitAt :: Int -> Text -> (Text, Text) +> lines :: Int -> Text -> [Text] +> chunksOf :: Int -> Text -> [Text] + + which relate a Text with a pair or list of Texts. The corresponding functions here (taking + account of \'lensification\') are + +> view . splitAt :: (Monad m, Integral n) +> => n -> Producer Text m r -> Producer Text.Text m (Producer Text.Text m r) +> view lines :: Monad m => Producer Text m r -> FreeT (Producer Text m) m r +> view . chunksOf :: (Monad m, Integral n) => n -> Producer Text m r -> FreeT (Producer Text m) m r + + In the type @Producer Text m (Producer Text m r)@ the second + element of the \'pair\' of of \'effectful Texts\' cannot simply be retrieved + with 'snd'. This is an \'effectful\' pair, and one must work through the effects + of the first element to arrive at the second. Similarly in @FreeT (Producer Text m) m r@, + which corresponds with @[Text]@, on cannot simply drop 10 Producers and take the others; + we can only get to the ones we want to take by working through their predecessors. + + Some of the types may be more readable if you imagine that we have introduced + our own type synonyms + +> type Text m r = Producer T.Text m r +> type Texts m r = FreeT (Producer T.Text m) m r + + Then we would think of the types above as + +> view . splitAt :: (Monad m, Integral n) => n -> Text m r -> Text m (Text m r) +> view lines :: (Monad m) => Text m r -> Texts m r +> view . chunksOf :: (Monad m, Integral n) => n -> Text m r -> Texts m r + + which brings one closer to the types of the similar functions in @Data.Text.Lazy@ - 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, /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 - - -- * Consumers - , stdout - , stdoutLn - , toHandle - , writeFile + fromLazy -- * Pipes , map @@ -83,7 +103,6 @@ module Pipes.Text ( , dropWhile , filter , scan - , encodeUtf8 , pack , unpack , toCaseFold @@ -108,7 +127,6 @@ module Pipes.Text ( , count -- * Primitive Character Parsers - -- $parse , nextChar , drawChar , unDrawChar @@ -123,19 +141,16 @@ module Pipes.Text ( , group , word , line - , decodeUtf8 - , decode -- * FreeT Splitters , chunksOf , splitsWith - , split --- , groupsBy --- , groups + , splits + , groupsBy + , groups , lines , words - -- * Transformations , intersperse , packChars @@ -145,52 +160,33 @@ module Pipes.Text ( , unlines , unwords - -- * Re-exports + -- * Re-exports -- $reexports , module Data.ByteString , module Data.Text , module Data.Profunctor - , module Data.Word , module Pipes.Parse + , module Pipes.Group ) where -import Control.Exception (throwIO, try) -import Control.Monad (liftM, unless, join) +import Control.Applicative ((<*)) +import Control.Monad (liftM, 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.Text.Lazy.Internal (foldrChunks, defaultChunkSize) -import Data.ByteString.Unsafe (unsafeTake, unsafeDrop) import Data.ByteString (ByteString) -import qualified Data.ByteString as B -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 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 Pipes.Group (concats, intercalates, FreeT(..), FreeF(..)) +import qualified Pipes.Group as PG import qualified Pipes.Parse as PP -import Pipes.Parse (Parser, concats, intercalates, FreeT(..)) -import qualified Pipes.Safe.Prelude as Safe -import qualified Pipes.Safe as Safe -import Pipes.Safe (MonadSafe(..), Base(..)) +import Pipes.Parse (Parser) import qualified Pipes.Prelude as P -import qualified System.IO as IO import Data.Char (isSpace) import Data.Word (Word8) @@ -228,111 +224,6 @@ fromLazy :: (Monad m) => TL.Text -> Producer' Text m () fromLazy = foldrChunks (\e a -> yield e >> a) (return ()) {-# INLINE fromLazy #-} --- | Stream text from 'stdin' -stdin :: MonadIO m => Producer Text m () -stdin = fromHandle IO.stdin -{-# INLINE stdin #-} - -{-| Convert a 'IO.Handle' into a text stream using a text size - 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 -{-# INLINABLE fromHandle#-} - - -{-| 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 => FilePath -> Producer Text m () -readFile file = Safe.withFile file IO.ReadMode fromHandle -{-# INLINE 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 -{-# INLINABLE stdinLn #-} - -{-| 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. --} -stdout :: MonadIO m => Consumer' Text m () -stdout = go - where - go = do - txt <- await - x <- liftIO $ try (T.putStr txt) - 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 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' - - Note: again, for best performance, where possible use - @(for source (liftIO . hPutStr handle))@ instead of @(source >-> toHandle handle)@. --} -toHandle :: MonadIO m => IO.Handle -> Consumer' Text m r -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) => 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) @@ -361,16 +252,6 @@ concatMap f = P.map (T.concatMap 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; @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 @@ -390,8 +271,8 @@ unpack = for cat (\t -> yield (T.unpack t)) 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@, @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 #-} @@ -426,7 +307,8 @@ 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; @@ -499,13 +381,15 @@ filter predicate = P.map (T.filter predicate) scan :: (Monad m) => (Char -> Char -> Char) -> Char -> Pipe Text Text m r -scan step begin = go begin +scan step begin = do + yield (T.singleton begin) + go begin where go c = do txt <- await let txt' = T.scanl step c txt c' = T.last txt' - yield txt' + yield (T.tail txt') go c' {-# INLINABLE scan #-} @@ -603,7 +487,6 @@ minimum = P.fold step Nothing id Just c -> Just (min c (T.minimum txt)) {-# INLINABLE minimum #-} - -- | Find the first element in the stream that matches the predicate find :: (Monad m) @@ -625,12 +508,12 @@ count c p = P.fold (+) 0 id (p >-> P.map (fromIntegral . T.count c)) {-# INLINABLE count #-} -{-| Consume the first character from a stream of 'Text' +-- | 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'. - '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 @@ -646,9 +529,8 @@ nextChar = go 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 --} +-- | 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 @@ -675,7 +557,9 @@ unDrawChar c = modify (yield (T.singleton c) >>) > Left _ -> return () > Right c -> unDrawChar c > return x + -} + peekChar :: (Monad m) => Parser Text m (Maybe Char) peekChar = do x <- drawChar @@ -702,32 +586,6 @@ isEndOfChars = do {-# INLINABLE isEndOfChars #-} - - - --- | Transform a Pipe of 'ByteString's expected to be UTF-8 encoded into a Pipe of Text --- returning a Pipe of ByteStrings that begins 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 PE.streamDecodeUtf8 p0)) where - go !carry dec0 p = do - x <- lift (next p) - case x of Left r -> if B.null carry - then return (return r) -- all bytestrinput was consumed - else return (do yield carry -- a potentially valid fragment remains - return r) - - Right (chunk, p') -> case dec0 chunk of - PE.Some text carry2 dec -> do yield text - go carry2 dec p' - PE.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) @@ -753,25 +611,11 @@ 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 --} +-- | Split a text stream in two, producing the longest +-- consecutive group of characters that satisfies the predicate +-- and returning the rest + span :: (Monad m) => (Char -> Bool) @@ -794,7 +638,7 @@ span predicate k p0 = fmap join (k (go p0)) return (yield suffix >> p') {-# INLINABLE span #-} -{-| Split a text stream in two, where the first text stream is the longest +{-| Split a text stream in two, producing the longest consecutive group of characters that don't satisfy the predicate -} break @@ -882,7 +726,7 @@ 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 = PP.folds step id done (p^.PP.chunksOf defaultChunkSize) + to p = PG.folds step id done (p^.PG.chunksOf defaultChunkSize) step diffAs c = diffAs . (c:) @@ -892,6 +736,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 -> 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 -} @@ -899,80 +761,113 @@ splitsWith :: (Monad m) => (Char -> Bool) -> Producer Text m r - -> PP.FreeT (Producer Text m) m r -splitsWith predicate p0 = PP.FreeT (go0 p0) + -> 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 (PP.Pure r) + Left r -> return (Pure r) Right (txt, p') -> if (T.null txt) then go0 p' - else return $ PP.Free $ do + else return $ Free $ do p'' <- (yield txt >> p') ^. span (not . predicate) - return $ PP.FreeT (go1 p'') + return $ FreeT (go1 p'') go1 p = do x <- nextChar p return $ case x of - Left r -> PP.Pure r - Right (_, p') -> PP.Free $ do + Left r -> Pure r + Right (_, p') -> Free $ do p'' <- p' ^. span (not . predicate) - return $ PP.FreeT (go1 p'') + return $ FreeT (go1 p'') {-# 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 (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) => 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'' -{-# INLINABLE lines #-} + _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) => 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 + go p = FreeT $ do x <- next (p >-> dropWhile isSpace) return $ case x of - Left r -> PP.Pure r - Right (bs, p') -> PP.Free $ do + 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 -} @@ -984,17 +879,17 @@ intercalate 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' @@ -1007,10 +902,10 @@ unlines 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' @@ -1020,59 +915,15 @@ unlines = go -} 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 - The following parsing utilities are single-character analogs of the ones found - @pipes-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). + @Pipes.Parse@ re-exports 'input', 'concat', 'FreeT' (the type) and the 'Parse' synonym. -} - -decode :: Monad m => PE.Decoding -> Producer ByteString m r -> Producer Text m (Producer ByteString m r) --- decode codec = go B.empty where --- go extra p0 = --- do x <- lift (next p0) --- case x of Right (chunk, p) -> --- do let (text, stuff) = codecDecode codec (B.append extra chunk) --- yield text --- case stuff of Right extra' -> go extra' p --- Left (exc,bs) -> do yield text --- return (do yield bs --- p) --- Left r -> return (do yield extra --- return r) - -decode d p0 = case d of - PE.Other txt bad -> do yield txt - return (do yield bad - p0) - PE.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) -> decode (dec chunk) p1 - --- go !carry dec0 p = do --- x <- lift (next p) --- case x of Left r -> if B.null carry --- then return (return r) -- all bytestrinput was consumed --- else return (do yield carry -- a potentially valid fragment remains --- return r) --- --- Right (chunk, p') -> case dec0 chunk of --- PE.Some text carry2 dec -> do yield text --- go carry2 dec p' --- PE.Other text bs -> do yield text --- return (do yield bs -- an invalid blob remains --- p') --- {-# INLINABLE decodeUtf8 #-}