module Data.Conduit
(
module Data.Conduit.Types.Source
, module Data.Conduit.Types.Sink
, module Data.Conduit.Types.Conduit
,
($$)
, ($=)
, (=$)
, (=$=)
, module Data.Conduit.Util.Source
, module Data.Conduit.Util.Sink
, module Data.Conduit.Util.Conduit
, ResourceT
, Resource (..)
, ResourceIO
, ResourceUnsafeIO
, runResourceT
, ResourceThrow (..)
) where
import Control.Monad.Trans.Resource
import Data.Conduit.Types.Source
import Data.Conduit.Util.Source
import Data.Conduit.Types.Sink
import Data.Conduit.Util.Sink
import Data.Conduit.Types.Conduit
import Data.Conduit.Util.Conduit
infixr 0 $$
($$) :: (BufferSource bsrc, Resource m) => bsrc m a -> Sink a m b -> ResourceT m b
bs' $$ Sink msink = do
sinkI <- msink
case sinkI of
SinkNoData output -> return output
SinkData push close -> do
bs <- bufferSource bs'
connect' bs push close
where
connect' bs push close =
loop
where
loop = do
res <- bsourcePull bs
case res of
Closed -> do
res' <- close
return res'
Open a -> do
mres <- push a
case mres of
Done leftover res' -> do
maybe (return ()) (bsourceUnpull bs) leftover
bsourceClose bs
return res'
Processing -> loop
data FuseLeftState a = FLClosed [a] | FLOpen [a]
infixl 1 $=
($=) :: (Resource m, BufferSource bsrc)
=> bsrc m a
-> Conduit a m b
-> Source m b
bsrc' $= Conduit mc = Source $ do
istate <- newRef $ FLOpen []
bsrc <- bufferSource bsrc'
c <- mc
return $ PreparedSource
(pull istate bsrc c)
(close istate bsrc c)
where
pull istate bsrc c = do
state' <- readRef istate
case state' of
FLClosed [] -> return Closed
FLClosed (x:xs) -> do
writeRef istate $ FLClosed xs
return $ Open x
FLOpen (x:xs) -> do
writeRef istate $ FLOpen xs
return $ Open x
FLOpen [] -> do
mres <- bsourcePull bsrc
case mres of
Closed -> do
res <- conduitClose c
case res of
[] -> do
writeRef istate $ FLClosed []
return Closed
x:xs -> do
writeRef istate $ FLClosed xs
return $ Open x
Open input -> do
res' <- conduitPush c input
case res' of
Producing [] -> pull istate bsrc c
Producing (x:xs) -> do
writeRef istate $ FLOpen xs
return $ Open x
Finished leftover output -> do
maybe (return ()) (bsourceUnpull bsrc) leftover
bsourceClose bsrc
case output of
[] -> do
writeRef istate $ FLClosed []
return Closed
x:xs -> do
writeRef istate $ FLClosed xs
return $ Open x
close istate bsrc c = do
writeRef istate $ FLClosed []
_ignored <- conduitClose c
bsourceClose bsrc
infixr 0 =$
(=$) :: Resource m => Conduit a m b -> Sink b m c -> Sink a m c
Conduit mc =$ Sink ms = Sink $ do
s <- ms
case s of
SinkData pushI closeI -> mc >>= go pushI closeI
SinkNoData mres -> return $ SinkNoData mres
where
go pushI closeI c = do
return SinkData
{ sinkPush = \cinput -> do
res <- conduitPush c cinput
case res of
Producing sinput -> do
let push [] = return Processing
push (i:is) = do
mres <- pushI i
case mres of
Processing -> push is
Done _sleftover res' -> do
_ <- conduitClose c
return $ Done Nothing res'
push sinput
Finished cleftover sinput -> do
let push [] = closeI
push (i:is) = do
mres <- pushI i
case mres of
Processing -> push is
Done _sleftover res' -> return res'
res' <- push sinput
return $ Done cleftover res'
, sinkClose = do
sinput <- conduitClose c
let push [] = closeI
push (i:is) = do
mres <- pushI i
case mres of
Processing -> push is
Done _sleftover res' -> return res'
push sinput
}
infixr 0 =$=
(=$=) :: Resource m => Conduit a m b -> Conduit b m c -> Conduit a m c
Conduit outerM =$= Conduit innerM = Conduit $ do
outer <- outerM
inner <- innerM
return PreparedConduit
{ conduitPush = \inputO -> do
res <- conduitPush outer inputO
case res of
Producing inputI -> do
let push [] front = return $ Producing $ front []
push (i:is) front = do
resI <- conduitPush inner i
case resI of
Producing c -> push is (front . (c ++))
Finished _leftover c -> do
_ <- conduitClose outer
return $ Finished Nothing $ front c
push inputI id
Finished leftoverO inputI -> do
c <- conduitPushClose inner inputI
return $ Finished leftoverO c
, conduitClose = do
b <- conduitClose outer
c <- conduitPushClose inner b
return c
}
conduitPushClose :: Monad m => PreparedConduit a m b -> [a] -> ResourceT m [b]
conduitPushClose c [] = conduitClose c
conduitPushClose c (input:rest) = do
res <- conduitPush c input
case res of
Finished _ b -> return b
Producing b -> do
b' <- conduitPushClose c rest
return $ b ++ b'