-- Module      : Foundation.Conduit.Internal
-- License     : BSD-style
-- Maintainer  : Foundation
-- Stability   : experimental
-- Portability : portable
--
-- Taken from the conduit package almost verbatim, and
-- Copyright (c) 2012 Michael Snoyman
--
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}
module Foundation.Conduit.Internal
    ( Pipe(..)
    , Conduit(..)
    , ZipSink(..)
    , ResourceT(..)
    , MonadResource(..)
    , runResourceT
    , await
    , awaitForever
    , yield
    , yieldOr
    , leftover
    , runConduit
    , runConduitRes
    , runConduitPure
    , fuse
    , bracketConduit
    ) where

import Basement.Imports hiding (throw)
import Foundation.Monad
import Foundation.Numerical
import Basement.Monad
import Control.Monad ((>=>), liftM, void, mapM_, join)
import Control.Exception (SomeException, mask_)
import Data.IORef (atomicModifyIORef)

-- | A pipe producing and consuming values
--
-- A basic intuition is that every @Pipe@ produces a stream of /output/ values
-- and eventually indicates that this stream is terminated by sending a
-- /result/. On the receiving end of a @Pipe@, these become the /input/ and /upstream/
-- parameters.
data Pipe leftOver input output upstream monad result =
      -- | Provide new output to be sent downstream. This constructor has three
      -- fields: the next @Pipe@ to be used, a finalization function, and the
      -- output value.
      Yield (Pipe leftOver input output upstream monad result) (monad ()) output
      -- | Request more input from upstream. The first field takes a new input
      -- value and provides a new @Pipe@. The second takes an upstream result
      -- value, which indicates that upstream is producing no more results.
    | Await (input -> Pipe leftOver input output upstream monad result)
                (upstream -> Pipe leftOver input output upstream monad result)
      -- | Processing with this @Pipe@ is complete, providing the final result.
    | Done result
      -- | Require running of a monadic action to get the next @Pipe@.
    | PipeM (monad (Pipe leftOver input output upstream monad result))
      -- | Return leftover input, which should be provided to future operations.
    | Leftover (Pipe leftOver input output upstream monad result) leftOver

instance Applicative m => Functor (Pipe l i o u m) where
    fmap = (<$>)
    {-# INLINE fmap #-}

instance Applicative m => Applicative (Pipe l i o u m) where
    pure = Done
    {-# INLINE pure #-}

    Yield p c o  <*> fa = Yield (p <*> fa) c o
    Await p c    <*> fa = Await (\i -> p i <*> fa) (\o -> c o <*> fa)
    Done r       <*> fa = r <$> fa
    PipeM mp     <*> fa = PipeM ((<*> fa) <$> mp)
    Leftover p i <*> fa = Leftover (p <*> fa) i
    {-# INLINE (<*>) #-}

instance (Functor m, Monad m) => Monad (Pipe l i o u m) where
    return = Done
    {-# INLINE return #-}

    Yield p c o  >>= fp = Yield    (p >>= fp)            c          o
    Await p c    >>= fp = Await    (p >=> fp)            (c >=> fp)
    Done x       >>= fp = fp x
    PipeM mp     >>= fp = PipeM    ((>>= fp) <$> mp)
    Leftover p i >>= fp = Leftover (p >>= fp)            i

-- | A component of a conduit pipeline, which takes a stream of
-- @input@, produces a stream of @output@, performs actions in the
-- underlying @monad@, and produces a value of @result@ when no more
-- output data is available.
newtype Conduit input output monad result = Conduit
    { unConduit :: forall a .  (result -> Pipe input input output () monad a) -> Pipe input input output () monad a
    }

instance Functor (Conduit i o m) where
    fmap f (Conduit c) = Conduit $ \resPipe -> c (resPipe . f)

instance Applicative (Conduit i o m) where
    pure x = Conduit ($ x)
    {-# INLINE pure #-}

    fab <*> fa = fab >>= \ab -> fa >>= \a -> pure (ab a)
    {-# INLINE (<*>) #-}

instance Monad (Conduit i o m) where
    return = pure
    Conduit f >>= g = Conduit $ \h -> f $ \a -> unConduit (g a) h

instance MonadTrans (Conduit i o) where
    lift m = Conduit $ \rest -> PipeM $ liftM rest m

instance MonadIO m => MonadIO (Conduit i o m) where
    liftIO = lift . liftIO

instance MonadFailure m => MonadFailure (Conduit i o m) where
    type Failure (Conduit i o m) = Failure m
    mFail = lift . mFail

instance MonadThrow m => MonadThrow (Conduit i o m) where
    throw = lift . throw

instance MonadCatch m => MonadCatch (Conduit i o m) where
    catch (Conduit c0) onExc = Conduit $ \rest -> let
        go (PipeM m) =
            PipeM $ catch (liftM go m) (return . flip unConduit rest . onExc)
        go (Done r) = rest r
        go (Await p c) = Await (go . p) (go . c)
        go (Yield p m o) = Yield (go p) m o
        go (Leftover p i) = Leftover (go p) i

        in go (c0 Done)

-- | Await for a value from upstream.
await :: Conduit i o m (Maybe i)<