Question

我正在努力解决Haskell中的一个设计问题，我似乎无法以优雅和令人满意的方式解决这个问题。我有一个系统，其核心是基于事件源的概念：系统的状态是由一系列事件应用到初始状态产生的。有不同类型的事件，每种类型通过类型系列与系统的特定组件相关：

class Model a where
   data Event a :: * 
   apply :: Event a -> a -> a

instance Model Foo where
   data Event Foo = Foo Int
   ...

instance Model Bar where
   data Event Bar = Bar String
   ...

目前系统是100％同步和耦合的，每个模型都可以访问所有其他模型的事件，这很快变得一团糟，所以我想通过引入事件总线来解耦Bus Events以这种方式，我应该能够写出类似的东西假设在dispatch :: Bus Events -> Consumer (Event Foo) -> Bus Events和Event Foo之间存在某种形式的子类型或包含，Bus Events将Event Foo的某些消费者附加到Events。然后我可以通过确保消费者每个人都在自己的线程中运行来添加异步性。

从系统的角度来看，这将允许我确保每个组件都是可独立包装的，从而将依赖性限制在所有事件的子集中。 Events类型将在整个应用程序级别定义。这个问题看起来与离散时间的FRP类似，但我似乎无法绕过它......

有没有人已经处理过类似的事情，如果有，是怎么回事？

修改：

我提出了以下代码，它没有使用Source，但受到@ Cirdec的提议的启发：

import           Control.Applicative
import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Monad.Reader
import qualified Data.Vector            as V

type Handlers e = V.Vector (Handler e)

data EventBus e = EventBus { handlers    :: Handlers e
                           , eventQueue  :: TChan e
                           , eventThread :: MVar ThreadId
                           }

newBus :: IO (EventBus e)
newBus = do
  chan <- newTChanIO
  var <- newEmptyMVar
  return $ EventBus V.empty chan var

addHandler :: Handler e -> EventBus e -> EventBus e
addHandler h b@EventBus{..} = b { handlers = V.snoc handlers h }

removeHandler :: Int -> EventBus e -> EventBus e
removeHandler idx b@EventBus{..} = b { handlers = let (h,t) = V.splitAt idx handlers
                                                  in h V.++ V.tail t }

startBus :: EventBus e -> IO (EventBus e)
startBus b@EventBus{..} = do
  tid <- forkIO (runBus b)
  putMVar eventThread tid
  return b

runBus :: EventBus e -> IO ()
runBus b@EventBus{..} = do
  _ <- takeMVar eventThread
  forever $ do
    e <- liftIO $ atomically $ readTChan eventQueue
    v <- newTVarIO b
    runReaderT (runEvents $ publish e) v

-- | A monad to handle pub/sub of events of type @e@
newtype Events e a = Events { runEvents :: ReaderT (TVar (EventBus e)) IO a }
                   deriving (Applicative, Functor, Monad, MonadIO, MonadReader (TVar (EventBus e)))

newtype Handler e = Handler { handle :: Events e ()                 -- Unsubscription function
                                     -> Events e (e -> Events e ())  -- what to do with events @e@
                            }


-- | Register a new @Handler e@ within given @Events e@ context
subscribe :: Handler e -> Events e ()
subscribe h = do
  bus <- ask
  liftIO $ atomically $ modifyTVar' bus (addHandler h)

unsubscribe :: Int -> Events e ()
unsubscribe idx = do
  bus <- ask
  liftIO $ atomically $ modifyTVar' bus (removeHandler idx)

publishBus :: EventBus e -> e -> IO ()
publishBus EventBus{..} = atomically . writeTChan eventQueue

publish :: e -> Events e ()
publish event = do
  EventBus{..} <- ask >>= liftIO . atomically . readTVar
  forM_ (zip (V.toList handlers) [0..]) (dispatch event)

dispatch :: e -> (Handler e, Int) -> Events e ()
dispatch event (Handler h, idx) = do
  hdl <- h (unsubscribe idx)
  hdl event

printer :: (Show s) => String -> Handler s
printer prefix = Handler ( \ _ -> return $ \ e -> liftIO (putStrLn $ prefix ++ show e))

Answer 1

可以订阅a的事件来源具有以下类型

type Source m a = (a -> m ()) -> m (m ())
                   |             |  ^--- how to unsubscribe             
                   |             ^--- how to subscribe
                   ^--- what to do when an `a` happens

事件的消费者或处理者天真地接受事件源并订阅它

type Handler m a = (Source m a             ) -> m ()
                 = ((a -> m ()) -> m (m ())) -> m ()
                                                ^-- set up the consumer.

这有点令人费解，我们可以反转事物并为事件处理程序获得更好的表示：

type Handler m a = m () -> m (a -> m ())
                   |       |  ^-- what to do when an `a` happens
                   |       ^-- set up the consumer
                   ^-- how to unsubscribe

原始事件源使用起来有点棘手;订阅者可能想要取消订阅以响应事件发生，在这种情况下，他们需要递归地将得到的取消订阅操作变为事件发生时要做的事情。从Handler的更好定义开始，我们不会遇到此问题。事件源现在是接受事件处理程序并发布到它的东西。

type Source m a = (Handler m a          ) -> m ()
                = (m () -> m (a -> m ())) -> m ()
                                             ^-- how to subscribe

如何在Haskell中编写事件总线？

1 个答案: