{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
module Data.Profunctor.Absorbent where

import Data.Profunctor
import Data.Functor.Identity
import Control.Monad

-- Similar to Profunctor Representable, but simpler to implement and less restrictive
-- Represents Profunctors which can run effects.
class Profunctor p => Absorbent m p | p -> m where
  absorb :: p a (m b) -> p a b

instance Absorbent Identity (->) where
  absorb :: (a -> Identity b) -> a -> b
absorb p :: a -> Identity b
p = Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> (a -> Identity b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity b
p

instance Monad m => Absorbent m (Star m) where
  absorb :: Star m a (m b) -> Star m a b
absorb (Star f :: a -> m (m b)
f) = (a -> m b) -> Star m a b
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star (m (m b) -> m b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m b) -> m b) -> (a -> m (m b)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (m b)
f)

instance Absorbent m (Forget (m r)) where
  absorb :: Forget (m r) a (m b) -> Forget (m r) a b
absorb (Forget f :: a -> m r
f) = (a -> m r) -> Forget (m r) a b
forall r a b. (a -> r) -> Forget r a b
Forget a -> m r
f