module Eventloop.System.SenderThread where import Control.Exception import Control.Monad import Control.Concurrent.STM import Control.Concurrent.Datastructures.BlockingConcurrentQueue import Eventloop.Types.Common import Eventloop.Types.Events import Eventloop.Types.Exception import Eventloop.Types.System startSending :: EventloopSystemConfiguration progstateT -> (EventloopModuleConfiguration, EventloopModuleSenderConfiguration) -> IO () startSending systemConfig (moduleConfig, moduleSenderConfig) = forever $ do outEvent <- takeFromBlockingConcurrentQueue senderEventQueue_ case outEvent of Stop -> do sendOne moduleId_ sharedConst sharedIOT ioConst ioStateT_ sender_ Stop throwIO RequestShutdownException _ -> sendOne moduleId_ sharedConst sharedIOT ioConst ioStateT_ sender_ outEvent where moduleId_ = moduleId moduleConfig sharedConst = sharedIOConstants systemConfig sharedIOT = sharedIOStateT systemConfig ioConst = ioConstants moduleConfig ioStateT_ = ioStateT moduleConfig sender_ = sender moduleSenderConfig senderEventQueue_ = senderEventQueue moduleSenderConfig sendOne :: EventloopModuleIdentifier -> SharedIOConstants -> TVar SharedIOState -> IOConstants -> TVar IOState -> EventSender -> Out -> IO () sendOne moduleId sharedConst sharedIOT ioConst ioStateT sender outEvent = handle ( \exception -> -- Wrap the exception if it isn't a ShuttingDownException case (fromException exception) of (Just ShuttingDownException) -> throwIO ShuttingDownException _ -> throwIO (SendingException moduleId outEvent exception) ) ( sender sharedConst sharedIOT ioConst ioStateT outEvent )