为类似 ReaderT 的 monad 转换器编写 "zooming" 函数

Writing a "zooming" function for a ReaderT-like monad transformer

我有这个类似于 ReaderT 的 monad 转换器(灵感来自 答案):

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
import Control.Monad.Reader -- from "mtl"
import Data.Kind (Type)

type DepT :: ((Type -> Type) -> Type) -> (Type -> Type) -> Type -> Type
newtype DepT env m r = DepT {toReaderT :: ReaderT (env (DepT env m)) m r}
  deriving (Functor, Applicative, Monad, MonadReader (env (DepT env m)))

instance MonadTrans (DepT env) where
  lift = DepT . lift

这两个参数化记录,我给了"rank-2 functor"个实例:

{-# LANGUAGE TemplateHaskell #-}
import qualified Rank2 -- form rank2classes
import qualified Rank2.TH

type Env :: (Type -> Type) -> Type
data Env m = Env
  { logger :: String -> m (),
    logic :: Int -> m Int
  }
$(Rank2.TH.deriveFunctor ''Env)

type BiggerEnv :: (Type -> Type) -> Type
data BiggerEnv m = BiggerEnv
  { inner :: Env m,
    extra :: Int -> m Int
  }
$(Rank2.TH.deriveFunctor ''BiggerEnv)

直觉上,我希望能够编写一个类型为以下的转换函数:

zoom :: forall a. DepT Env IO a -> DepT BiggerEnv IO a

这是因为 DepT Env IO a 使用的信息比 DepT BiggerEnv IO a 少。

但我卡住了。有没有办法写成zoom?

首先,我们可以创建一个更通用的函数,withDepT,它类似于 withReaderT 函数。

withDepT :: forall env env' m a.
            (env' (DepT env' m) -> env (DepT env m))
            -> DepT env m a
            -> DepT env' m a
withDepT f (DepT m) = DepT (withReaderT f m)

然后我们可以使用它来实现zoom,方法是提供如下函数:

biggerEnvToEnv :: BiggerEnv (DepT BiggerEnv IO) -> Env (DepT Env IO)
biggerEnvToEnv (BiggerEnv (Env logger logic) _) = Env logger' logic'
  where
    logger' = mystery . logger
    logic' = mystery . logic

zoom = withDepT biggerEnvToEnv

但是接下来我们需要实施mystery。让我们看看它的类型:

mystery :: forall a. DepT BiggerEnv IO a -> DepT Env IO a

现在我们可以看到 mystery 与我们想​​要的 zoom 函数相反:

zoom :: forall a. DepT Env IO a -> DepT BiggerEnv IO a

所以我们可以得出结论,除非 BiggerEnvEnv 是同构的,否则不可能自然地推导出 zoom,而它们不是因为 extra 中的值BiggerEnv.

一般的解决方案是这样的函数:

withDepT ::
  forall small big m a.
  Monad m =>
  ( forall p q.
    (forall x. p x -> q x) ->
    small p ->
    small q
  ) ->
  (forall t. big t -> small t) ->
  DepT small m a ->
  DepT big m a
withDepT mapEnv inner (DepT (ReaderT f)) =
  DepT
    ( ReaderT
        ( \big ->
            let small :: small (DepT small m)
                -- we have a big environment at hand, so let's extract the
                -- small environment, transform every function in the small
                -- environment by supplying the big environment and, as a
                -- finishing touch, lift from the base monad m so that it
                -- matches the monad expected by f.
                small = mapEnv (lift . flip runDepT big) (inner big)
             in f small
        )
    )

Env 的情况下,第一个参数是

这样的函数
mapEnv :: (forall x. n x -> m x) -> Env n -> Env m
mapEnv f (Env {logger,logic}) =
    Env { logger = f . logger, logic = f . logic }

它改变了环境的单子。 mapEnv 对应 Rank2.<$> from rank2classes.