{-# LANGUAGE UndecidableInstances #-}
module Effectful.Class.Reader
  ( MonadReader(..)
  , asks
  ) where

import Control.Monad.Trans.Class
import Control.Monad.Trans.Control

import Effectful.Internal.Has
import Effectful.Internal.Monad
import qualified Effectful.Reader as R

-- | Compatiblity layer for a transition period from MTL-style effect handling
-- to 'Effective.Eff'.
class Monad m => MonadReader r m where
  {-# MINIMAL (ask | reader), local #-}
  ask :: m r
  ask = (r -> r) -> m r
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader r -> r
forall a. a -> a
id

  local :: (r -> r) -> m a -> m a

  reader :: (r -> a) -> m a
  reader r -> a
f = m r
forall r (m :: * -> *). MonadReader r m => m r
ask m r -> (r -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> (r -> a) -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> a
f

-- | Generic, overlappable instance.
instance {-# OVERLAPPABLE #-}
  ( MonadReader r m
  , MonadTransControl t
  , Monad (t m)
  ) => MonadReader r (t m) where
  ask :: t m r
ask       = m r -> t m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> t m a -> t m a
local r -> r
f t m a
m = (Run t -> m (StT t a)) -> t m (StT t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith (\Run t
run -> (r -> r) -> m (StT t a) -> m (StT t a)
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (t m a -> m (StT t a)
Run t
run t m a
m)) t m (StT t a) -> (StT t a -> t m a) -> t m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m (StT t a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (m (StT t a) -> t m a)
-> (StT t a -> m (StT t a)) -> StT t a -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> m (StT t a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  reader :: (r -> a) -> t m a
reader    = m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> ((r -> a) -> m a) -> (r -> a) -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance R.Reader r :> es => MonadReader r (Eff es) where
  ask :: Eff es r
ask    = Eff es r
forall r (es :: [*]). (Reader r :> es) => Eff es r
R.ask
  local :: (r -> r) -> Eff es a -> Eff es a
local  = (r -> r) -> Eff es a -> Eff es a
forall r (es :: [*]) a.
(Reader r :> es) =>
(r -> r) -> Eff es a -> Eff es a
R.local
  reader :: (r -> a) -> Eff es a
reader = (r -> a) -> Eff es a
forall r (es :: [*]) a. (Reader r :> es) => (r -> a) -> Eff es a
R.reader

asks :: MonadReader r m => (r -> a) -> m a
asks :: (r -> a) -> m a
asks = (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader