{-# LANGUAGE TemplateHaskell #-}

module Polysemy.Reader
  ( -- * Effect
    Reader (..)

    -- * Actions
  , ask
  , asks
  , local

    -- * Interpretations
  , runReader

    -- * Interpretations for Other Effects
  , inputToReader
  ) where

import Polysemy
import Polysemy.Input


------------------------------------------------------------------------------
-- | An effect corresponding to 'Control.Monad.Trans.Reader.ReaderT'.
data Reader i m a where
  Ask   :: Reader i m i
  Local :: (i -> i) -> m a -> Reader i m a

makeSem ''Reader


asks :: forall i j r. Member (Reader i) r => (i -> j) -> Sem r j
asks :: (i -> j) -> Sem r j
asks i -> j
f = i -> j
f (i -> j) -> Sem r i -> Sem r j
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r i
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask
{-# INLINABLE asks #-}


------------------------------------------------------------------------------
-- | Run a 'Reader' effect with a constant value.
runReader :: i -> Sem (Reader i ': r) a -> Sem r a
runReader :: i -> Sem (Reader i : r) a -> Sem r a
runReader i
i = (forall x (rInitial :: [Effect]).
 Reader i (Sem rInitial) x
 -> Tactical (Reader i) (Sem rInitial) r x)
-> Sem (Reader i : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
(forall x (rInitial :: [Effect]).
 e (Sem rInitial) x -> Tactical e (Sem rInitial) r x)
-> Sem (e : r) a -> Sem r a
interpretH ((forall x (rInitial :: [Effect]).
  Reader i (Sem rInitial) x
  -> Tactical (Reader i) (Sem rInitial) r x)
 -> Sem (Reader i : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
    Reader i (Sem rInitial) x
    -> Tactical (Reader i) (Sem rInitial) r x)
-> Sem (Reader i : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Reader i (Sem rInitial) x
Ask -> i -> Tactical (Reader i) (Sem rInitial) r i
forall a (e :: Effect) (m :: * -> *) (r :: [Effect]).
a -> Tactical e m r a
pureT i
i
  Local f m -> do
    Sem (Reader i : r) (f x)
mm <- Sem rInitial x
-> Sem
     (WithTactics (Reader i) f (Sem rInitial) r)
     (Sem (Reader i : r) (f x))
forall (m :: * -> *) a (e :: Effect) (f :: * -> *) (r :: [Effect]).
m a -> Sem (WithTactics e f m r) (Sem (e : r) (f a))
runT Sem rInitial x
m
    Sem r (f x)
-> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x)
forall (e :: Effect) (r :: [Effect]) a. Sem r a -> Sem (e : r) a
raise (Sem r (f x)
 -> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x))
-> Sem r (f x)
-> Sem (WithTactics (Reader i) f (Sem rInitial) r) (f x)
forall a b. (a -> b) -> a -> b
$ i -> Sem (Reader i : r) (f x) -> Sem r (f x)
forall i (r :: [Effect]) a. i -> Sem (Reader i : r) a -> Sem r a
runReader (i -> i
f i
i) Sem (Reader i : r) (f x)
mm
{-# INLINE runReader #-}


------------------------------------------------------------------------------
-- | Transform an 'Input' effect into a 'Reader' effect.
--
-- @since 1.0.0.0
inputToReader :: Member (Reader i) r => Sem (Input i ': r) a -> Sem r a
inputToReader :: Sem (Input i : r) a -> Sem r a
inputToReader = (forall x (rInitial :: [Effect]).
 Input i (Sem rInitial) x -> Sem r x)
-> Sem (Input i : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [Effect]). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: [Effect]).
  Input i (Sem rInitial) x -> Sem r x)
 -> Sem (Input i : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
    Input i (Sem rInitial) x -> Sem r x)
-> Sem (Input i : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Input i (Sem rInitial) x
Input -> Sem r x
forall i (r :: [Effect]). MemberWithError (Reader i) r => Sem r i
ask
{-# INLINE inputToReader #-}