免费的Monad Trans Control实例

时间:2014-05-19 18:10:21

标签: haskell monad-transformers free-monad

是否可以为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

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

1 个答案:

答案 0 :(得分:2)

免责声明:Traversable f个实例需要MonadTransControl约束。

警告:此答案中的实例不符合MonadTransControl 的所有法律

Pragma and imports

{-# 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”状态&#34; 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.mapMtraverse但约束Monad。为什么我们需要呢?如果你看一下FreeT的定义,你可能会注意到(注意:这很粗糙,我在这里忘了Pure

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

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

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

所以我们需要&#34;推动&#34;所有f到最后并加入头部的所有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

显然,这项法律不适用。这是因为我们tpushFreeT中的monad图层会折叠。因此,已实施的liftWith合并FreeT f m所有层中的效果,使我们等同于m (Free f)