Multiway Trees

RoseTree.hs

{-# LANGUAGE InstanceSigs #-}

-- Rose Trees
data Tree a =
  a :> [Tree a]
  deriving (Eq, Show)

singleton :: a -> Tree a
singleton = (:> [])

instance Functor Tree where
  fmap :: (a -> b) -> Tree a -> Tree b
  fmap f (x :> xs) = (f x) :> fmap (f <$>) xs

instance Applicative Tree where
  pure :: a -> Tree a
  pure = singleton
  (<*>) :: Tree (a -> b) -> Tree a -> Tree b
  (f :> fs) <*> t@(x :> xs) = (f x) :> fxs
    where
      fxs = map (f <$>) xs ++ map (<*> t) fs

instance Foldable Tree where
  foldMap :: Monoid m => (a -> m) -> Tree a -> m
  foldMap f (x :> xs) = f x <> foldMap (foldMap f) xs

instance Monad Tree where
  return :: a -> Tree a
  return = pure
  (>>=) :: Tree a -> (a -> Tree b) -> Tree b
  (x :> xs) >>= f =
    case f x of
      x' :> xs' -> x' :> (xs' ++ map (>>= f) xs)