gistfile1.hs

class Comonad w where
    (=>>) :: w a -> (w a -> b) -> w b
    extract :: w a -> a

data T a = L a | B (T a) a (T a) deriving (Eq, Show)

unit :: a -> T a
unit = L

counit :: T a -> a
counit (L a)      = a
counit (B _ a _ ) = a

bind :: T a -> (a -> T b) -> T b
bind (L a)     f = f a
bind (B l a r) f = B (l `bind` f) (counit (f a)) (r `bind` f)

cobind :: T a -> (T a -> b) -> T b
cobind n@(L a)   f = return $ f n
cobind (B l a r) f = B (l `cobind` f) (f (unit a)) (r `cobind` f)

instance Monad T where
    return = unit
    (>>=)  = bind

instance Comonad T where
    extract = counit
    (=>>)   = cobind

instance Functor T where
    fmap f (L a)     = L (f a)
    fmap f (B l a r) = B (f `fmap` l) (f a) (f `fmap` r)