Tree Comonad

TreeComonad.hs

class Functor f => Extend f where
  -- CoSelectMany
  extend ::
    (f a -> b)
    -> f a
    -> f b

  -- CoFlatten?
  duplicate ::
    f a
    -> f (f a)
  duplicate =
    extend id

class Extend f => Comonad f where
  counit ::
    f a
    -> a

data Tree a =
  Tree a [Tree a]

instance Functor Tree where
  fmap f (Tree x y) =
    Tree (f x) (map (fmap f) y)

instance Extend Tree where
  extend f t@(Tree _ y) =
    Tree (f t) (map (extend f) y)

instance Comonad Tree where
  counit (Tree x _) =
    x