Jak napisać autobus na wydarzenie w Haskell?

Question

Mam problem z projektowaniem w Haskell, którego nie mogę rozwiązać w sposób elegancki i satysfakcjonujący. Mam system, którego podstawą jest koncepcja pozyskiwania zdarzeń: stan systemu wynika z zastosowania sekwencji zdarzeń do stanu początkowego. Istnieją różne typy zdarzeń, każdy rodzaj jest związane z konkretnym składnikiem systemu przez rodziny typu:

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 
    ... 

Obecnie system jest w 100% synchroniczne i sprzężony, każdy model mający dostęp do wydarzeń wszystko inny model i to szybko staje się bałagan, więc chcę, aby oddzielić rzeczy poprzez wprowadzenie magistrali zdarzeńBus Events w taki sposób będę mógł napisać coś takiego dispatch :: Bus Events -> Consumer (Event Foo) -> Bus Events dołączyć jakąś konsumenta Event Foo do Bus Events zakładając, że istnieje jakiś forma subpozycji lub subpozycji między Event Foo i Events. Następnie mogę dodać asynchroniczność, upewniając konsumentów, że każdy działa we własnych wątkach.

Z systemowego punktu widzenia pozwoliłoby to zapewnić, że każdy składnik jest pakowalny niezależnie, ograniczając zależności do podzbioru wszystkich zdarzeń. Typ Events zostałby zdefiniowany na poziomie całej aplikacji. Ten problem wygląda na zwodniczo podobnego do dyskretnego FRP, ale nie potrafię się nim obejść ...

Czy ktoś już poradził sobie z czymś podobnym, a jeśli tak, to w jaki sposób?

EDIT:

wpadłem na następujący kod, który sprawia, że ​​nie korzysta z Source ale jest znacznie zainspirowany @ propozycję Cirdec za:

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

źródła zdarzeń niosącego a jakoby można subskrybować, ma następujący typ:

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

Konsument lub dłoń ler zdarzeń jest naiwnie coś że akceptuje źródło zdarzenia i podpisuje z nim

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

To jest trochę skomplikowane, możemy odwrócić rzeczy i uzyskać ładniejszy reprezentację do obsługi zdarzeń:

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

The oryginalne źródło zdarzeń było nieco trudne w użyciu; subskrybent może chcieć zrezygnować z subskrypcji w odpowiedzi na zdarzenie, w którym to przypadku musiałby rekursywnie uzyskać wynikową akcję rezygnacji z subskrypcji, co zrobić, gdy wydarzenie się wydarzy. Zaczynając od ładniejszej definicji Handler nie mamy tego problemu. Źródło zdarzenia jest teraz czymś, co akceptuje procedurę obsługi zdarzeń i publikuje ją.

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