如何在 haskell 中编写有状态的 dbus 方法？

问题描述

我正在 Haskell 中使用 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 使用方法调用，而不是消息传递。因此，我需要能够export 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 相关的类型。

解决方法

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

DBusR Reply === ReaderT Client IO Reply

那里没有空间让你挤进你自己的 StateT monad。您可以改为导出 a 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