Question

我正在尝试编写一个旨在重现Qt的线程语义的库：信号可以连接到插槽，并且所有插槽都在一个已知线程中执行，因此绑定到同一线程的插槽相互之间是线程安全的。

我有以下API：

data Signal a = Signal Unique a
data Slot a = Slot Unique ThreadId (a -> IO ())

mkSignal :: IO (Signal a)
mkSlot   :: ThreadId -> (Slot a -> a -> IO ()) -> IO (Slot a)

connect :: Signal a -> Slot a -> IO ()

-- callable from any thread
emit :: Signal a -> a -> IO ()

-- runs in Slot's thread as a result of `emit`
execute :: Slot a -> a -> IO ()
execute (Slot _ _ f) arg = f arg

问题是从emit升级到execute。该参数需要以某种方式存储在运行时，然后执行IO操作，但我似乎无法通过类型检查器。

我需要的东西：

类型安全：信号不应连接到期望不同类型的插槽。
类型独立性：任何给定类型都可以有多个插槽（也许这可以通过newtype和/或TH来放宽。）
易于使用：由于这是一个库，因此信号和插槽应易于创建。

我尝试过的事情：

Data.Dynamic：使整个事情变得非常脆弱，我还没有找到一种方法在Dynamic上执行正确类型的IO操作。有dynApply，但它很纯粹。
Existential types：我需要执行传递给mkSlot的函数，而不是基于类型的任意函数。
Data.HList：我不够聪明，无法弄明白。

我错过了什么？

Answer 1

首先，你确定Slots真的想在特定的线程中执行吗？在Haskell中编写线程安全的代码很容易，而且GHC中的线程非常轻量级，所以通过将所有事件处理程序执行绑定到特定的Haskell线程，你并没有获得太多收益。

此外，mkSlot的回调不需要为Slot本身提供：您可以使用recursive do-notation绑定其回调中的插槽，而无需添加将结结合到{{}的问题。 1}}。

无论如何，您不需要像这些解决方案那样复杂的任何东西。我希望当你谈到存在主义类型时，你会考虑通过mkSlot（你在评论中提到的）发送(a -> IO (), a)之类的内容并将其应用到另一端，但是你想要TChan为任何 a 接受此类型的值，而不仅仅是一个特定的 a 。这里的关键见解是，如果你有TChan并且不知道是什么，你唯一能做的就是将函数应用于值，给你一个{{1 - 所以我们可以通过频道发送它们！

以下是一个例子：

(a -> IO (), a)

这使用IO ()向每个插槽绑定的工作线程发送操作。

请注意，我对Qt不是很熟悉，所以我可能错过了模型的一些细微之处。您也可以使用以下方式断开插槽：

import Data.Unique
import Control.Applicative
import Control.Monad
import Control.Concurrent
import Control.Concurrent.STM

newtype SlotGroup = SlotGroup (IO () -> IO ())

data Signal a = Signal Unique (TVar [Slot a])
data Slot a = Slot Unique SlotGroup (a -> IO ())

-- When executed, this produces a function taking an IO action and returning
-- an IO action that writes that action to the internal TChan. The advantage
-- of this approach is that it's impossible for clients of newSlotGroup to
-- misuse the internals by reading the TChan or similar, and the interface is
-- kept abstract.
newSlotGroup :: IO SlotGroup
newSlotGroup = do
  chan <- newTChanIO
  _ <- forkIO . forever . join . atomically . readTChan $ chan
  return $ SlotGroup (atomically . writeTChan chan)

mkSignal :: IO (Signal a)
mkSignal = Signal <$> newUnique <*> newTVarIO []

mkSlot :: SlotGroup -> (a -> IO ()) -> IO (Slot a)
mkSlot group f = Slot <$> newUnique <*> pure group <*> pure f

connect :: Signal a -> Slot a -> IO ()
connect (Signal _ v) slot = atomically $ do
  slots <- readTVar v
  writeTVar v (slot:slots)

emit :: Signal a -> a -> IO ()
emit (Signal _ v) a = atomically (readTVar v) >>= mapM_ (`execute` a)

execute :: Slot a -> a -> IO ()
execute (Slot _ (SlotGroup send) f) a = send (f a)

如果这可能是一个瓶颈，您可能需要TChan而不是disconnect :: Signal a -> Slot a -> IO () disconnect (Signal _ v) (Slot u _ _) = atomically $ do slots <- readTVar v writeTVar v $ filter keep slots where keep (Slot u' _) = u' /= u。

所以，这里的解决方案是（a）认识到你有一些基本上基于可变状态的东西，并使用一个可变变量来构造它; （b）认识到函数和IO操作就像其他所有东西一样，所以你不需要做任何特殊的事情来在运行时构造它们：）

顺便说一下，我建议保留Map Unique (Slot a)和[Slot a]的实现，不要从定义它们的模块中导出它们的构造函数;毕竟，有很多方法可以在不改变API的情况下解决这个问题。

跨线程存储任意函数调用

1 个答案: