{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Conduit.Internal.Fusion
    ( -- ** Types
      Step (..)
    , Stream (..)
    , ConduitWithStream
    , StreamConduitT
    , StreamConduit
    , StreamSource
    , StreamProducer
    , StreamSink
    , StreamConsumer
      -- ** Functions
    , streamConduit
    , streamSource
    , streamSourcePure
    , unstream
    ) where

import Data.Conduit.Internal.Conduit
import Data.Conduit.Internal.Pipe (Pipe (..))
import Data.Functor.Identity (Identity (runIdentity))
import Data.Void (Void, absurd)
import Control.Monad.Trans.Resource (runResourceT)

-- | This is the same as stream fusion\'s Step. Constructors are renamed to
-- avoid confusion with conduit names.
data Step s o r
    = Emit s o
    | Skip s
    | Stop r
    deriving (forall a b. (a -> b) -> Step s o a -> Step s o b)
-> (forall a b. a -> Step s o b -> Step s o a)
-> Functor (Step s o)
forall a b. a -> Step s o b -> Step s o a
forall a b. (a -> b) -> Step s o a -> Step s o b
forall s o a b. a -> Step s o b -> Step s o a
forall s o a b. (a -> b) -> Step s o a -> Step s o b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Step s o b -> Step s o a
$c<$ :: forall s o a b. a -> Step s o b -> Step s o a
fmap :: forall a b. (a -> b) -> Step s o a -> Step s o b
$cfmap :: forall s o a b. (a -> b) -> Step s o a -> Step s o b
Functor

data Stream m o r = forall s. Stream
    (s -> m (Step s o r))
    (m s)

data ConduitWithStream i o m r = ConduitWithStream
    (ConduitT i o m r)
    (StreamConduitT i o m r)

type StreamConduitT i o m r = Stream m i () -> Stream m o r

type StreamConduit i m o = StreamConduitT i o m ()

type StreamSource m o = StreamConduitT () o m ()

type StreamProducer m o = forall i. StreamConduitT i o m ()

type StreamSink i m r = StreamConduitT i Void m r

type StreamConsumer i m r = forall o. StreamConduitT i o m r

unstream :: ConduitWithStream i o m r -> ConduitT i o m r
unstream :: forall i o (m :: * -> *) r.
ConduitWithStream i o m r -> ConduitT i o m r
unstream (ConduitWithStream ConduitT i o m r
c StreamConduitT i o m r
_) = ConduitT i o m r
c
{-# INLINE [0] unstream #-}

fuseStream :: Monad m
           => ConduitWithStream a b m ()
           -> ConduitWithStream b c m r
           -> ConduitWithStream a c m r
fuseStream :: forall (m :: * -> *) a b c r.
Monad m =>
ConduitWithStream a b m ()
-> ConduitWithStream b c m r -> ConduitWithStream a c m r
fuseStream (ConduitWithStream ConduitT a b m ()
a StreamConduitT a b m ()
x) (ConduitWithStream ConduitT b c m r
b StreamConduitT b c m r
y) =
  ConduitT a c m r
-> StreamConduitT a c m r -> ConduitWithStream a c m r
forall i o (m :: * -> *) r.
ConduitT i o m r
-> StreamConduitT i o m r -> ConduitWithStream i o m r
ConduitWithStream (ConduitT a b m ()
a ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT b c m r
b) (StreamConduitT b c m r
y StreamConduitT b c m r
-> StreamConduitT a b m () -> StreamConduitT a c m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamConduitT a b m ()
x)
{-# INLINE fuseStream #-}

{-# RULES "conduit: fuseStream (.|)" forall left right.
        unstream left .| unstream right = unstream (fuseStream left right)
  #-}
{-# RULES "conduit: fuseStream (fuse)" forall left right.
        fuse (unstream left) (unstream right) = unstream (fuseStream left right)
  #-}
{-# RULES "conduit: fuseStream (=$=)" forall left right.
        unstream left =$= unstream right = unstream (fuseStream left right)
  #-}

runStream :: Monad m
          => ConduitWithStream () Void m r
          -> m r
runStream :: forall (m :: * -> *) r.
Monad m =>
ConduitWithStream () Void m r -> m r
runStream (ConduitWithStream ConduitT () Void m r
_ StreamConduitT () Void m r
f) =
    Stream m Void r -> m r
forall {m :: * -> *} {r}. Monad m => Stream m Void r -> m r
run (Stream m Void r -> m r) -> Stream m Void r -> m r
forall a b. (a -> b) -> a -> b
$ StreamConduitT () Void m r
f StreamConduitT () Void m r -> StreamConduitT () Void m r
forall a b. (a -> b) -> a -> b
$ (() -> m (Step () () ())) -> m () -> Stream m () ()
forall (m :: * -> *) o r s.
(s -> m (Step s o r)) -> m s -> Stream m o r
Stream () -> m (Step () () ())
forall {m :: * -> *} {p} {s} {o}. Monad m => p -> m (Step s o ())
emptyStep (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  where
    emptyStep :: p -> m (Step s o ())
emptyStep p
_ = Step s o () -> m (Step s o ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s o () -> m (Step s o ())) -> Step s o () -> m (Step s o ())
forall a b. (a -> b) -> a -> b
$ () -> Step s o ()
forall s o r. r -> Step s o r
Stop ()
    run :: Stream m Void r -> m r
run (Stream s -> m (Step s Void r)
step m s
ms0) =
        m s
ms0 m s -> (s -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m r
loop
      where
        loop :: s -> m r
loop s