haskell – FreeT的MonadTransControl实例

2019年8月4日 174次阅读

是否可以为
FreeT实施
MonadTransControl实例？我从以下开始,但卡住了：

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

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

最佳答案 免责声明：事实证明,您需要MonadTransControl实例的Traversable f约束.

警告：此答案中的实例不遵守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

自由的monadic状态

正如我在评论中所说,FreeT f的正确“monadic状态”应该是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实现

在我们查看实现之前,让我们看看lift的类型应该是什么：

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

为什么可穿越？

正如您所看到的,问题在于pushFreeT函数：它使用T.mapM(它是遍历但具有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

显然,这项法律并不成立.这是因为当我们pushFreeT时,t中的monad层会崩溃.因此,实现的liftWith在FreeT fm的所有层中合并效果,使我们相当于m(Free f).

点赞