Во-первых, вы уверены, что слоты действительно хотят выполнять в определенном потоке? Легко написать потокобезопасный код на Haskell, а потоки очень легки в GHC, так что вы не добьетесь больших результатов, привязав все выполнение обработчика событий к определенному потоку на Haskell.
Кроме того, для обратного вызова mkSlot
нет необходимости давать сам слот: вы можете использовать рекурсивную нотацию , чтобы связать слот в его обратном вызове, не добавляя беспокойства о завязывании узла. до mkSlot
.
В любом случае, вам не нужно ничего более сложного, чем эти решения. Я ожидаю, что когда вы говорите об экзистенциальных типах, вы думаете о том, чтобы отправить что-то вроде (a -> IO (), a)
через TChan
(которое вы упомянули, используя в комментариях) и применить его на другом конце, но вы хотите, чтобы TChan
принимать значения этого типа для любого a , а не только для одного конкретного a . Ключевым моментом здесь является то, что если у вас есть (a -> IO (), a)
и вы не знаете, что такое a , единственное, что вы можете сделать, это применить функцию к значению, что даст вам IO ()
- так что мы можно просто отправить их через канал!
Вот пример:
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
для отправки действий рабочему потоку, к которому привязан каждый слот.
Обратите внимание, что я не очень знаком с Qt, поэтому, возможно, я упустил некоторые тонкости модели. Вы также можете отключить слоты с помощью:
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
Возможно, вы захотите что-то вроде Map Unique (Slot a)
вместо [Slot a]
, если это может быть узким местом.
Итак, решение здесь состоит в том, чтобы (а) распознать, что у вас есть нечто, что фундаментально основано на изменчивом состоянии, и использовать изменяемую переменную для его структурирования; (б) понять, что функции и действия ввода-вывода являются первоклассными, как и все остальное, поэтому вам не нужно делать ничего особенного, чтобы конструировать их во время выполнения:)
Кстати, я рекомендую сохранять реализации Signal
и Slot
абстрактными, не экспортируя их конструкторы из определяющего их модуля; в конце концов, есть много способов решить этот подход без изменения API.