module Data.Profunctor.Reader where import Data.Profunctor import Control.Category (Category) import qualified Control.Category as C import Data.Bifunctor (first, second) import Data.Profunctor.Reader.Class import Data.Profunctor.Strong newtype ReaderT r p a b = ReaderT (p (a, r) b) instance Profunctor p => Profunctor (ReaderT r p) where dimap :: (a -> b) -> (c -> d) -> ReaderT r p b c -> ReaderT r p a d dimap f :: a -> b f g :: c -> d g (ReaderT r :: p (b, r) c r) = p (a, r) d -> ReaderT r p a d forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (((a, r) -> (b, r)) -> (c -> d) -> p (b, r) c -> p (a, r) d forall (p :: * -> * -> *) a b c d. Profunctor p => (a -> b) -> (c -> d) -> p b c -> p a d dimap ((a -> b) -> (a, r) -> (b, r) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first a -> b f) (c -> d g) p (b, r) c r) instance (Category p, Strong p) => Category (ReaderT r p) where id :: ReaderT r p a a id = p (a, r) a -> ReaderT r p a a forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (((a, r) -> a) -> p a a -> p (a, r) a forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap (a, r) -> a forall a b. (a, b) -> a fst p a a forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a C.id) ReaderT x :: p (b, r) c x . :: ReaderT r p b c -> ReaderT r p a b -> ReaderT r p a c . ReaderT y :: p (a, r) b y = p (a, r) c -> ReaderT r p a c forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (p (b, r) c x p (b, r) c -> p (a, r) (b, r) -> p (a, r) c forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k). Category cat => cat b c -> cat a b -> cat a c C.. ((a, r) -> b -> (b, r)) -> p (a, r) b -> p (a, r) (b, r) forall (p :: * -> * -> *) a b c. Strong p => (a -> b -> c) -> p a b -> p a c strong (\(_, r :: r r) b :: b b -> (b b, r r)) p (a, r) b y) instance (Profunctor p, Category p) => ProfunctorReader r (ReaderT r p) where ask :: ReaderT r p a (a, r) ask = p (a, r) (a, r) -> ReaderT r p a (a, r) forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT p (a, r) (a, r) forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a C.id reader :: (r -> a -> b) -> ReaderT r p a b reader f :: r -> a -> b f = ((a, r) -> b) -> ReaderT r p a (a, r) -> ReaderT r p a b forall (p :: * -> * -> *) b c a. Profunctor p => (b -> c) -> p a b -> p a c rmap ((a -> r -> b) -> (a, r) -> b forall a b c. (a -> b -> c) -> (a, b) -> c uncurry ((a -> r -> b) -> (a, r) -> b) -> (a -> r -> b) -> (a, r) -> b forall a b. (a -> b) -> a -> b $ (r -> a -> b) -> a -> r -> b forall a b c. (a -> b -> c) -> b -> a -> c flip r -> a -> b f) ReaderT r p a (a, r) forall r (p :: * -> * -> *) a. ProfunctorReader r p => p a (a, r) ask local :: (r -> r) -> ReaderT r p a b -> ReaderT r p a b local f :: r -> r f (ReaderT q :: p (a, r) b q) = p (a, r) b -> ReaderT r p a b forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (((a, r) -> (a, r)) -> p (a, r) b -> p (a, r) b forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap ((r -> r) -> (a, r) -> (a, r) forall (p :: * -> * -> *) b c a. Bifunctor p => (b -> c) -> p a b -> p a c second r -> r f) p (a, r) b q) instance (Profunctor p) => ProfunctorReader' r (ReaderT r p) where ask' :: ReaderT r p (a, r) b -> ReaderT r p a b ask' (ReaderT p :: p ((a, r), r) b p) = p (a, r) b -> ReaderT r p a b forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (p (a, r) b -> ReaderT r p a b) -> p (a, r) b -> ReaderT r p a b forall a b. (a -> b) -> a -> b $ ((a, r) -> ((a, r), r)) -> p ((a, r), r) b -> p (a, r) b forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap (\(a :: a a, r :: r r) -> ((a a, r r), r r)) p ((a, r), r) b p local' :: (r -> r) -> ReaderT r p a b -> ReaderT r p a b local' f :: r -> r f (ReaderT p :: p (a, r) b p) = p (a, r) b -> ReaderT r p a b forall r (p :: * -> * -> *) a b. p (a, r) b -> ReaderT r p a b ReaderT (p (a, r) b -> ReaderT r p a b) -> p (a, r) b -> ReaderT r p a b forall a b. (a -> b) -> a -> b $ ((a, r) -> (a, r)) -> p (a, r) b -> p (a, r) b forall (p :: * -> * -> *) a b c. Profunctor p => (a -> b) -> p b c -> p a c lmap ((r -> r) -> (a, r) -> (a, r) forall (p :: * -> * -> *) b c a. Bifunctor p => (b -> c) -> p a b -> p a c second r -> r f) p (a, r) b p