eventloop-0.8.2.8: src/Eventloop/System/Setup.hs

module Eventloop.System.Setup
    ( setupEventloopSystemConfig
    ) where

import Control.Concurrent
import Control.Concurrent.ExceptionCollection
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Concurrent.Datastructures.BlockingConcurrentQueue

import Eventloop.DefaultConfiguration
import Eventloop.Types.System


setupEventloopSystemConfig :: EventloopSetupConfiguration progstateT
                           -> IO (EventloopSystemConfiguration progstateT)
setupEventloopSystemConfig setupConfig
    = do
        eventloopConfig_ <- setupEventloopConfiguration setupConfig
        moduleConfigurations_ <- mapM setupEventloopModuleConfig (setupModuleConfigurations setupConfig)
        sharedIOConst <- setupSharedIOConstants
        sharedIOState_ <- setupSharedIOState
        sharedIOStateT_ <- newTVarIO sharedIOState_
        systemThreadId_ <- myThreadId
        retrieverThreadsM_ <- newMVar []
        outRouterThreadM_ <- newEmptyMVar
        senderThreadsM_ <- newMVar []
        exceptionCollection <- createExceptionCollection
        isStoppingM_ <- newMVar False

        return ( EventloopSystemConfiguration
                    eventloopConfig_
                    moduleConfigurations_
                    sharedIOConst
                    sharedIOStateT_
                    systemThreadId_
                    retrieverThreadsM_
                    outRouterThreadM_
                    senderThreadsM_
                    exceptionCollection
                    isStoppingM_
               )


setupEventloopConfiguration :: EventloopSetupConfiguration progstateT
                            -> IO (EventloopConfiguration progstateT)
setupEventloopConfiguration setupConfig
    = do
        progStateT_ <- newTVarIO (beginProgstate setupConfig)
        inEventQueue_ <- createBlockingConcurrentQueue
        outEventQueue_ <- createBlockingConcurrentQueue

        return ( EventloopConfiguration
                    progStateT_
                    (eventloopF setupConfig)
                    inEventQueue_
                    outEventQueue_
               )


setupEventloopModuleConfig :: EventloopSetupModuleConfiguration
                           -> IO EventloopModuleConfiguration
setupEventloopModuleConfig setupModuleConfig
    = do
        ioStateT <- newTVarIO NoState
        senderConfig <- setupEventloopModuleSenderConfiguration (eventSenderF setupModuleConfig)

        return ( EventloopModuleConfiguration
                    (moduleIdentifier setupModuleConfig)
                    NoConstants
                    ioStateT
                    (initializerF setupModuleConfig)
                    (eventRetrieverF setupModuleConfig)
                    (preprocessorF setupModuleConfig)
                    (postprocessorF setupModuleConfig)
                    senderConfig
                    (teardownF setupModuleConfig)
               )
    where
        moduleId_ = moduleIdentifier setupModuleConfig



setupEventloopModuleSenderConfiguration :: Maybe EventSender
                                        -> IO (Maybe EventloopModuleSenderConfiguration)
setupEventloopModuleSenderConfiguration Nothing = return Nothing
setupEventloopModuleSenderConfiguration (Just eventSender_)
    = do
        senderEventQueue_ <- createBlockingConcurrentQueue

        return (Just (EventloopModuleSenderConfiguration eventSender_ senderEventQueue_))