在StateT中合并多个状态

Question

我正在编写一个作为守护进程运行的程序。为了创建守护进程，用户为每个必需的类(其中一个是数据库)提供了一组实现，所有这些类都有表单StateT s IO a的类型签名，但是每个类的s是不同的。

假设每个类都遵循以下模式：

import Control.Monad (liftM)
import Control.Monad.State (StateT(..), get)

class Hammer h where
  driveNail :: StateT h IO ()

data ClawHammer = MkClawHammer Int -- the real implementation is more complex

instance Hammer ClawHammer where
  driveNail = return () -- the real implementation is more complex

-- Plus additional classes for wrenches, screwdrivers, etc.

现在，我可以定义一个记录，它表示用户为每个“时隙”选择的实现。

data MultiTool h = MultiTool {
    hammer :: h
    -- Plus additional fields for wrenches, screwdrivers, etc.
  }

守护进程的大部分工作都是在StateT (MultiTool h ...) IO () monad中完成的。

现在，由于multitool包含一个锤子，我可以在需要锤子的任何情况下使用它。换句话说，如果我编写如下代码，MultiTool类型可以实现它包含的任何类：

stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g

withHammer :: StateT h IO () -> StateT (MultiTool h) IO ()
withHammer runProgram = do
  t <- get
  stateMap (\h -> t {hammer=h}) hammer runProgram

instance Hammer h => Hammer (MultiTool h) where
  driveNail = withHammer driveNail

但是withHammer、withWrench、withScrewdriver等的实现基本上是相同的。很高兴能写出这样的东西.

--withMember accessor runProgram = do
--  u <- get
--  stateMap (\h -> u {accessor=h}) accessor runProgram

-- instance Hammer h => Hammer (MultiTool h) where
--   driveNail = withMember hammer driveNail

但这当然不能编译。

我怀疑我的解决方案过于面向对象。有更好的办法吗？也许是Monad变压器？谢谢您的任何建议。

Answer 1

如果你想要像你这样的大的全局状态，那么你想要使用的是透镜，就像Ben建议的那样。我也推荐Edward的镜头库。然而，还有另一种，也许更好的方法。

服务器具有程序连续运行的属性，并在状态空间上执行相同的操作。当您想要模块化服务器时，麻烦就开始了，在这种情况下，您需要的不仅仅是某种全局状态。你想让模块有自己的状态。

让我们把模块看作是将请求转换为响应的东西

Module :: (Request -> m Response) -> Module m

现在，如果它有某种状态，那么这个状态就会被注意到，因为下一次模块可能会给出一个不同的答案。有几种方法可以做到这一点，例如：

Module :: s -> ((Request, s) -> m (Response s)) -> Module m

但是一种更好、更等价的表达方法是下面的构造函数(我们很快就会围绕它构建一个类型)：

Module :: (Request -> m (Response, Module m)) -> Module m

此模块将请求映射到响应，但在此过程中还会返回其自身的新版本。让我们更进一步，提出请求和响应多态：

Module :: (a -> m (b, Module m a b)) -> Module m a b

现在，如果一个模块的输出类型与另一个模块的输入类型匹配，那么您可以像常规函数一样组合它们。这种组合是相联的，具有多态同一性。这听起来很像一个类别，实际上是这样的！它是一个范畴，一个应用函子和一个箭头。

newtype Module m a b =
    Module (a -> m (b, Module m a b))

instance (Monad m) => Applicative (Module m a)
instance (Monad m) => Arrow (Module m)
instance (Monad m) => Category (Module m)
instance (Monad m) => Functor (Module m a)

我们现在可以组成两个模块，它们有自己的本地状态，甚至不知道！但这还不够。我们想要更多。那么可以在其中切换的模块呢？让我们扩展我们的小模块系统，这样模块实际上可以选择不给出答案：

newtype Module m a b =
    Module (a -> m (Maybe b, Module m a b))

这允许另一种与(.)正交的组合形式:现在，我们的类型也是Alternative函子的一个家族：

instance (Monad m) => Alternative (Module m a)

现在，模块可以选择是否响应请求，如果不响应，则将尝试下一个模块。很简单。你刚刚重新发明了线材的种类。=)

你当然不需要重新发明这个了。内特维尔库实现了这个设计模式，并附带了一个由预定义的“模块”(称为连线)组成的大型库。有关教程，请参阅Control.Wire模块。

Answer 2

下面是一个具体的例子，说明如何像其他人所说的那样使用lens。在下面的代码示例中，Type1是本地状态(即您的锤子)，Type2是全局状态(即您的多工具)。lens提供了zoom函数，它允许您运行本地化状态计算，该计算可以放大透镜定义的任何字段：

import Control.Lens
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State

data Type1 = Type1 {
    _field1 :: Int   ,
    _field2 :: Double}

field1 :: SimpleLens Type1 Int
field1 = lens _field1 (\x a -> x { _field1 = a})

field2 :: SimpleLens Type1 Double
field2 = lens _field2 (\x a -> x { _field2 = a})

data Type2 = Type2 {
    _type1  :: Type1 ,
    _field3 :: String}

type1 :: SimpleLens Type2 Type1
type1 = lens _type1 (\x a -> x { _type1 = a})

field3 :: SimpleLens Type2 String
field3 = lens _field3 (\x a -> x { _field3 = a})

localCode :: StateT Type1 IO ()
localCode = do
    field1 += 3
    field2 .= 5.0
    lift $ putStrLn "Done!"

globalCode :: StateT Type2 IO ()
globalCode = do
    f1 <- zoom type1 $ do
        localCode
        use field1
    field3 %= (++ show f1)
    f3 <- use field3
    lift $ putStrLn f3

main = runStateT globalCode (Type2 (Type1 9 4.0) "Hello: ")

zoom不限于类型的直接子字段。由于镜片是可合成的，你可以在一次手术中放大到你想要的深度，只需做以下操作：

zoom (field1a . field2c . field3b . field4j) $ do ...

Answer 3

这听起来很像镜片的应用。

镜片是某些数据子字段的规范.其思想是您有一些值toolLens，并且函数view和set，以便view toolLens :: MultiTool h -> h获取该工具，set toolLens :: MultiTool h -> h -> MultiTool h用一个新的值替换它。然后，您可以轻松地将您的withMember定义为只接受镜头的函数。

镜头技术最近有了很大的进步，现在他们已经有了难以置信的能力。在编写本报告时，最强大的库是Edward的lens库，这个库有点难以下咽，但是一旦您找到您想要的特性，它就很简单了。你也可以在这里搜索更多关于镜头的问题，例如功能透镜链接到镜片，fclabels，数据存取器，用于结构访问和突变的库更好。，或者镜片标签。