在StateT中组合多个状态

mhw*_*bat 16 state haskell

我正在编写一个作为守护进程运行的程序.要创建守护程序,用户为每个必需的类提供一组实现(其中一个是数据库)所有这些类的函数都具有表单的类型签名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.
Run Code Online (Sandbox Code Playgroud)

现在我可以定义一条记录,表示用户为每个"槽"选择的实现.

data MultiTool h = MultiTool {
    hammer :: h
    -- Plus additional fields for wrenches, screwdrivers, etc.
  }
Run Code Online (Sandbox Code Playgroud)

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

现在,由于多功能工具包含一把锤子,我可以在任何需要锤子的情况下使用它.换句话说,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
Run Code Online (Sandbox Code Playgroud)

但是的实现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
Run Code Online (Sandbox Code Playgroud)

但当然不会编译.

我怀疑我的解决方案过于面向对象.有没有更好的办法?可能是Monad变形金刚?提前感谢您的任何建议.

小智 28

如果你想像你的情况一样处于一个大的全球状态,那么你想要使用的是镜头,正如Ben所建议的那样.我也推荐Edward Kmett的镜头库.然而,还有另一种可能更好的方法.

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

让我们将模块视为将请求转换为响应的东西:

Module :: (Request -> m Response) -> Module m
Run Code Online (Sandbox Code Playgroud)

现在,如果它有一些状态,那么这个状态变得明显,因为模块可能在下次给出不同的答案.有很多方法可以做到这一点,例如:

Module :: s -> ((Request, s) -> m (Response s)) -> Module m
Run Code Online (Sandbox Code Playgroud)

但是表达这个的更好和等效的方法是以下构造函数(我们将很快构建一个类型):

Module :: (Request -> m (Response, Module m)) -> Module m
Run Code Online (Sandbox Code Playgroud)

此模块将请求映射到响应,但沿途还会返回自身的新版本.让我们更进一步,使请求和响应多态:

Module :: (a -> m (b, Module m a b)) -> Module m a b
Run Code Online (Sandbox Code Playgroud)

现在,如果模块的输出类型与另一个模块的输入类型匹配,那么您可以像常规函数一样组合它们.该组合物是关联的并且具有多态性身份.这听起来很像一个类别,事实上它是!它是一个类别,一个应用函子和一个箭头.

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)
Run Code Online (Sandbox Code Playgroud)

我们现在可以编写两个具有各自本地状态的模块,甚至不知道它!但这还不够.我们想要更多.可以切换的模块怎么样?让我们扩展我们的小模块系统,使模块实际上可以选择给出答案:

newtype Module m a b =
    Module (a -> m (Maybe b, Module m a b))
Run Code Online (Sandbox Code Playgroud)

这允许另一种形式的组合正交于(.):现在我们的类型也是一个Alternative仿函数族:

instance (Monad m) => Alternative (Module m a)
Run Code Online (Sandbox Code Playgroud)

现在,模块可以选择是否响应请求,如果不响应,则尝试下一个模块.简单.你刚刚彻底改造了电线类别.=)

当然你不需要重新发明这个.所述Netwire库实现这种设计模式,并配备了预定义的"模块"(称为电线)的大型文库.有关教程,请参阅Control.Wire模块.


Gab*_*lez 17

这是一个如何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: ")
Run Code Online (Sandbox Code Playgroud)

zoom不仅限于某种类型的直接子字段.由于镜头是可组合的,因此只需执行以下操作即可在一次操作中进行任意深度缩放:

zoom (field1a . field2c . field3b . field4j) $ do ...
Run Code Online (Sandbox Code Playgroud)


Ben*_*ood 6

这听起来非常像镜头的应用.

镜头是某些数据的子场的规范.这个想法是你有一些价值toolLens和功能view,set所以view toolLens :: MultiTool h -> h拿起工具并set toolLens :: MultiTool h -> h -> MultiTool h用一个新值替换它.然后,您可以轻松地将您定义withMember为仅接受镜头的功能.

镜头技术最近已经取得了很大的进步,现在它们具有令人难以置信的能力.在撰写本文时,最强大的图书馆是爱德华·凯梅特(Edward Kmett)的lens图书馆,它有点可以吞下,但是一旦找到你想要的功能就会非常简单.您还可以在此处搜索有关镜头的更多问题,例如与镜头,fclabels,数据访问器相关的功能镜头- 用于结构访问和变异的库更好,或镜头标签.