为 RVarT 实现一个 MFunctor 实例

Question

是否可以为RVarT 实现MFunctor 实例？

到目前为止，我想出了以下几点：

{-# LANGUAGE RankNTypes #-}
import Data.RVar                        -- from rvar
import Control.Monad.Trans.Class (lift) -- from transformers

hoistRVarT :: Monad m => (forall t. n t -> m t) -> RVarT n a -> RVarT m a
hoistRVarT f rv = sampleRVarTWith (lift . f) rv

但是，这不能用作MFunctor 的hoist 的定义，因为lift 对m 产生了Monad 约束。问题是，如果没有lift，我找不到另一种方法将生成的单子提升到RVarT。但我认为从概念上讲它应该是可能的，因为RVarT 应该类似于StateT，并且StateT 有一个MFunctor 实例。问题是我在 rvar 或 random-fu 的 API 中找不到任何暴露此类功能的内容。

Answer 1

RVarT m a 是PromptT Prim m a 的newtype，其中PromptT 在Control.Monad.Prompt 中定义。 PromptT Prim m a 是 newtype 的 Prompt (Lift Prim m) a。这又是一个newtype 用于

forall b. (a -> b) -> (forall x. Lift Prim m x -> (x -> b) -> b) -> b

你可以用unsafeCoerce解开整个东西：

fromRVarT :: RVarT m a -> (a -> b) -> (forall x. Lift Prim m x -> (x -> b) -> b) -> b
fromRVarT = unsafeCoerce

toRVarT :: (forall b. (a -> b) -> (forall x. Lift Prim m x -> (x -> b) -> b) -> b) -> RVarT m a
toRVarT = unsafeCoerce

Prim 没有被导出，但是由于您一开始就不需要触摸它，并且您正在使用unsafeCoerce 组装和拆卸整个东西，您可以定义：

data Prim a

您可以为Lift 编写一个MFunctor 实例：

instance MFunctor (Lift f) where
  hoist _ (Effect p) = Effect p
  hoist phi (Lift m) = Lift (phi m)

然后你可以解开RVarT，将所有Lifts 传递给它的提示函数，然后再次包装：

instance MFunctor RVarT where
  hoist phi rv = toRVarT $ \done prm -> fromRVarT rv done (\l -> prm $ hoist phi l)

Answer 2

如果您不需要在没有 m 的 monad 实例的情况下实际使用值 RVarT m，我发现了一个适用于这种情况和类似情况的技巧。它的工作原理是推迟自然变换的应用，直到我们真正需要得到一个值。如果有合适的实例还是不错的。

{-# LANGUAGE RankNTypes, ExistentialQuantification #-}

import Data.RVar
import Control.Monad.Trans.Class (lift)
import Control.Monad.Morph
import Control.Monad (ap)

hoistRVarT :: Monad m => (forall t. n t -> m t) -> RVarT n a -> RVarT m a
hoistRVarT f = sampleRVarTWith (lift . f)

data RVarTFun m a = forall n. RVarTFun 
  { transformation :: forall t. n t -> m t
  , rvart :: RVarT n a }

-- You can only get a value out if you have a monad for m.
getRVarTFun :: Monad m => RVarTFun m a -> RVarT m a
getRVarTFun (RVarTFun t ma) = hoistRVarT t ma

wrapRVarTFun :: RVarT m a -> RVarTFun m a
wrapRVarTFun = RVarTFun id

-- Actually the result is slightly stronger than MFunctor because we don't need
-- a Monad on n.
hoistRVarTFun :: (forall t. n t -> m t) -> RVarTFun n a -> RVarTFun m a
hoistRVarTFun f (RVarTFun t nx) = RVarTFun (f . t) nx

instance MFunctor RVarTFun where
  hoist = hoistRVarTFun

可以在here 找到更通用的实现。