13

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.

ocharles
  • 6,172
  • 2
  • 35
  • 46
  • 1
    What would the `Monad (Tree m)` look like to begin with? – gallais Dec 15 '17 at 15:03
  • See http://hackage.haskell.org/package/hedgehog-0.5.1/docs/Hedgehog-Internal-Tree.html#t:Tree - this is the `Tree` I'm trying to add `MonadFix` to. – ocharles Dec 15 '17 at 15:16
  • 1
    Ok, [I may have something for you](https://gist.github.com/gallais/4c59b949c743c0a85cab55dcb73aaf7c) 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. – gallais Dec 15 '17 at 15:37
  • Very interesting, I'll give that a try and see what the behavior is. – ocharles Dec 15 '17 at 15:46
  • Unfortunately @gallais 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). – ocharles Dec 16 '17 at 12:24
  • 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). – gallais Dec 16 '17 at 12:33
  • 1
    @gallais I think this is the fix: https://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`. – ocharles Dec 16 '17 at 12:43
  • 1
    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? – dfeuer Dec 16 '17 at 23:25
  • @dfeuer more like CofreeT [], no? – ocharles Dec 17 '17 at 00:06
  • 1
    @ocharles, ah, yes, I mixed sums with products. Please apply my question to the type I should have meant! – dfeuer Dec 17 '17 at 01:01
  • @ocharles since you have the solution, mind posting it as an answer and accepting it? – sclv Feb 02 '18 at 22:28
  • @sclv done, thanks for the reminder. – ocharles Feb 05 '18 at 11:21

1 Answers1

2

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
ocharles
  • 6,172
  • 2
  • 35
  • 46