Подтвердить что ты не робот

Может ли монадическое розовое дерево иметь экземпляр MonadFix?

Учитывая

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

Есть ли действительный экземпляр MonadFix?

Моя попытка была

instance MonadFix m => MonadFix (Tree m) where
  mfix f = Tree $ do
    Node
      <$> mfix (runTree . f . nodeValue) 
      <*> fmap nodeChildren (runTree (mfix f))

Но это, похоже, не заканчивается, когда я на самом деле пытаюсь его использовать. Экземпляр несколько вдохновлен экземпляром MonadFix для списков.

Ответ 1

Реальное решение действительно происходит от gallais с небольшой модификацией. Мы также подняли основную идею в библиотеке containers, с MonadFix Tree экземпляром здесь

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