在StateT组合多个国家(Combining multiple states in StateT)

我写的是作为后台进程运行的程序。 为了创建守护程序，用户提供了一组实施方案中的每一个所需的类（它们中的一个是一个数据库）所有这些类的具有函数具有以下形式的式签名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 ()单子。

现在，由于多刀包含一个锤子，我可以在需要锤子任何情况下使用它。 换句话说，该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的建议。 我也建议爱德华Kmett的镜头库。 然而，还有另外一个，也许是更好的方式。

服务器具有程序连续运行，并在状态空间执行相同的操作属性。 麻烦的开始，当你想模块化服务器，在这种情况下，你需要的不仅仅是一些全球性状态的更多。 你想要的模块有自己的状态。

让我们考虑一个模块的东西，其转换一个请求的响应 ：

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

现在，如果它有一些国家，那么这个国家成为该模块可能会给出不同的答案，下一次noticable。 有许多方法可以做到这一点，例如以下内容：

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)

现在，一个模块可以选择是否响应请求，如果没有，下一个模块将受到审判。 简单。 你刚才又彻底改造了电线类。 =）

当然，你并不需要彻底改造这个。 所述Netwire库实现这样的设计图案，并配备了预定义的“模块”（称为线）大的库。 见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的功能只是接受镜头。

镜头技术最近提出了一个伟大的交易，他们现在令人难以置信的能力。 在写作的时候身边最有力的库是爱德华Kmett的lens库中，这是一个有点很难接受，但相当简单，一旦你找到你想要的功能。 您也可以搜索有关的镜头在这里让更多的问题，比如功能的镜头可链接到镜头，fclabels，数据访问-这库结构访问和突变是更好的 ，或者镜头标记。

Answer 4:

我创建称为带透镜的可扩展记录库数据多样透镜 ，其允许组合多个ReaderT（或StateT）这样要旨 ：

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Lens
import Control.Monad.Reader
import Control.Monad.State
import Data.Diverse.Lens
import Data.Semigroup

foo :: (MonadReader r m, HasItem' Int r, HasItem' String r) => m (Int, String)
foo = do
    i <- view (item' @Int) -- explicitly specify type
    s <- view item' -- type can also be inferred
    pure (i + 10, s <> "bar")

bar :: (MonadState s m, HasItem' Int s, HasItem' String s) => m ()
bar = do
    (item' @Int) %= (+10) -- explicitly specify type
    item' %= (<> "bar") -- type can also be inferred
    pure ()

main :: IO ()
main = do
    -- example of running ReaderT with multiple items
    (i, s) <- runReaderT foo ((2 :: Int) ./ "foo" ./ nil)
    putStrLn $ show i <> s -- prints out "12foobar"
    -- example of running StateT with multiple items
    is <- execStateT bar ((2 :: Int) ./ "foo" ./ nil)
    putStrLn $ show (view (item @Int) is) <> (view (item @String) is) -- prints out "12foobar"

Data.Has是做同样的元组用一个简单的库。 从库中头版例如：

 {-# LANGUAGE FlexibleContexts #-}

 -- in some library code
 ...
 logInAnyReaderHasLogger :: (Has Logger r, MonadReader r m) => LogString -> m ()
 logInAnyReaderHasLogger s = asks getter >>= logWithLogger s

 queryInAnyReaderHasSQL :: (Has SqlBackEnd r, MonadReader r m) => Query -> m a
 queryInAnyReaderHasSQL q = asks getter >>= queryWithSQL q
 ...

 -- now you want to use these effects together
 ...
 logger <- initLogger  ...
 sql <- initSqlBackEnd ...

 (`runReader` (logger, sql)) $ do
       ...
       logInAnyReaderHasLogger ...
       ...
       x <- queryInAnyReaderHasSQL ...
       ...  

文章来源: Combining multiple states in StateT