如何在哈斯克尔中编写有状态的dbus方法?

Question

我正在哈斯克尔使用 dbus，但我很难弄清楚如何导出执行有状态操作的 dbus 方法。下面是一个完全充实的示例来说明我卡在哪里。

---

假设您正在使用 dbus 编写计数器服务。当服务启动时，计数器最初为 0。该服务定义一个 dbus API，该 API 公开一个返回计数器的当前值的count方法，以及一个递增该计数器并返回新值的update方法。

下面是我刚才描述的行为的伪代码实现，使用消息传递通信方式：

-- | Updates the given integer. 
update :: Int -> Int
update = (+1)
-- | main function with message-passing-style communication
mainLoop :: Int -> IO Int
mainLoop state = do
case receiveMessage of
"update" -> do -- increment / update counter
sendReply $ update state
mainLoop $ update state -- recurse
"count" -> do -- return counter value
sendReply state
mainLoop state
"stop" -> do -- stop the counting service
exitSuccess
main :: IO ()
main = do
mainLoop 0

但是，dbus 使用方法调用，而不是消息传递。因此，我需要能够导出一个与我的消息传递示例中相同的count和update方法。

我们将使用的存根是这样的：

-- | Updates the given integer. 
update :: Int -> Int
update = (+1)
main :: IO ()
main = do
let initialState = 0
dbus <- connectSession
export dbus "/org/counter/CounterService"
[ autoMethod "org.counter.CounterService" "update" ({-- call update? --})
, autoMethod "org.counter.CounterService" "count" ({-- return state? --}) ]

这就是我的问题：我应该如何对缺失的{-- call update? --}和{-- return state? --}函数进行编码？

我知道我可以使用MVar来创建全局可变状态，然后只是让函数从中读取，但我想在这里尽可能避免可变性。我想我可以以某种方式使用 Reader/State monad 来做到这一点，也许是通过在函数中潜入get/ask，但我不知道如何处理与 DBus 相关的类型。

Answer 1

最终，dbus包只允许您export类型Method的方法，它有一个返回 monadic 值的methodHandler字段：

DBusR Reply === ReaderT Client IO Reply

而且那里没有空间让你挤进你自己的StateTmonad。 您可以改为导出Property，但这对您没有帮助，因为该类型的字段还涉及获取和设置属性IO操作。

因此，保持你的状态IO，很可能是一个MVar，几乎是不可避免的。

您可以尝试将纯"核心"与 IO shell 分开。 一种方法(根据@HTNW的评论)是将核心写入State：

type Counter = Int
update :: State Counter ()
update = modify (+1)
count :: State Counter Int
count = get

并用类似的东西将其提升到IO：

import Data.Tuple (swap)
runStateIO :: State s a -> MVar s -> IO a
runStateIO act s = modifyMVar s (return . swap . runState act)
main = do
...
s <- newMVar 0
let run act = runStateIO act s
export dbus "/com/example/CounterService"
defaultInterface
{ interfaceName = "com.example.CounterService"
, interfaceMethods =
[ autoMethod "update" (run update)
, autoMethod "count" (run count) ]
}

(我想我在这里使用的是比你更新的dbus版本，因为 API 有点不同——我正在用dbus-1.2.16进行测试，仅供参考。

一个潜在的缺点是，这将锁定每个方法调用的状态MVar，即使调用不需要状态或只需要只读访问权限。 DBus 服务通常流量非常低，方法调用旨在快速完成，因此我认为这在实践中不是问题。

无论如何，这里有一个完整的工作程序，我用它测试过：

dbus-send --print-reply --session --dest=com.example /com/example/CounterService com.example.CounterService.update
dbus-send --print-reply --session --dest=com.example /com/example/CounterService com.example.CounterService.count

该计划：

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
import System.IO
import System.Exit
import Data.Int
import DBus.Client
import Data.Tuple
import Control.Concurrent
import Control.Monad.State
type Counter = Int32
update :: State Counter ()
update = modify (+1)
count :: State Counter Int32
count = get
runStateIO :: State s a -> MVar s -> IO a
runStateIO act s = modifyMVar s (return . swap . runState act)
main :: IO ()
main = do
dbus <- connectSession
requestResult <- requestName dbus "com.example" []
when (requestResult /= NamePrimaryOwner) $ do
hPutStrLn stderr "Name "com.example" not available"
exitFailure
s <- newMVar 0
let run act = runStateIO act s
export dbus "/com/example/CounterService"
defaultInterface
{ interfaceName = "com.example.CounterService"
, interfaceMethods =
[ autoMethod "update" (run update)
, autoMethod "count" (run count) ]
}
forever $ threadDelay 60000000