module Control.Joint.Effects.Reader where

import Control.Joint.Abilities.Composition (Composition (Primary, run))
import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite))
import Control.Joint.Abilities.Modulator (Modulator ((-<$>-)))
import Control.Joint.Abilities.Liftable (Liftable (lift))
import Control.Joint.Schemes.TU (TU (TU))
import Control.Joint.Schemes.TUT (TUT (TUT))
import Control.Joint.Schemes.UT (UT (UT))

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

instance Functor (Reader e) where
        fmap f (Reader g) = Reader (f . g)

instance Applicative (Reader e) where
        pure = Reader . const
        Reader f <*> Reader g = Reader $ \e -> f e (g e)

instance Monad (Reader e) where
        Reader g >>= f = Reader $ \e -> run (f (g e)) e

instance Functor u => Functor (TU ((->) e) u) where
        fmap f (TU x) = TU $ \r -> f <$> x r

instance Applicative u => Applicative (TU ((->) e) u) where
        pure = TU . pure . pure
        TU f <*> TU x = TU $ \r -> f r <*> x r

instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where
        TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f

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

instance Transformer (Reader e) where
        type Schema (Reader e) u = TU ((->) e) u
        embed x = TU . const $ x
        build x = TU $ pure <$> run x
        unite = TU

instance Modulator (Reader e) where
        f -<$>- (TU x) = TU $ f <$> x

ask :: Reader e e
ask = Reader $ \e -> e

instance Liftable (Reader e) ((->) e) where
        lift = run

type Configured e = Liftable (Reader e)