Haskell 一元玫瑰树可以有一个MonadFix实例吗？

给定

是否存在有效的

MonadFix

实例

我的尝试失败了

newtype Tree m a = Tree { runTree :: m (Node m a) }
data Node m a = Node
  { nodeValue :: a
  , nodeChildren :: [Tree m a] 
  }

instance MonadFix m=>MonadFix（树m）其中
mfix f=树$do
节点
mfix（runTree.f.nodeValue）
fmap节点儿童（运行树（mfix f））

---

然而，当我真正尝试使用它时，它似乎并没有终止。该实例在某种程度上受到了列表的MonadFix实例的启发。

真正的解决方案实际上来自于一个小小的修改。我们使用

MonadFix树

实例将核心思想提升到

容器

库中

{-#语言派生函子#-}
模块MonadTree在哪里
进口管制
导入控制.Monad.Fix
newtype Tree ma=树{runTree:：m（节点ma）}
派生（函子）
数据节点MA=节点
{nodeValue:：a
，nodeChildren:：[treema]
}派生（函子）
valueM:：函子m=>树MA->MA
值M=fmap节点值。runTree
子函数m=>树MA->m[树MA]
childrenM=fmap节点儿童。runTree
joinTree:：Monad m=>m（树MA）->树MA
joinTree=树。参加fmap运行树
实例Monad m=>Applicative（树m），其中
纯a=树$pure$节点a[]
（）=ap
实例Monad m=>Monad（树m）其中
返回=纯
m>>=k=
树$do
节点x xs=k）xs++ys
实例MonadFix m=>MonadFix（树m），其中
mfix f=树$do
节点do
运行树（f（节点值a））
let value=nodeValue节点
let trees=nodeChildren节点
让children=zipWith（\k_uu->mfix（joinTree.fmap（！！k.childrenM.f））树[0..]
返回$Node值子节点

单子（树m）的开头是什么样子的？好吧。这是基于我对

MonadFix[]

的理解：在

f

上使用

fix

获取顶层的形状，并通过递归调用子位置上的

mfix

生成子树，修改后的

f

精确定位每个位置。我很有信心它对

树标识做了正确的事情，但是我不确信我没有过早地强制执行一些
m
操作，因为我推断是
树m
的语义。@gallais我认为这是修复方法：。您需要
mfix
而不是
fix
，因此
m
也必须是
MonadFix
。这至少满足了我在
IO
中的上述示例。这种类型闻起来很像
FreeT[]
。它是？如果是这样，如果你给出的实例是有效的，在什么情况下，
FreeT f m
可以有一个有效的
MonadFix
实例？@ocharles，啊，是的，我把和和与积混合了。请把我的问题应用到我本该问的类型上！
instance MonadFix m => MonadFix (Tree m) where
  mfix f = Tree $ do
    Node
      <$> mfix (runTree . f . nodeValue) 
      <*> fmap nodeChildren (runTree (mfix f))

{-# 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