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