module Control.Comonad.Density
( Density(..)
, liftDensity
, densityToAdjunction, adjunctionToDensity
) where
import Control.Applicative
import Control.Comonad
import Control.Comonad.Trans.Class
import Data.Functor.Apply
import Data.Functor.Adjunction
import Data.Functor.Extend
data Density k a where
Density :: (k b -> a) -> k b -> Density k a
instance Functor (Density f) where
fmap f (Density g h) = Density (f . g) h
instance Extend (Density f) where
duplicated (Density f ws) = Density (Density f) ws
instance Comonad (Density f) where
duplicate (Density f ws) = Density (Density f) ws
extract (Density f a) = f a
instance ComonadTrans Density where
lower (Density f c) = extend f c
instance Apply f => Apply (Density f) where
Density kxf x <.> Density kya y =
Density (\k -> kxf (fmap fst k) (kya (fmap snd k))) ((,) <$> x <.> y)
instance Applicative f => Applicative (Density f) where
pure a = Density (const a) (pure ())
Density kxf x <*> Density kya y =
Density (\k -> kxf (fmap fst k) (kya (fmap snd k))) (liftA2 (,) x y)
liftDensity :: Comonad w => w a -> Density w a
liftDensity = Density extract
densityToAdjunction :: Adjunction f g => Density f a -> f (g a)
densityToAdjunction (Density f v) = fmap (leftAdjunct f) v
adjunctionToDensity :: Adjunction f g => f (g a) -> Density f a
adjunctionToDensity = Density counit