module Proarrow.Promonad.Reader where

import Prelude (Monoid (..), fmap, snd, (<>))

import Proarrow.Category.Monoidal (MonoidalProfunctor (..))
import Proarrow.Core (Profunctor (..), Promonad (..))
import Proarrow.Object.BinaryProduct ()
import Proarrow.Profunctor.Composition ((:.:) (..))
import Proarrow.Promonad (Procomonad (..))

newtype Reader r a b = Reader {forall r a b. Reader r a b -> (r, a) -> b
unReader :: (r, a) -> b}

instance Profunctor (Reader r) where
  dimap :: forall c a b d.
(c ~> a) -> (b ~> d) -> Reader r a b -> Reader r c d
dimap c ~> a
l b ~> d
r (Reader (r, a) -> b
f) = ((r, c) -> d) -> Reader r c d
forall r a b. ((r, a) -> b) -> Reader r a b
Reader (b ~> d
b -> d
r (b -> d) -> ((r, c) -> b) -> (r, c) -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. (r, a) -> b
f ((r, a) -> b) -> ((r, c) -> (r, a)) -> (r, c) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (p :: PRO k k) (b :: k) (c :: k) (a :: k).
Promonad p =>
p b c -> p a b -> p a c
. (c -> a) -> (r, c) -> (r, a)
forall a b. (a -> b) -> (r, a) -> (r, b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap c ~> a
c -> a
l)

instance Promonad (Reader r) where
  id :: forall a. Ob a => Reader r a a
id = ((r, a) -> a) -> Reader r a a
forall r a b. ((r, a) -> b) -> Reader r a b
Reader (r, a) -> a
forall a b. (a, b) -> b
snd
  Reader (r, b) -> c
g . :: forall b c a. Reader r b c -> Reader r a b -> Reader r a c
. Reader (r, a) -> b
f = ((r, a) -> c) -> Reader r a c
forall r a b. ((r, a) -> b) -> Reader r a b
Reader \(r
r, a
a) -> (r, b) -> c
g (r
r, (r, a) -> b
f (r
r, a
a))

instance (Monoid m) => Procomonad (Reader m) where
  extract :: Reader m :~> (~>)
extract (Reader (m, a) -> b
f) a
a = (m, a) -> b
f (m
forall a. Monoid a => a
mempty, a
a)
  duplicate :: Reader m :~> (Reader m :.: Reader m)
duplicate (Reader (m, a) -> b
f) = ((m, a) -> (m, a)) -> Reader m a (m, a)
forall r a b. ((r, a) -> b) -> Reader r a b
Reader (m, a) -> (m, a)
forall a. Ob a => a -> a
forall {k} (p :: PRO k k) (a :: k). (Promonad p, Ob a) => p a a
id Reader m a (m, a)
-> Reader m (m, a) b -> (:.:) (Reader m) (Reader m) a b
forall {j} {k} {i} (p :: j +-> k) (a :: k) (b :: j) (q :: i +-> j)
       (c :: i).
p a b -> q b c -> (:.:) p q a c
:.: ((m, (m, a)) -> b) -> Reader m (m, a) b
forall r a b. ((r, a) -> b) -> Reader r a b
Reader \(m
m1, (m
m2, a
a)) -> (m, a) -> b
f (m
m1 m -> m -> m
forall a. Semigroup a => a -> a -> a
<> m
m2, a
a)

instance MonoidalProfunctor (Reader r) where
  par0 :: Reader r Unit Unit
par0 = Reader r () ()
Reader r Unit Unit
forall a. Ob a => Reader r a a
forall {k} (p :: PRO k k) (a :: k). (Promonad p, Ob a) => p a a
id
  Reader (r, x1) -> x2
f par :: forall x1 x2 y1 y2.
Reader r x1 x2 -> Reader r y1 y2 -> Reader r (x1 ** y1) (x2 ** y2)
`par` Reader (r, y1) -> y2
g = ((r, (x1, y1)) -> (x2, y2)) -> Reader r (x1, y1) (x2, y2)
forall r a b. ((r, a) -> b) -> Reader r a b
Reader \(r
r, (x1
a, y1
b)) -> ((r, x1) -> x2
f (r
r, x1
a), (r, y1) -> y2
g (r
r, y1
b))