Can a monadic rose tree have a MonadFix instance?

Question

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.

Matrimony

What would the Monad (Tree m) look like to begin with? – Swineherd

See hackage.haskell.org/package/hedgehog-0.5.1/docs/… - this is the Tree I'm trying to add MonadFix to. – Matrimony

Ok, I may have something for you then. It is based on my understanding of MonadFix []: use fix on f to grab the shape of the top layer, and generate the subtrees by calling mfix recursively on the subpositions with a modified f that targets each position precisely. I'm pretty confident that it does the right thing for Tree Identity however I'm not convinced I'm not forcing some m actions too early wrt what I infer is the Tree m's semantics. – Swineherd

Very interesting, I'll give that a try and see what the behavior is. – Matrimony

Unfortunately @Swineherd that doesn't seem quite right. I tried out your file and then ran: nodeValue <$> runTree (mfix (const (return ())), which I believe should just be () (using return for Tree just creates a Node with a value and no children). In fact, it actually just blows the stack with a stack overflow exception (how appropriate). – Matrimony

It indeed doesn't work with m equal to IO but I tested it with Identity or State Int and it seems to be working out. I wonder what's special about IO (or whether we can find other failing examples). – Swineherd

@Swineherd I think this is the fix: gist.github.com/ocharles/9b6fb71669de4533373a9c7f1f3ce8f9. You need to mfix rather fix, and hence m must also be MonadFix. That at least satisfies my above example in IO. – Matrimony

This type smells a lot like FreeT []. Is it? If so, and if the instance you give is valid, under what circumstances can FreeT f m have a valid MonadFix instance? – Meimeibers

@Meimeibers more like CofreeT [], no? – Matrimony

@ocharles, ah, yes, I mixed sums with products. Please apply my question to the type I should have meant! – Meimeibers

@Matrimony since you have the solution, mind posting it as an answer and accepting it? – Nichani

@Nichani done, thanks for the reminder. – Matrimony

Answer 1

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

Matrimony