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)