module Control.Comonad
(
Comonad(..)
, (=>>)
, (.>>)
, liftW
, CoKleisli(..)
, local
, sequenceW
, mapW
, parallelW
, unfoldW
)where
import Control.Arrow
import Control.Functor()
import Control.Monad.Identity
infixl 1 =>>, .>>
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> (w a -> w b)
extend f = fmap f . duplicate
duplicate = extend id
liftW :: Comonad w => (a -> b) -> (w a -> w b)
liftW f = extend (f . extract)
(=>>) :: Comonad w => w a -> (w a -> b) -> w b
(=>>) = flip extend
(.>>) :: Comonad w => w a -> b -> w b
w .>> b = extend (\_ -> b) w
instance Comonad Identity where
extract (Identity x) = x
duplicate y = Identity y
extend c w = Identity (c w)
instance Comonad ((,) a) where
extract (_,x) = x
duplicate (c,x) = (c,(c,x))
local :: (c -> c') -> ((c',a) -> a) -> ((c,a) -> a)
local g f (c,x) = f (g c, x)
newtype CoKleisli w a b = CoKleisli { unCoKleisli :: w a -> b }
instance Functor (CoKleisli w a) where
fmap f (CoKleisli g) = CoKleisli (f . g)
instance (Comonad w) => Arrow (CoKleisli w) where
arr f = CoKleisli (f . extract)
CoKleisli a >>> CoKleisli b
= CoKleisli (b . fmap a . duplicate)
CoKleisli a &&& CoKleisli b
= CoKleisli (a &&& b)
CoKleisli a *** CoKleisli b
= CoKleisli (a . fmap fst &&& b . fmap snd)
first a = a *** arr id
second a = arr id *** a
mapW :: Comonad w => (w a -> b) -> w [a] -> [b]
mapW f w | null (extract w) = []
| otherwise = f (fmap head w) : mapW f (fmap tail w)
parallelW :: Comonad w => w [a] -> [w a]
parallelW w | null (extract w) = []
| otherwise = fmap head w : parallelW (fmap tail w)
unfoldW :: Comonad w => (w b -> (a,b)) -> w b -> [a]
unfoldW f w = fst (f w) : unfoldW f (w =>> snd . f)
sequenceW :: Comonad w => [w a -> b] -> w a -> [b]
sequenceW [] _ = []
sequenceW (f:fs) w = f w : sequenceW fs w