eventloop-0.5.0.0: src/Eventloop/System/SenderThread.hs

module Eventloop.System.SenderThread where

import Control.Exception
import Control.Monad
import Control.Concurrent.MVar
import Control.Concurrent.Datastructures.BlockingConcurrentQueue

import Eventloop.System.ThreadActions
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 -> throwIO RequestShutdownException
            _    -> sendOne moduleId_ sharedIOStateM_ iostateM_ sender_ outEvent
    where
        moduleId_ = moduleId moduleConfig
        sharedIOStateM_ = sharedIOStateM systemConfig
        iostateM_ = iostateM moduleConfig
        sender_ = sender moduleSenderConfig
        senderEventQueue_ = senderEventQueue moduleSenderConfig

                
sendOne :: EventloopModuleIdentifier
        -> MVar SharedIOState
        -> MVar IOState
        -> EventSender
        -> Out
        -> IO ()
sendOne moduleId sharedIOStateM_ iostateM sender outEvent
    = withSharedIOStateAndIOState sharedIOStateM_ iostateM
        ( \exception ->
            -- Wrap the exception if it isn't a ShuttingDownException
            case (fromException exception) of
                (Just ShuttingDownException) -> throwIO ShuttingDownException
                _                            -> throwIO (SendingException moduleId outEvent exception)
        )
        ( \sharedIOState iostate ->
            sender sharedIOState iostate outEvent
        )