19

我正在编写一个作为守护进程运行的程序。为了创建守护程序，用户为每个所需的类（其中一个是数据库）提供一组实现。所有这些类都具有具有形式类型签名的函数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如果我编写这样的代码，该类型可以实现它包含的任何类：

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

但这当然不会编译。

我怀疑我的解决方案过于面向对象。有没有更好的办法？单子变压器，也许？提前感谢您的任何建议。

4

4 回答 4

30

如果您想使用像您的情况那样的大型全局状态，那么您想要使用的是镜头，正如 Ben 所建议的那样。我也推荐 Edward Kmett 的镜头库。但是，还有另一种可能更好的方法。

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

让我们将模块视为将Request转换为Response的东西：

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)

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

当然，您不需要重新发明它。Netwire库实现了这种设计模式，并带有一个预定义“模块”（称为线）的大型库。有关教程，请参阅Control.Wire模块。

于 2012-12-17T18:12:48.900 回答
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: ")

zoom不限于一种类型的直接子字段。由于镜头是可组合的，因此您只需执行以下操作即可在一次操作中任意缩放：

zoom (field1a . field2c . field3b . field4j) $ do ...
于 2012-12-17T22:38:03.117 回答
6

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

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

镜头技术最近取得了很大进步，现在它们的能力令人难以置信。在撰写本文时，最强大的库是 Edward Kmett 的lens库，它有点难以接受，但是一旦你找到了你想要的功能，它就非常简单了。您还可以在 SO 上搜索有关镜头的更多问题，例如，链接到镜头、fclabels、数据访问器的功能镜头- 用于结构访问和突变的库更好，或者镜头标签。

于 2012-12-17T14:50:30.103 回答
1

我创建了一个名为data-diverse-lens的镜头可扩展记录库，它允许像以下要点一样组合多个 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 ...
       ...
于 2018-04-14T12:23:25.047 回答