module Data.Functor.Contravariant.Adjunction
( Adjunction(..)
, DualAdjunction(..)
, Representation(..)
, repAdjunction, repFlippedAdjunction
) where
import Control.Monad.Instances ()
import Data.Functor.Contravariant
class (Contravariant f, Contravariant g) => Adjunction f g | f -> g, g -> f where
unit :: a -> g (f a)
counit :: a -> f (g a)
leftAdjunct :: (b -> f a) -> a -> g b
rightAdjunct :: (a -> g b) -> b -> f a
unit = leftAdjunct id
counit = rightAdjunct id
leftAdjunct f = contramap f . unit
rightAdjunct f = contramap f . counit
instance Adjunction (Op r) (Op r) where
unit a = Op (\k -> getOp k a)
counit = unit
instance Adjunction Predicate Predicate where
unit a = Predicate (\k -> getPredicate k a)
counit = unit
data Representation f x = Representation
{ rep :: forall a. (a -> x) -> f a
, unrep :: forall a. f a -> (a -> x)
}
repAdjunction :: Adjunction f g => Representation g (f ())
repAdjunction = Representation
{ rep = flip leftAdjunct ()
, unrep = rightAdjunct . const
}
repFlippedAdjunction :: Adjunction f g => Representation f (g ())
repFlippedAdjunction = Representation
{ rep = flip rightAdjunct ()
, unrep = leftAdjunct . const
}
class (Contravariant f, Contravariant g) => DualAdjunction f g | f -> g, g -> f where
unitOp :: g (f a) -> a
counitOp :: f (g a) -> a
leftAdjunctOp :: (f a -> b) -> g b -> a
rightAdjunctOp :: (g b -> a) -> f a -> b
unitOp = leftAdjunctOp id
counitOp = rightAdjunctOp id
leftAdjunctOp f = unitOp . contramap f
rightAdjunctOp f = counitOp . contramap f