{-# 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'(..)
    -- * 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
    -- * Convenience Functions

    -- | 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 functions.

  , asks'
  , 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' f :: 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' #-}

-- | The untagged version of 'asks''.

asks :: Reader r m => (r -> a) -> m a
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' G r m => (r -> a) -> m a
asks' @G
{-# INLINE 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
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 :: (* -> *) -> * -> *) (m :: * -> *)
       a.
EachVia effs t m a -> t m a
runVia
{-# INLINE runReader' #-}

-- | The untagged version of 'runReader''.

runReader :: r -> (Reader r `Via` R.ReaderT r) m a -> m a
runReader :: r -> Via (Reader r) (ReaderT r) m a -> m a
runReader = forall k (tag :: k) r (m :: * -> *) a.
r -> Via (Reader' tag r) (ReaderT r) m a -> m a
forall r (m :: * -> *) a.
r -> Via (Reader' G r) (ReaderT r) m a -> m a
runReader' @G
{-# INLINE runReader #-}