{-# LANGUAGE CPP #-}
module Control.Effect.Type.ReaderPrim
  ( -- * Effects
    ReaderPrim(..)

    -- * Threading utilities
  , threadReaderPrim
  , threadReaderPrimViaClass
  , threadReaderPrimViaRegional
 ) where

import Control.Monad.Trans

import Control.Monad.Reader.Class (MonadReader)
import qualified Control.Monad.Reader.Class as RC
import Control.Monad.Trans.Except (ExceptT(..))

import Control.Monad.Trans.Reader (ReaderT(..))
import qualified Control.Monad.Trans.Reader as R

import qualified Control.Monad.Trans.State.Strict as SSt
import qualified Control.Monad.Trans.State.Lazy as LSt
import qualified Control.Monad.Trans.Writer.Lazy as LWr
import qualified Control.Monad.Trans.Writer.Strict as SWr
import qualified Control.Monad.Trans.Writer.CPS as CPSWr

import Control.Effect.Internal.ViaAlg
import Control.Effect.Type.Regional
import Control.Effect.Internal.Reflection
import Control.Effect.Internal.Union

-- | A primitive effect that may be used for
-- interpreters of connected 'Control.Effect.Reader.Ask' and
-- 'Control.Effect.Reader.Local' effects.
--
-- This combines 'Control.Effect.Reader.Ask' and 'Control.Effect.Reader.Local',
-- which is relevant since certain monad transformers may only lift
-- 'Control.Effect.Reader.local' if they also have access to
-- 'Control.Effect.Reader.ask'.
--
-- __'ReaderPrim' is only used as a primitive effect.__
-- If you define a 'Control.Effect.Carrier' that relies on a novel
-- non-trivial monad transformer @t@, then you need to make
-- a @'ThreadsEff' t ('ReaderPrim' i)@ instance (if possible).
-- 'threadReaderPrimViaClass' and 'threadReaderPrimViaRegional'
-- can help you with that.
--
-- The following threading constraints accept 'ReaderPrim':
--
-- * 'Control.Effect.ReaderThreads'
-- * 'Control.Effect.State.StateThreads'
-- * 'Control.Effect.State.StateLazyThreads'
-- * 'Control.Effect.Error.ErrorThreads'
-- * 'Control.Effect.Writer.WriterThreads'
-- * 'Control.Effect.Writer.WriterLazyThreads'
-- * 'Control.Effect.NonDet.NonDetThreads'
-- * 'Control.Effect.Stepped.SteppedThreads'
-- * 'Control.Effect.Cont.ContThreads'
data ReaderPrim i :: Effect where
  ReaderPrimAsk   :: ReaderPrim i m i
  ReaderPrimLocal :: (i -> i) -> m a -> ReaderPrim i m a

instance ( Reifies s (ReifiedEffAlgebra (ReaderPrim i) m)
         , Monad m
         ) => MonadReader i (ViaAlg s (ReaderPrim i) m) where
  ask :: ViaAlg s (ReaderPrim i) m i
ask = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
    ReifiedEffAlgebra forall x. ReaderPrim i m x -> m x
alg -> (ReaderPrim i m i -> m i)
-> ReaderPrim i (ViaAlg s (ReaderPrim i) m) i
-> ViaAlg s (ReaderPrim i) m i
forall (n :: * -> *) (m :: * -> *) (e :: Effect) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg ReaderPrim i m i -> m i
forall x. ReaderPrim i m x -> m x
alg ReaderPrim i (ViaAlg s (ReaderPrim i) m) i
forall i (m :: * -> *). ReaderPrim i m i
ReaderPrimAsk
  {-# INLINE ask #-}

  local :: (i -> i)
-> ViaAlg s (ReaderPrim i) m a -> ViaAlg s (ReaderPrim i) m a
local i -> i
f ViaAlg s (ReaderPrim i) m a
m = case forall a. Reifies s a => a
forall k (s :: k) a. Reifies s a => a
reflect @s of
    ReifiedEffAlgebra forall x. ReaderPrim i m x -> m x
alg -> (ReaderPrim i m a -> m a)
-> ReaderPrim i (ViaAlg s (ReaderPrim i) m) a
-> ViaAlg s (ReaderPrim i) m a
forall (n :: * -> *) (m :: * -> *) (e :: Effect) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg ReaderPrim i m a -> m a
forall x. ReaderPrim i m x -> m x
alg ((i -> i)
-> ViaAlg s (ReaderPrim i) m a
-> ReaderPrim i (ViaAlg s (ReaderPrim i) m) a
forall i (m :: * -> *) a. (i -> i) -> m a -> ReaderPrim i m a
ReaderPrimLocal i -> i
f ViaAlg s (ReaderPrim i) m a
m)
  {-# INLINE local #-}

-- | Construct a valid definition of 'threadEff' for a
-- @'ThreadsEff' t ('ReaderPrim' w)@ instance
-- only by specifying how 'ReaderPrimLocal' should be lifted.
--
-- This uses 'lift' to lift 'ReaderPrimAsk'.
threadReaderPrim :: forall i t m a
                  . (MonadTrans t, Monad m)
                 => ( (forall x. ReaderPrim i m x -> m x)
                    -> (i -> i) -> t m a -> t m a
                    )
                 -> (forall x. ReaderPrim i m x -> m x)
                 -> ReaderPrim i (t m) a -> t m a
threadReaderPrim :: ((forall x. ReaderPrim i m x -> m x) -> (i -> i) -> t m a -> t m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a
-> t m a
threadReaderPrim (forall x. ReaderPrim i m x -> m x) -> (i -> i) -> t m a -> t m a
h forall x. ReaderPrim i m x -> m x
alg = \case
  ReaderPrim i (t m) a
ReaderPrimAsk       -> m i -> t m i
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderPrim i m i -> m i
forall x. ReaderPrim i m x -> m x
alg ReaderPrim i m i
forall i (m :: * -> *). ReaderPrim i m i
ReaderPrimAsk)
  ReaderPrimLocal i -> i
f t m a
m -> (forall x. ReaderPrim i m x -> m x) -> (i -> i) -> t m a -> t m a
h forall x. ReaderPrim i m x -> m x
alg i -> i
f t m a
m
{-# INLINE threadReaderPrim #-}

-- | A valid definition of 'threadEff' for a @'ThreadsEff' t ('ReaderPrim' i)@
-- instance, given that @t@ lifts @'MonadReader' i@.
threadReaderPrimViaClass :: forall i t m a
                          . Monad m
                         => ( RepresentationalT t
                            , MonadTrans t
                            , forall b. MonadReader i b => MonadReader i (t b)
                            )
                         => (forall x. ReaderPrim i m x -> m x)
                         -> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaClass :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaClass forall x. ReaderPrim i m x -> m x
alg ReaderPrim i (t m) a
e = ReifiedEffAlgebra (ReaderPrim i) m
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ReaderPrim i) m)) =>
    pr s -> t m a)
-> t m a
forall a r.
a
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s a) =>
    pr s -> r)
-> r
reify ((forall x. ReaderPrim i m x -> m x)
-> ReifiedEffAlgebra (ReaderPrim i) m
forall k (e :: (k -> *) -> k -> *) (m :: k -> *).
(forall (x :: k). e m x -> m x) -> ReifiedEffAlgebra e m
ReifiedEffAlgebra forall x. ReaderPrim i m x -> m x
alg) ((forall s (pr :: * -> *).
  (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ReaderPrim i) m)) =>
  pr s -> t m a)
 -> t m a)
-> (forall s (pr :: * -> *).
    (pr ~ Proxy, Reifies s (ReifiedEffAlgebra (ReaderPrim i) m)) =>
    pr s -> t m a)
-> t m a
forall a b. (a -> b) -> a -> b
$ \(pr s
_ :: pr s) ->
  case ReaderPrim i (t m) a
e of
    ReaderPrim i (t m) a
ReaderPrimAsk -> m i -> t m i
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderPrim i m i -> m i
forall x. ReaderPrim i m x -> m x
alg ReaderPrim i m i
forall i (m :: * -> *). ReaderPrim i m i
ReaderPrimAsk)
    ReaderPrimLocal i -> i
f t m a
m -> t (ViaAlg s (ReaderPrim i) m) a -> t m a
forall s (e :: Effect) (t :: Effect) (m :: * -> *) a.
RepresentationalT t =>
t (ViaAlg s e m) a -> t m a
unViaAlgT ((i -> i)
-> t (ViaAlg s (ReaderPrim i) m) a
-> t (ViaAlg s (ReaderPrim i) m) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
RC.local i -> i
f (t m a -> t (ViaAlg s (ReaderPrim i) m) a
forall s (e :: Effect) (t :: Effect) (m :: * -> *) a.
RepresentationalT t =>
t m a -> t (ViaAlg s e m) a
viaAlgT @s @(ReaderPrim i) t m a
m))
{-# INLINE threadReaderPrimViaClass #-}

-- | A valid definition of 'threadEff' for a @'ThreadsEff' t ('ReaderPrim' i)@
-- instance, given that @t@ threads @'Regional' s@ for any @s@.
threadReaderPrimViaRegional :: forall i t m a
                         . ( Monad m
                           , MonadTrans t
                           , ThreadsEff t (Regional ())
                           )
                        => (forall x. ReaderPrim i m x -> m x)
                        -> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaRegional :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a -> t m a
threadReaderPrimViaRegional forall x. ReaderPrim i m x -> m x
alg ReaderPrim i (t m) a
ReaderPrimAsk = m i -> t m i
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderPrim i m i -> m i
forall x. ReaderPrim i m x -> m x
alg ReaderPrim i m i
forall i (m :: * -> *). ReaderPrim i m i
ReaderPrimAsk)
threadReaderPrimViaRegional forall x. ReaderPrim i m x -> m x
alg (ReaderPrimLocal i -> i
f t m a
m) =
  (forall x. Regional () m x -> m x) -> Regional () (t m) a -> t m a
forall (t :: Effect) (e :: Effect) (m :: * -> *) a.
(ThreadsEff t e, Monad m) =>
(forall x. e m x -> m x) -> e (t m) a -> t m a
threadEff (\(Regionally _ m') -> ReaderPrim i m x -> m x
forall x. ReaderPrim i m x -> m x
alg (ReaderPrim i m x -> m x) -> ReaderPrim i m x -> m x
forall a b. (a -> b) -> a -> b
$ (i -> i) -> m x -> ReaderPrim i m x
forall i (m :: * -> *) a. (i -> i) -> m a -> ReaderPrim i m a
ReaderPrimLocal i -> i
f m x
m') (() -> t m a -> Regional () (t m) a
forall s (m :: * -> *) a. s -> m a -> Regional s m a
Regionally () t m a
m)
{-# INLINE threadReaderPrimViaRegional #-}

#define THREAD_READER(monadT)                                 \
instance ThreadsEff (monadT) (ReaderPrim threadedInput) where \
  threadEff = threadReaderPrimViaClass;                       \
  {-# INLINE threadEff #-}

#define THREAD_READER_CTX(ctx, monadT)                               \
instance ctx => ThreadsEff (monadT) (ReaderPrim threadedInput) where \
  threadEff = threadReaderPrimViaClass;                              \
  {-# INLINE threadEff #-}

instance ThreadsEff (ReaderT i') (ReaderPrim i) where
  threadEff :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (ReaderT i' m) a -> ReaderT i' m a
threadEff = ((forall x. ReaderPrim i m x -> m x)
 -> (i -> i) -> ReaderT i' m a -> ReaderT i' m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (ReaderT i' m) a
-> ReaderT i' m a
forall i (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
((forall x. ReaderPrim i m x -> m x) -> (i -> i) -> t m a -> t m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a
-> t m a
threadReaderPrim (((forall x. ReaderPrim i m x -> m x)
  -> (i -> i) -> ReaderT i' m a -> ReaderT i' m a)
 -> (forall x. ReaderPrim i m x -> m x)
 -> ReaderPrim i (ReaderT i' m) a
 -> ReaderT i' m a)
-> ((forall x. ReaderPrim i m x -> m x)
    -> (i -> i) -> ReaderT i' m a -> ReaderT i' m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (ReaderT i' m) a
-> ReaderT i' m a
forall a b. (a -> b) -> a -> b
$ \forall x. ReaderPrim i m x -> m x
alg i -> i
f ReaderT i' m a
m ->
    (m a -> m a) -> ReaderT i' m a -> ReaderT i' m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
R.mapReaderT (ReaderPrim i m a -> m a
forall x. ReaderPrim i m x -> m x
alg (ReaderPrim i m a -> m a)
-> (m a -> ReaderPrim i m a) -> m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i) -> m a -> ReaderPrim i m a
forall i (m :: * -> *) a. (i -> i) -> m a -> ReaderPrim i m a
ReaderPrimLocal i -> i
f) ReaderT i' m a
m
  {-# INLINE threadEff #-}

instance Monoid w => ThreadsEff (CPSWr.WriterT w) (ReaderPrim i) where
  threadEff :: (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (WriterT w m) a -> WriterT w m a
threadEff = ((forall x. ReaderPrim i m x -> m x)
 -> (i -> i) -> WriterT w m a -> WriterT w m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (WriterT w m) a
-> WriterT w m a
forall i (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
((forall x. ReaderPrim i m x -> m x) -> (i -> i) -> t m a -> t m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (t m) a
-> t m a
threadReaderPrim (((forall x. ReaderPrim i m x -> m x)
  -> (i -> i) -> WriterT w m a -> WriterT w m a)
 -> (forall x. ReaderPrim i m x -> m x)
 -> ReaderPrim i (WriterT w m) a
 -> WriterT w m a)
-> ((forall x. ReaderPrim i m x -> m x)
    -> (i -> i) -> WriterT w m a -> WriterT w m a)
-> (forall x. ReaderPrim i m x -> m x)
-> ReaderPrim i (WriterT w m) a
-> WriterT w m a
forall a b. (a -> b) -> a -> b
$ \forall x. ReaderPrim i m x -> m x
alg i -> i
f WriterT w m a
m ->
    (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
CPSWr.mapWriterT (ReaderPrim i m (a, w) -> m (a, w)
forall x. ReaderPrim i m x -> m x
alg (ReaderPrim i m (a, w) -> m (a, w))
-> (m (a, w) -> ReaderPrim i m (a, w)) -> m (a, w) -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> i) -> m (a, w) -> ReaderPrim i m (a, w)
forall i (m :: * -> *) a. (i -> i) -> m a -> ReaderPrim i m a
ReaderPrimLocal i -> i
f) WriterT w m a
m
  {-# INLINE threadEff #-}

-- TODO(KingoftheHomeless): Benchmark this vs hand-written instances.
THREAD_READER(ExceptT e)
THREAD_READER(SSt.StateT s)
THREAD_READER(LSt.StateT s)
THREAD_READER_CTX(Monoid w, LWr.WriterT w)
THREAD_READER_CTX(Monoid w, SWr.WriterT w)

-- We don't thread ReaderPrim for ContT; its MonadReader instance isn't lawful.