module Data.Profunctor.Depending where

import Data.Profunctor
import Data.Profunctor.Traversing

class Traversing p => Depending p where
  depend :: (forall f. Monad f => (a -> f b) -> (s -> f t)) -> p a b -> p s t

instance Monad f => Depending (Star f) where
  depend :: (forall (f :: * -> *). Monad f => (a -> f b) -> s -> f t)
-> Star f a b -> Star f s t
depend f :: forall (f :: * -> *). Monad f => (a -> f b) -> s -> f t
f (Star amb :: a -> f b
amb) = (s -> f t) -> Star f s t
forall (f :: * -> *) d c. (d -> f c) -> Star f d c
Star ((a -> f b) -> s -> f t
forall (f :: * -> *). Monad f => (a -> f b) -> s -> f t
f a -> f b
amb)