Comonadic Binary Tree in Haskell

BinaryTreeComonad.hs

data BinaryTree3 v a
  = Node3 v a (BinaryTree3 v a) (BinaryTree3 v a)
  | Leaf3 v a
  deriving (Show)

-- Node3 (Node3 0 False (Node3 1 False (Leaf3 3 False) (Leaf3 4 False)) (Leaf3 2 True)) False
--   (Node3 (Node3 1 False (Leaf3 3 False) (Leaf3 4 False)) False
--     (Leaf3 (Leaf3 3 False) False)
--     (Leaf3 (Leaf3 4 False) False))
--   (Leaf3 (Leaf3 2 True) True)
duplicate :: BinaryTree3 v a -> BinaryTree3 (BinaryTree3 v a) a
duplicate n@(Node3 v a l r) =
  Node3 n a (duplicate l) (duplicate r)
duplicate l@(Leaf3 v a) =
  Leaf3 l a

extract :: BinaryTree3 v a -> v
extract (Node3 v a l r) = v
extract (Leaf3 v a) = v

fmap :: (v -> w) -> BinaryTree3 v a -> BinaryTree3 w a
fmap f (Node3 v a l r) = Node3 (f v) a (fmap f l) (fmap f r)
fmap f (Leaf3 v a) = Leaf3 (f v) a

extend :: (BinaryTree3 v a -> w) -> BinaryTree3 v a -> BinaryTree3 w a
extend f = fmap f . duplicate

merge [] ys = ys
merge (x : xs) ys = x : merge xs ys

toList :: BinaryTree3 v a -> [v]
toList (Node3 v a l r) =
  [v] `merge` toList l `merge` toList r
toList (Leaf3 v a) = [v]

branch0 =
  Node3
    (0 :: Int)
    False
    ( Node3
        (1 :: Int)
        False
        (Leaf3 (2 :: Int) False)
        (Leaf3 (3 :: Int) False)
    )
    (Leaf3 (4 :: Int) True)

increment (Node3 v a l r) = v + 1
increment (Leaf3 v a) = v + 1

main :: IO ()
main = do
  print $ toList $ extend increment branch0