{-# LANGUAGE DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}

-- | A carrier for 'Reader' effects.
--
-- @since 1.0.0.0
module Control.Carrier.Reader
( -- * Reader carrier
  runReader
, ReaderC(..)
  -- * Reader effect
, module Control.Effect.Reader
) where

import Control.Algebra
import Control.Applicative (Alternative(..), liftA2)
import Control.Effect.Reader
import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class

-- | Run a 'Reader' effect with the passed environment value.
--
-- @
-- 'runReader' a 'ask' = 'pure' a
-- @
-- @
-- 'runReader' a ('pure' b) = 'pure' b
-- @
-- @
-- 'runReader' a ('local' f m) = 'runReader' (f a) m
-- @
--
-- @since 1.0.0.0
runReader :: r -> ReaderC r m a -> m a
runReader :: r -> ReaderC r m a -> m a
runReader r :: r
r (ReaderC runReaderC :: r -> m a
runReaderC) = r -> m a
runReaderC r
r
{-# INLINE runReader #-}

-- | @since 1.0.0.0
newtype ReaderC r m a = ReaderC (r -> m a)
  deriving (a -> ReaderC r m b -> ReaderC r m a
(a -> b) -> ReaderC r m a -> ReaderC r m b
(forall a b. (a -> b) -> ReaderC r m a -> ReaderC r m b)
-> (forall a b. a -> ReaderC r m b -> ReaderC r m a)
-> Functor (ReaderC r m)
forall a b. a -> ReaderC r m b -> ReaderC r m a
forall a b. (a -> b) -> ReaderC r m a -> ReaderC r m b
forall r (m :: * -> *) a b.
Functor m =>
a -> ReaderC r m b -> ReaderC r m a
forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReaderC r m a -> ReaderC r m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ReaderC r m b -> ReaderC r m a
$c<$ :: forall r (m :: * -> *) a b.
Functor m =>
a -> ReaderC r m b -> ReaderC r m a
fmap :: (a -> b) -> ReaderC r m a -> ReaderC r m b
$cfmap :: forall r (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReaderC r m a -> ReaderC r m b
Functor)

instance Applicative m => Applicative (ReaderC r m) where
  pure :: a -> ReaderC r m a
pure = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m a) -> ReaderC r m a)
-> (a -> r -> m a) -> a -> ReaderC r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> r -> m a
forall a b. a -> b -> a
const (m a -> r -> m a) -> (a -> m a) -> a -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE pure #-}
  ReaderC f :: r -> m (a -> b)
f <*> :: ReaderC r m (a -> b) -> ReaderC r m a -> ReaderC r m b
<*> ReaderC a :: r -> m a
a = (r -> m b) -> ReaderC r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((m (a -> b) -> m a -> m b)
-> (r -> m (a -> b)) -> (r -> m a) -> r -> m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) r -> m (a -> b)
f r -> m a
a)
  {-# INLINE (<*>) #-}
  ReaderC u :: r -> m a
u *> :: ReaderC r m a -> ReaderC r m b -> ReaderC r m b
*> ReaderC v :: r -> m b
v = (r -> m b) -> ReaderC r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m b) -> ReaderC r m b) -> (r -> m b) -> ReaderC r m b
forall a b. (a -> b) -> a -> b
$ \ r :: r
r -> r -> m a
u r
r m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> r -> m b
v r
r
  {-# INLINE (*>) #-}
  ReaderC u :: r -> m a
u <* :: ReaderC r m a -> ReaderC r m b -> ReaderC r m a
<* ReaderC v :: r -> m b
v = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m a) -> ReaderC r m a) -> (r -> m a) -> ReaderC r m a
forall a b. (a -> b) -> a -> b
$ \ r :: r
r -> r -> m a
u r
r m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* r -> m b
v r
r
  {-# INLINE (<*) #-}

instance Alternative m => Alternative (ReaderC r m) where
  empty :: ReaderC r m a
empty = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (m a -> r -> m a
forall a b. a -> b -> a
const m a
forall (f :: * -> *) a. Alternative f => f a
empty)
  {-# INLINE empty #-}
  ReaderC l :: r -> m a
l <|> :: ReaderC r m a -> ReaderC r m a -> ReaderC r m a
<|> ReaderC r :: r -> m a
r = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((m a -> m a -> m a) -> (r -> m a) -> (r -> m a) -> r -> m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) r -> m a
l r -> m a
r)
  {-# INLINE (<|>) #-}

instance Monad m => Monad (ReaderC r m) where
  ReaderC a :: r -> m a
a >>= :: ReaderC r m a -> (a -> ReaderC r m b) -> ReaderC r m b
>>= f :: a -> ReaderC r m b
f = (r -> m b) -> ReaderC r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ r :: r
r -> r -> m a
a r
r m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> ReaderC r m b -> m b
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader r
r (ReaderC r m b -> m b) -> (a -> ReaderC r m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderC r m b
f)
  {-# INLINE (>>=) #-}

instance Fail.MonadFail m => Fail.MonadFail (ReaderC r m) where
  fail :: String -> ReaderC r m a
fail = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m a) -> ReaderC r m a)
-> (String -> r -> m a) -> String -> ReaderC r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> r -> m a
forall a b. a -> b -> a
const (m a -> r -> m a) -> (String -> m a) -> String -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail
  {-# INLINE fail #-}

instance MonadFix m => MonadFix (ReaderC s m) where
  mfix :: (a -> ReaderC s m a) -> ReaderC s m a
mfix f :: a -> ReaderC s m a
f = (s -> m a) -> ReaderC s m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ r :: s
r -> (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (s -> ReaderC s m a -> m a
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader s
r (ReaderC s m a -> m a) -> (a -> ReaderC s m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderC s m a
f))
  {-# INLINE mfix #-}

instance MonadIO m => MonadIO (ReaderC r m) where
  liftIO :: IO a -> ReaderC r m a
liftIO = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m a) -> ReaderC r m a)
-> (IO a -> r -> m a) -> IO a -> ReaderC r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> r -> m a
forall a b. a -> b -> a
const (m a -> r -> m a) -> (IO a -> m a) -> IO a -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  {-# INLINE liftIO #-}

instance (Alternative m, Monad m) => MonadPlus (ReaderC r m)

instance MonadTrans (ReaderC r) where
  lift :: m a -> ReaderC r m a
lift = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC ((r -> m a) -> ReaderC r m a)
-> (m a -> r -> m a) -> m a -> ReaderC r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> r -> m a
forall a b. a -> b -> a
const
  {-# INLINE lift #-}

instance Algebra sig m => Algebra (Reader r :+: sig) (ReaderC r m) where
  alg :: (:+:) (Reader r) sig (ReaderC r m) a -> ReaderC r m a
alg (L (Ask       k :: r -> ReaderC r m a
k)) = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ r :: r
r -> r -> ReaderC r m a -> m a
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader r
r (r -> ReaderC r m a
k r
r))
  alg (L (Local f :: r -> r
f m :: ReaderC r m b
m k :: b -> ReaderC r m a
k)) = (r -> m b) -> ReaderC r m b
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ r :: r
r -> r -> ReaderC r m b -> m b
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader (r -> r
f r
r) ReaderC r m b
m) ReaderC r m b -> (b -> ReaderC r m a) -> ReaderC r m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ReaderC r m a
k
  alg (R other :: sig (ReaderC r m) a
other)         = (r -> m a) -> ReaderC r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderC r m a
ReaderC (\ r :: r
r -> sig m a -> m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Algebra sig m =>
sig m a -> m a
alg ((forall x. ReaderC r m x -> m x) -> sig (ReaderC r m) a -> sig m a
forall (h :: (* -> *) -> * -> *) (m :: * -> *) (n :: * -> *) a.
(HFunctor h, Functor m) =>
(forall x. m x -> n x) -> h m a -> h n a
hmap (r -> ReaderC r m x -> m x
forall r (m :: * -> *) a. r -> ReaderC r m a -> m a
runReader r
r) sig (ReaderC r m) a
other))
  {-# INLINE alg #-}