组合多个状态/读取器单子的最佳方式？

Question

我正在编写一个项目，涉及组成多个堆栈StateT和ReaderT单子：

newtype FooT m a = FooT { unFooT :: (StateT State1 (ReaderT Reader1 m)) a }

newtype BarT m a = BarT { unBarT :: (StateT State2 (ReaderT Reader2 m)) a }

然后，我基本上只是运行所有内容FooT (BarT m)并根据需要提升到适当的 monad。我用来lens与各种状态/阅读器类型进行交互：

foo :: Monad m => FooT m ()
foo = do
  field1 .= ... -- where field1 is a lens into State1
  ...

然而，当我添加更多StateT+ReaderT变压器时，这种方法变得丑陋（并且似乎可能会产生一些性能成本）。

到目前为止，我唯一的想法是将以下状态结合起来：

newtype BazT m a = BazT { unBazT :: StateT (State1, State2) (ReaderT (Reader1, Reader2) m)) a }

然后我就可以用更多的镜头投射到状态类型中。

foo :: Monad m => BazT m ()
foo = do
  (_1 . field1) .= ... -- where field1 is a lens into State1
  ...

有没有一种规范的方法来组合这样的多个状态？如果可能的话，我想避免修改所有镜头代码。

Answer 1

如果您碰巧在同一上下文中经常处理这两种状态，则应该将这些状态组合起来，因为它们适合一种功能。

堆栈通常一次封装一种功能。因此，在一个堆栈中，您通常最多需要每个 monad 转换器一次。

要封装堆栈，您必须确保内部变压器不会暴露在外面。这样，您的堆栈就可以进一步组合。

有关如何封装 monad 堆栈的完整示例：

{-# LANGUAGE UndecidableInstances #-} -- Needed for all things around transformers.
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Except
import Control.Applicative


data Reader1 = Reader1
data State1 = State1

newtype FooT m a = FooT { unFooT :: (StateT State1 (ReaderT Reader1 m)) a }
  deriving
    ( Functor, Applicative, Monad, Alternative
    , MonadWriter w, MonadError e, MonadIO
    -- ..
    )
  -- Note that Reader and State are not derived automatically.
  -- Instead, the instances are lifted past its inside manually.

instance MonadTrans FooT where
  lift = FooT . lift . lift

instance MonadState s m => MonadState s (FooT m) where
  get = lift $ get
  put = lift . put

instance MonadReader r m => MonadReader r (FooT m) where
  ask = lift $ ask
  local f = mapFooT $ mapStateT $ mapReaderT $ local f
    where
      mapFooT g = FooT . g . unFooT


-- Your class that provides the functionality of the stack.
class Monad m => MonadFoo m where
  fooThings :: m Reader1
  -- ...

-- Access to the inside of your stack, to implement your class.
instance Monad m => MonadFoo (FooT m) where
  fooThings = FooT $ ask


-- Boilerplate to include all the typical transformers,
-- so that MonadFoo can be accessed and derived through them.
instance MonadFoo m => MonadFoo (ReaderT r m) where
  fooThings = lift $ fooThings

instance MonadFoo m => MonadFoo (StateT s m) where
  fooThings = lift $ fooThings

-- ..... instances for all the other common transformers go here ..


-- Another stack, that can now derive MonadFoo.
data Reader2 = Reader2
data State2 = State2

newtype BarT m a = BarT { unBarT :: (StateT State2 (ReaderT Reader2 m)) a }
  deriving
    ( Functor, Applicative, Monad, Alternative
    , MonadWriter w, MonadError e, MonadIO
    , MonadFoo
    )

-- Bar class and related instances would follow here as before.


-- A new stack that can make use of Bar and Foo, preferably through their classes.
newtype BazT m a = BazT { unBazT :: BarT (FooT m) a }

-- Baz can have its own ReaderT and StateT transformers,
-- without interfering with these in FooT and BarT.

正如您所看到的，它需要相当多的样板代码。如果是内部代码，您可以省略一些样板文件。如果您编写一个库，您的用户会欣赏它。

各种包解决了样板问题。