{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Reader
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- The reader effect, similar to the @MonadReader@ type class from the @mtl@
-- library.
-----------------------------------------------------------------------------
module Control.Effect.Reader
  ( -- * Tagged Reader Effect
    Reader'(..)
    -- * Convenience Functions
  , asks'
    -- * Untagged Reader Effect
    -- | If you don't require disambiguation of multiple reader effects
    -- (i.e., you only have one reader effect in your monadic context),
    -- it is recommended to always use the untagged reader effect.
  , Reader
  , ask
  , local
  , reader
  , asks
    -- * Interpretations
  , runReader'
  , runReader
    -- * Tagging and Untagging
    -- | Conversion functions between the tagged and untagged reader effect,
    -- usually used in combination with type applications, like:
    --
    -- @
    --     'tagReader'' \@\"newTag\" program
    --     'retagReader'' \@\"oldTag\" \@\"newTag\" program
    --     'untagReader'' \@\"erasedTag\" program
    -- @
    -- 
  , tagReader'
  , retagReader'
  , untagReader'
  ) where

-- transformers
import qualified Control.Monad.Trans.Reader   as R
import qualified Control.Monad.Trans.RWS.CPS  as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy

import Control.Effect.Machinery

-- | An effect that adds an immutable state (i.e., an \"environment\") to a given
-- computation. The effect allows to read values from the environment, pass values
-- from function to function, and execute sub-computations in a modified environment.
class Monad m => Reader' tag r m | tag m -> r where
  {-# MINIMAL (ask' | reader'), local' #-}
  
  -- | Gets the environment.
  ask' :: m r
  ask' = (r -> r) -> m r
forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> a) -> m a
reader' @tag r -> r
forall a. a -> a
id
  {-# INLINE ask' #-}
  
  -- | Executes a sub-computation in a modified environment.
  local' :: (r -> r) -- ^ The function to modify the environment.
         -> m a      -- ^ The sub-computation to run in the modified environment.
         -> m a      -- ^ The result of the sub-computation.
  
  -- | Gets a specific component of the environment, using the provided projection function.
  reader' :: (r -> a) -- ^ The projection function to apply to the environment.
          -> m a      -- ^ The result of the projection.
  reader' r -> a
f = do
    r
r <- forall k (tag :: k) r (m :: * -> *). Reader' tag r m => m r
forall r (m :: * -> *). Reader' tag r m => m r
ask' @tag
    a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> a
f r
r)
  {-# INLINE reader' #-}

makeTaggedEffect ''Reader'

instance Monad m => Reader' tag r (R.ReaderT r m) where
  ask' :: ReaderT r m r
ask' = ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
  {-# INLINE ask' #-}
  local' :: (r -> r) -> ReaderT r m a -> ReaderT r m a
local' = (r -> r) -> ReaderT r m a -> ReaderT r m a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
R.local
  {-# INLINE local' #-}
  reader' :: (r -> a) -> ReaderT r m a
reader' = (r -> a) -> ReaderT r m a
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
R.reader
  {-# INLINE reader' #-}

instance (Monad m, Monoid w) => Reader' tag r (Lazy.RWST r w s m) where
  ask' :: RWST r w s m r
ask' = RWST r w s m r
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
Lazy.ask
  {-# INLINE ask' #-}
  local' :: (r -> r) -> RWST r w s m a -> RWST r w s m a
local' = (r -> r) -> RWST r w s m a -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
Lazy.local
  {-# INLINE local' #-}
  reader' :: (r -> a) -> RWST r w s m a
reader' = (r -> a) -> RWST r w s m a
forall w (m :: * -> *) r a s.
(Monoid w, Monad m) =>
(r -> a) -> RWST r w s m a
Lazy.reader
  {-# INLINE reader' #-}

instance Monad m => Reader' tag r (Strict.RWST r w s m) where
  ask' :: RWST r w s m r
ask' = RWST r w s m r
forall (m :: * -> *) r w s. Monad m => RWST r w s m r
Strict.ask
  {-# INLINE ask' #-}
  local' :: (r -> r) -> RWST r w s m a -> RWST r w s m a
local' = (r -> r) -> RWST r w s m a -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> r) -> RWST r w s m a -> RWST r w s m a
Strict.local
  {-# INLINE local' #-}
  reader' :: (r -> a) -> RWST r w s m a
reader' = (r -> a) -> RWST r w s m a
forall (m :: * -> *) r a w s. Monad m => (r -> a) -> RWST r w s m a
Strict.reader
  {-# INLINE reader' #-}

-- | Gets a specific component of the environment, using the provided projection function.
asks' :: forall tag r m a. Reader' tag r m
      => (r -> a) -- ^ The projection function to apply to the environment.
      -> m a      -- ^ The result of the projection.
asks' :: (r -> a) -> m a
asks' = forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> a) -> m a
forall r (m :: * -> *) a. Reader' tag r m => (r -> a) -> m a
reader' @tag
{-# INLINE asks' #-}

makeUntagged ['asks']

-- | Runs the reader effect.
runReader' :: forall tag r m a. r                   -- ^ The initial environment.
           -> (Reader' tag r `Via` R.ReaderT r) m a -- ^ The program whose reader effect should be handled.
           -> m a                                   -- ^ The program with its reader effect handled.
runReader' :: r -> Via (Reader' tag r) (ReaderT r) m a -> m a
runReader' r
r = (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT r
r (ReaderT r m a -> m a)
-> (Via (Reader' tag r) (ReaderT r) m a -> ReaderT r m a)
-> Via (Reader' tag r) (ReaderT r) m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Reader' tag r) (ReaderT r) m a -> ReaderT r m a
forall (effs :: [Effect]) (t :: Transformer) (m :: * -> *) a.
EachVia effs t m a -> t m a
runVia
{-# INLINE runReader' #-}

-- | The untagged version of 'runReader''.
makeUntagged ['runReader']