FreeT的MonadTransControl实例

Question

是否可以为实现一个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

如果它无法实现，那么为什么并且可以通过某种方式扩展特定的自由函子实现以使其可以实现？

Answer 1

免责声明：例如，事实证明您需要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 ... )))

所以我们需要将所有的fs“推”到最后，并将所有的ms连接到头部。因此，我们需要一个操作来让我们将单个推入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).