module Control.Functor.Adjunction where
import Control.Functor
import Control.Comonad
class (Functor f, Functor g) => Adjunction f g | f -> g, g -> f where
leftAdjunct :: (f a -> b) -> a -> g b
rightAdjunct :: (a -> g b) -> f a -> b
unit :: a -> g (f a)
counit :: f (g a) -> a
unit = leftAdjunct id
counit = rightAdjunct id
leftAdjunct f = fmap f . unit
rightAdjunct g = counit . fmap g
instance (Adjunction f g) => Monad (O g f) where
return = Comp . unit
m >>= k = Comp . fmap (rightAdjunct (deComp . k)) . deComp $ m
instance (Adjunction f g) => Comonad (O f g) where
extract = counit . deComp
extend f = Comp . fmap (leftAdjunct (f . Comp)) . deComp
instance Adjunction ((,) a) ((->) a) where
unit t = \x -> (x,t)
counit (x,f) = f x