module Control.Joint.Effects.Reader where

import Control.Joint.Operators ((<$$>), (<**>))
import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))
import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))
import Control.Joint.Abilities.Adaptable (Adaptable (adapt))
import Control.Joint.Schemes (TU (TU), type (<:.>))

newtype Reader e a = Reader (e -> a)

instance Functor (Reader e) where
	fmap :: (a -> b) -> Reader e a -> Reader e b
fmap a -> b
f (Reader e -> a
g) = (e -> b) -> Reader e b
forall e a. (e -> a) -> Reader e a
Reader (a -> b
f (a -> b) -> (e -> a) -> e -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a
g)

instance Applicative (Reader e) where
	pure :: a -> Reader e a
pure = (e -> a) -> Reader e a
forall e a. (e -> a) -> Reader e a
Reader ((e -> a) -> Reader e a) -> (a -> e -> a) -> a -> Reader e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e -> a
forall a b. a -> b -> a
const
	Reader e -> a -> b
f <*> :: Reader e (a -> b) -> Reader e a -> Reader e b
<*> Reader e -> a
g = (e -> b) -> Reader e b
forall e a. (e -> a) -> Reader e a
Reader ((e -> b) -> Reader e b) -> (e -> b) -> Reader e b
forall a b. (a -> b) -> a -> b
$ \e
e -> e -> a -> b
f e
e (e -> a
g e
e)

instance Monad (Reader e) where
	Reader e -> a
g >>= :: Reader e a -> (a -> Reader e b) -> Reader e b
>>= a -> Reader e b
f = (e -> b) -> Reader e b
forall e a. (e -> a) -> Reader e a
Reader ((e -> b) -> Reader e b) -> (e -> b) -> Reader e b
forall a b. (a -> b) -> a -> b
$ \e
e -> Reader e b -> e -> b
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (a -> Reader e b
f (e -> a
g e
e)) e
e

instance Interpreted (Reader e) where
	type Primary (Reader e) a = (->) e a
	run :: Reader e a -> Primary (Reader e) a
run (Reader e -> a
x) = Primary (Reader e) a
e -> a
x

type instance Schema (Reader e) = TU ((->) e)

instance Transformer (Reader e) where
	build :: Reader e ~> (Reader e :> u)
build Reader e a
x = TU ((->) e) u a -> (:>) (Reader e) u a
forall (t :: * -> *) (u :: * -> *) a.
(Transformer t => Schema t u a) -> (:>) t u a
T(TU ((->) e) u a -> (:>) (Reader e) u a)
-> ((((->) e :. u) := a) -> TU ((->) e) u a)
-> (((->) e :. u) := a)
-> (:>) (Reader e) u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((->) e :. u) := a) -> TU ((->) e) u a
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU ((((->) e :. u) := a) -> (:>) (Reader e) u a)
-> (((->) e :. u) := a) -> (:>) (Reader e) u a
forall a b. (a -> b) -> a -> b
$ a -> u a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> u a) -> (e -> a) -> ((->) e :. u) := a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader e a -> Primary (Reader e) a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run Reader e a
x
	unite :: Primary (Schema (Reader e) u) a -> (:>) (Reader e) u a
unite = TU ((->) e) u a -> (:>) (Reader e) u a
forall (t :: * -> *) (u :: * -> *) a.
(Transformer t => Schema t u a) -> (:>) t u a
T (TU ((->) e) u a -> (:>) (Reader e) u a)
-> ((((->) e :. u) := a) -> TU ((->) e) u a)
-> (((->) e :. u) := a)
-> (:>) (Reader e) u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((->) e :. u) := a) -> TU ((->) e) u a
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU

instance Functor u => Functor ((->) e <:.> u) where
	fmap :: (a -> b) -> (<:.>) ((->) e) u a -> (<:.>) ((->) e) u b
fmap a -> b
f (TU ((->) e :. u) := a
x) = (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU ((((->) e :. u) := b) -> (<:.>) ((->) e) u b)
-> (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall a b. (a -> b) -> a -> b
$ a -> b
f (a -> b) -> (((->) e :. u) := a) -> ((->) e :. u) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Functor t, Functor u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> ((->) e :. u) := a
x

instance Applicative u => Applicative ((->) e <:.> u) where
	pure :: a -> (<:.>) ((->) e) u a
pure = (((->) e :. u) := a) -> (<:.>) ((->) e) u a
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU ((((->) e :. u) := a) -> (<:.>) ((->) e) u a)
-> (a -> ((->) e :. u) := a) -> a -> (<:.>) ((->) e) u a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u a -> ((->) e :. u) := a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (u a -> ((->) e :. u) := a)
-> (a -> u a) -> a -> ((->) e :. u) := a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> u a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
	TU ((->) e :. u) := (a -> b)
f <*> :: (<:.>) ((->) e) u (a -> b)
-> (<:.>) ((->) e) u a -> (<:.>) ((->) e) u b
<*> TU ((->) e :. u) := a
x = (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU ((((->) e :. u) := b) -> (<:.>) ((->) e) u b)
-> (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall a b. (a -> b) -> a -> b
$ ((->) e :. u) := (a -> b)
f (((->) e :. u) := (a -> b))
-> (((->) e :. u) := a) -> ((->) e :. u) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Applicative t, Applicative u) =>
((t :. u) := (a -> b)) -> ((t :. u) := a) -> (t :. u) := b
<**> ((->) e :. u) := a
x

instance (Applicative u, Monad u) => Monad ((->) e <:.> u) where
	TU ((->) e :. u) := a
x >>= :: (<:.>) ((->) e) u a
-> (a -> (<:.>) ((->) e) u b) -> (<:.>) ((->) e) u b
>>= a -> (<:.>) ((->) e) u b
f = (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall k k (t :: k -> *) (u :: k -> k) (a :: k).
((t :. u) := a) -> TU t u a
TU ((((->) e :. u) := b) -> (<:.>) ((->) e) u b)
-> (((->) e :. u) := b) -> (<:.>) ((->) e) u b
forall a b. (a -> b) -> a -> b
$ \e
e -> ((->) e :. u) := a
x e
e u a -> (a -> u b) -> u b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((((->) e :. u) := b) -> ((->) e :. u) := b
forall a b. (a -> b) -> a -> b
$ e
e) ((((->) e :. u) := b) -> u b)
-> (a -> ((->) e :. u) := b) -> a -> u b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (<:.>) ((->) e) u b -> ((->) e :. u) := b
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run ((<:.>) ((->) e) u b -> ((->) e :. u) := b)
-> (a -> (<:.>) ((->) e) u b) -> a -> ((->) e :. u) := b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (<:.>) ((->) e) u b
f

type Configured e = Adaptable (Reader e)

get :: Configured e t => t e
get :: t e
get = Reader e e -> t e
forall (eff :: * -> *) (schema :: * -> *).
Adaptable eff schema =>
eff ~> schema
adapt (Reader e e -> t e) -> Reader e e -> t e
forall a b. (a -> b) -> a -> b
$ (e -> e) -> Reader e e
forall e a. (e -> a) -> Reader e a
Reader e -> e
forall a. a -> a
id