Given
newtype Tree m a = Tree { runTree :: m (Node m a) }
data Node m a = Node
{ nodeValue :: a
, nodeChildren :: [Tree m a]
}
Is there a valid MonadFix
instance?
My attempt was
instance MonadFix m => MonadFix (Tree m) where
mfix f = Tree $ do
Node
<$> mfix (runTree . f . nodeValue)
<*> fmap nodeChildren (runTree (mfix f))
Yet this doesn't seem to terminate when I actually try and use it. The instance is somewhat inspired by the MonadFix
instance for lists.
The real solution really comes from gallais with a small modification. We lifted the core idea out into the containers
library too, with MonadFix Tree
instance here
{-# LANGUAGE DeriveFunctor #-}
module MonadTree where
import Control.Monad
import Control.Monad.Fix
newtype Tree m a = Tree { runTree :: m (Node m a) }
deriving (Functor)
data Node m a = Node
{ nodeValue :: a
, nodeChildren :: [Tree m a]
} deriving (Functor)
valueM :: Functor m => Tree m a -> m a
valueM = fmap nodeValue . runTree
childrenM :: Functor m => Tree m a -> m [Tree m a]
childrenM = fmap nodeChildren . runTree
joinTree :: Monad m => m (Tree m a) -> Tree m a
joinTree = Tree . join . fmap runTree
instance Monad m => Applicative (Tree m) where
pure a = Tree $ pure $ Node a []
(<*>) = ap
instance Monad m => Monad (Tree m) where
return = pure
m >>= k =
Tree $ do
Node x xs <- runTree m
Node y ys <- runTree (k x)
pure . Node y $
fmap (>>= k) xs ++ ys
instance MonadFix m => MonadFix (Tree m) where
mfix f = Tree $ do
node <- mfix $ \a -> do
runTree (f (nodeValue a))
let value = nodeValue node
let trees = nodeChildren node
let children = zipWith (\ k _ -> mfix (joinTree . fmap (!! k) . childrenM . f)) [0..] trees
return $ Node value children