data FreeT (f :: (k -> *) -> k -> *) (g :: (k -> *)) (a :: k)
  = Done' (g a)
  | More' (f (FreeT f g) a)

class FFunctor t where
  ffmap :: (forall x. f x -> g x) -> t f a -> t g a

class FFunctor t => FMonad t where
  freturn :: f a -> t f a
  fbind :: (forall x. f x -> t g x) -> t f a -> t g a

instance FFunctor t => FFunctor (FreeT t) where
  ffmap f (Done' a) = Done' (f a)
  ffmap f (More' a) = More' (ffmap (ffmap f) a)

instance FFunctor t => FMonad (FreeT t) where
  freturn = Done'
  fbind f (Done' a) = f a
  fbind f (More' a) = More' (ffmap (fbind f) a)

foldFreeT
  :: (FFunctor f, FMonad t)
  => (forall x y. f y x -> t y x)
  -> FreeT f g a -> t g a
foldFreeT f (Done' a) = freturn a
foldFreeT f (More' a) = fbind (foldFreeT f) (f a)