5

是否可以实现一个MonadTransControl实例FreeT？我从以下开始，但卡住了：

instance (Functor f) => MonadTransControl (FreeT f) where
  newtype StT (FreeT f) r = FreeTStT r
  liftWith unlift = lift $ unlift $ error "Stuck here"
  restoreT inner = do
    FreeTStT r <- lift inner
    return r

如果它无法实现，那么为什么以及是否有可能以某种方式扩展特定的自由函子实现以使其可实现？

4

1 回答 1

2

免责声明：例如，您需要Traversable f约束MonadTransControl。

警告：此答案中的实例不遵守所有法律MonadTransControl

语用和导入

{-# LANGUAGE TypeFamilies #-}

import qualified Data.Traversable as T
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Control
import Control.Monad.Trans.Free
import qualified Control.Monad.Free as F

自由一元状态

正如我在评论中所说，正确的“一元状态”FreeT f应该是Free f（来自 的那个Control.Monad.Free）：

instance T.Traversable f => MonadTransControl (FreeT f) where
  newtype StT (FreeT f) a = StTFreeT { getStTFreeT :: F.Free f a }

现在的执行restoreT有点变化：

  restoreT inner = do
    StTFreeT m <- lift inner
    F.toFreeT m

liftWith执行

在我们查看实现之前，让我们看看类型应该是什么liftWith：

liftWith :: Monad m => (Run (FreeT f) -> m a) -> FreeT f m a

而且Run (FreeT f)实际上是

forall n b. Monad n => FreeT f n b -> n (StTFreeT f b)

所以实现会是这样的：

liftWith unlift = lift $ unlift (liftM StTFreeT . pushFreeT)

剩下的很简单：

pushFreeT :: (T.Traversable f, Monad m) => FreeT f m a -> m (F.Free f a)
pushFreeT m = do
  f <- runFreeT m
  case f of
    Pure x -> return (return x)
    Free y -> liftM wrap $ T.mapM pushFreeT y

为什么Traversable？

如您所见，问题出在pushFreeT功能上：它使用T.mapM（traverse但有Monad约束）。为什么我们需要它？如果您查看定义，FreeT您可能会注意到（注意：这很粗略，我在这里忘记了Pure）：

FreeT f m a ~ m (f (m (f ... )))

由于pushFreeT我们需要m (Free f a)：

m (Free f a) ~ m (f (f (f ... )))

所以我们需要把所有f的s“推”到最后，把所有的s加入m头部。因此，我们需要一个操作，让我们f通过单个推送单个m，这正是T.mapM pushFreeT给我们的：

mapM :: (Monad m, Traversable t) => (a -> m b) -> t a -> m (t b)
mapM pushFreeT :: Traversable t => t (FreeT t m a) -> m (t (Free t a))

法律

每个类实例通常都有规律。MonadTransControl也不例外，所以让我们检查一下它们是否适用于这个实例：

liftWith . const . return = return
liftWith (const (m >>= f)) = liftWith (const m) >>= liftWith . const . f

这两条规律显然来自于规律MonadTrans和定义liftWith。

liftWith (\run -> run t) >>= restoreT . return = t

显然，这条定律不成立。这是因为t当我们pushFreeT. 因此，liftWith在所有层中实现的合并效果FreeT f m给我们留下了等价的m (Free f).

于 2014-05-19T21:00:33.957 回答