module Data.Profunctor.Extras where

import Data.Profunctor
import Data.Profunctor.Sieve
import Data.Profunctor.Strong
import Data.Profunctor.Rep
import Data.Function ((&))
import Control.Monad

join' :: (Sieve p f, Strong p) => p a (p a b) -> p a (f b)
join' :: p a (p a b) -> p a (f b)
join' = (a -> (a -> f b) -> f b) -> p a (a -> f b) -> p a (f b)
forall (p :: * -> * -> *) a b c.
Strong p =>
(a -> b -> c) -> p a b -> p a c
strong a -> (a -> f b) -> f b
forall a b. a -> (a -> b) -> b
(&) (p a (a -> f b) -> p a (f b))
-> (p a (p a b) -> p a (a -> f b)) -> p a (p a b) -> p a (f b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a b -> a -> f b) -> p a (p a b) -> p a (a -> f b)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap p a b -> a -> f b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve

join'' :: (Representable p, Strong p, Monad (Rep p)) => p a (p a b) -> p a b
join'' :: p a (p a b) -> p a b
join'' = (a -> Rep p b) -> p a b
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((a -> Rep p b) -> p a b)
-> (p a (p a b) -> a -> Rep p b) -> p a (p a b) -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rep p (Rep p b) -> Rep p b)
-> (a -> Rep p (Rep p b)) -> a -> Rep p b
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap Rep p (Rep p b) -> Rep p b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((a -> Rep p (Rep p b)) -> a -> Rep p b)
-> (p a (p a b) -> a -> Rep p (Rep p b))
-> p a (p a b)
-> a
-> Rep p b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (Rep p b) -> a -> Rep p (Rep p b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve (p a (Rep p b) -> a -> Rep p (Rep p b))
-> (p a (p a b) -> p a (Rep p b))
-> p a (p a b)
-> a
-> Rep p (Rep p b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a -> Rep p b) -> Rep p b)
-> p a (a -> Rep p b) -> p a (Rep p b)
forall (p :: * -> * -> *) a b c.
Strong p =>
(a -> b -> c) -> p a b -> p a c
strong a -> (a -> Rep p b) -> Rep p b
forall a b. a -> (a -> b) -> b
(&) (p a (a -> Rep p b) -> p a (Rep p b))
-> (p a (p a b) -> p a (a -> Rep p b))
-> p a (p a b)
-> p a (Rep p b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (p a b -> a -> Rep p b) -> p a (p a b) -> p a (a -> Rep p b)
forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap p a b -> a -> Rep p b
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve

absorb :: (Representable p, m ~ Rep p, Monad m) => p a (m b) -> p a b
absorb :: p a (m b) -> p a b
absorb = (a -> m b) -> p a b
forall (p :: * -> * -> *) d c.
Representable p =>
(d -> Rep p c) -> p d c
tabulate ((a -> m b) -> p a b)
-> (p a (m b) -> a -> m b) -> p a (m b) -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (m b) -> m b) -> (a -> m (m b)) -> a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (m b) -> m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((a -> m (m b)) -> a -> m b)
-> (p a (m b) -> a -> m (m b)) -> p a (m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p a (m b) -> a -> m (m b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
Sieve p f =>
p a b -> a -> f b
sieve

newtype Dub p f a b = Dub (p (f a) (f b))

instance (Profunctor p, Functor f) => Profunctor (Dub p f) where
  dimap :: (a -> b) -> (c -> d) -> Dub p f b c -> Dub p f a d
dimap f :: a -> b
f g :: c -> d
g (Dub p :: p (f b) (f c)
p) = p (f a) (f d) -> Dub p f a d
forall (p :: * -> * -> *) (f :: * -> *) a b.
p (f a) (f b) -> Dub p f a b
Dub ((f a -> f b) -> (f c -> f d) -> p (f b) (f c) -> p (f a) (f d)
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
dimap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((c -> d) -> f c -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) p (f b) (f c)
p)