{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ViewPatterns #-}
module Pipes.Transduce.Text (
intoLazyText
, asUtf8
, asUtf8x
, bothAsUtf8x
, Line
, asFoldedLines
, eachLine
, combinedLines
, combinedLinesPrefixing
, decoder
, decoderx
, utf8
, utf8x
, lines
, lines_
, foldedLines
) where
import Prelude hiding (lines)
import Data.Bifunctor
import Data.ByteString
import qualified Data.Text
import qualified Data.Text.Lazy
import Data.Text hiding (lines)
import Data.Text.Encoding.Error (UnicodeException(..))
import qualified Control.Foldl as Foldl
import Control.Exception
import Control.Applicative
import Control.Applicative.Lift
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
import Pipes
import qualified Pipes.Text
import Pipes.Text.Encoding (decodeUtf8)
import Pipes.Transduce.Internal
type Line = Data.Text.Lazy.Text
foldedLines
:: Transducer Continuous Text e Line
foldedLines =
folds
(fmap Data.Text.Lazy.fromChunks (withFold Foldl.list))
(lines_ (mapper id))
asFoldedLines :: Fold1 Line e r -> Fold1 Text e r
asFoldedLines = transduce1 foldedLines
eachLine :: (Line -> IO (Either e ())) -> Fold1 Data.Text.Text e ()
eachLine action = transduce1 foldedLines (withFallibleConsumer (forever (do
await >>= lift . ExceptT . action)))
combinedLines :: Fold1 Text e r -> Fold2 Text Text e r
combinedLines =
combined (Pipes.Transduce.Text.lines (transducer id))
(Pipes.Transduce.Text.lines (transducer id))
combinedLinesPrefixing :: Text -> Text -> Fold1 Text e r -> Fold2 Text Text e r
combinedLinesPrefixing outprefix errprefix =
let tag prefix = groups (\producer -> Pipes.yield prefix *> producer)
in
combined (tag outprefix (Pipes.Transduce.Text.lines (transducer id)))
(tag errprefix (Pipes.Transduce.Text.lines (transducer id)))
lines_
:: Transducer Continuous a e Text
-> Transducer Delimited a e Text
lines_ sometrans = delimit (view Pipes.Text.lines) sometrans
lines
:: Transducer Continuous a e Text
-> Transducer Delimited a e Text
lines = groups (\p -> p <* Pipes.yield (Data.Text.singleton '\n')) . lines_
decoder
:: (forall r. Producer ByteString IO r -> Producer Text IO (Producer ByteString IO r))
-> Transducer Continuous ByteString ByteString Text
decoder f = fallibleTransducer (\producer -> f producer >>= \producer' -> lift (do
n <- next producer'
case n of
Left r -> return (Right r)
Right b -> return (Left (fst b))))
decoderx
:: (forall r. Producer ByteString IO r -> Producer Text IO (Producer ByteString IO r))
-> Transducer Continuous ByteString e Text
decoderx f = transducer (\producer -> f producer >>= \producer' -> lift (do
n <- next producer'
case n of
Left r -> return r
Right b -> throwIO (DecodeError "transducer decoding error" (Just (Data.ByteString.head (fst b))))))
decoderx'
:: (forall r. Producer ByteString IO r -> Producer Text IO (Producer ByteString IO r))
-> Producer ByteString IO x -> Producer Text IO x
decoderx' f = (\producer -> f producer >>= \producer' -> lift (do
n <- next producer'
case n of
Left r -> return r
Right b -> throwIO (DecodeError "transducer decoding error" (Just (Data.ByteString.head (fst b))))))
utf8 :: Transducer Continuous ByteString ByteString Text
utf8 = decoder decodeUtf8
utf8x :: Transducer Continuous ByteString e Text
utf8x = decoderx decodeUtf8
asUtf8 :: (ByteString -> e) -> Fold1 Text e r -> Fold1 ByteString e r
asUtf8 erradapt = transduce1 (first erradapt utf8)
asUtf8x :: Fold1 Text e r -> Fold1 ByteString e r
asUtf8x = transduce1 utf8x
bothAsUtf8x :: Fold2 Text Text e r -> Fold2 ByteString ByteString e r
bothAsUtf8x (Fold2 (unLift -> f)) = case f of
First f1 -> Fold2 (Other (First $ unwrap (trans f1)))
Second f1 -> Fold2 (Other (Second $ unwrap (trans f1)))
Both both -> Fold2 (Other (Both $ \f1 f2 -> both (dec f1) (dec f2)))
where
dec = decoderx' decodeUtf8
trans = transduce1 (transducer dec) . Fold1 . Other
unwrap (Fold1 z) = unLift z
intoLazyText :: Fold1 Text e Data.Text.Lazy.Text
intoLazyText = fmap Data.Text.Lazy.fromChunks (withFold Foldl.list)
type Getting r s a = (a -> Const r a) -> s -> Const r s
view :: Getting a s a -> s -> a
view l s = getConst (l Const s)
{-# INLINE view #-}