{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE StandaloneDeriving #-}
module Control.Effect.Reader.Internal
( Reader(..)
) where

import Control.Effect.Class

-- | @since 0.1.0.0
data Reader r m k
  = Ask (r -> m k)
  | forall b . Local (r -> r) (m b) (b -> m k)

deriving instance Functor m => Functor (Reader r m)

instance HFunctor (Reader r) where
  hmap :: (forall x. m x -> n x) -> Reader r m a -> Reader r n a
hmap f :: forall x. m x -> n x
f (Ask k :: r -> m a
k)       = (r -> n a) -> Reader r n a
forall r (m :: * -> *) k. (r -> m k) -> Reader r m k
Ask           (m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (r -> m a) -> r -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
k)
  hmap f :: forall x. m x -> n x
f (Local g :: r -> r
g m :: m b
m k :: b -> m a
k) = (r -> r) -> n b -> (b -> n a) -> Reader r n a
forall r (m :: * -> *) k b.
(r -> r) -> m b -> (b -> m k) -> Reader r m k
Local r -> r
g (m b -> n b
forall x. m x -> n x
f m b
m) (m a -> n a
forall x. m x -> n x
f (m a -> n a) -> (b -> m a) -> b -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m a
k)

instance Effect (Reader r) where
  thread :: ctx ()
-> (forall x. ctx (m x) -> n (ctx x))
-> Reader r m a
-> Reader r n (ctx a)
thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Ask k :: r -> m a
k)       = (r -> n (ctx a)) -> Reader r n (ctx a)
forall r (m :: * -> *) k. (r -> m k) -> Reader r m k
Ask                          (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m a) -> n (ctx a)) -> (r -> ctx (m a)) -> r -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m a -> ctx () -> ctx (m a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx) (m a -> ctx (m a)) -> (r -> m a) -> r -> ctx (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
k)
  thread ctx :: ctx ()
ctx handler :: forall x. ctx (m x) -> n (ctx x)
handler (Local f :: r -> r
f m :: m b
m k :: b -> m a
k) = (r -> r) -> n (ctx b) -> (ctx b -> n (ctx a)) -> Reader r n (ctx a)
forall r (m :: * -> *) k b.
(r -> r) -> m b -> (b -> m k) -> Reader r m k
Local r -> r
f (ctx (m b) -> n (ctx b)
forall x. ctx (m x) -> n (ctx x)
handler (m b
m m b -> ctx () -> ctx (m b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ctx ()
ctx)) (ctx (m a) -> n (ctx a)
forall x. ctx (m x) -> n (ctx x)
handler (ctx (m a) -> n (ctx a))
-> (ctx b -> ctx (m a)) -> ctx b -> n (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m a) -> ctx b -> ctx (m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> m a
k)