module Eventloop.System.EventloopThread where

import Control.DeepSeq
import Control.Exception
import Control.Monad
import Control.Concurrent.ExceptionUtility
import Control.Concurrent.MVar
import Control.Concurrent.STM
import Control.Concurrent.Datastructures.BlockingConcurrentQueue
import Data.Maybe

import Eventloop.System.Processing
import Eventloop.Types.Common
import Eventloop.Types.Exception
import Eventloop.Types.Events
import Eventloop.Types.System

startEventlooping :: EventloopSystemConfiguration progstateT 
                  -> IO ()
startEventlooping systemConfig
    = handle
        ( \exception ->
            case (fromException exception) of
                (Just RequestShutdownException) -> throwIO RequestShutdownException
                _                               -> throwIO (EventloopException exception)
        )
        ( do
            putInBlockingConcurrentQueue inEventQueue_ Start
            forever $ do
              inEvent <- takeFromBlockingConcurrentQueue inEventQueue_ -- Take an In event
              processedInEvents <- processEvents "Preprocessing" systemConfig modulePreprocessors [inEvent] -- Preprocess it
              outEvents <- eventloopSteps eventloop progstateT_ processedInEvents  -- Eventloop over the preprocessed In events
              processedOutEvents <- processEvents "Postprocessing" systemConfig modulePostprocessors outEvents -- Postprocess the Out events
              evaluatedOutEvents <- evaluate $ force processedOutEvents
              putAllInBlockingConcurrentQueue outEventQueue_ processedOutEvents -- Send the processed Out events to the OutRouter
        )
    where
        eventloopConfig_ = eventloopConfig systemConfig
        eventloop = eventloopFunc eventloopConfig_
        progstateT_ = progstateT eventloopConfig_
        inEventQueue_ = inEventQueue eventloopConfig_
        outEventQueue_ = outEventQueue eventloopConfig_
        moduleConfigurations_ = moduleConfigs systemConfig
        modulePreprocessors = findProcessors moduleConfigurations_ preprocessorM
        modulePostprocessors = findProcessors moduleConfigurations_ postprocessorM

        
findProcessors :: [EventloopModuleConfiguration]
               -> (EventloopModuleConfiguration -> Maybe (SharedIOConstants -> TVar SharedIOState -> IOConstants -> TVar IOState -> event -> IO [event])) -- Pre-/Postprocessor function
               -> [(EventloopModuleIdentifier, IOConstants, TVar IOState, (SharedIOConstants -> TVar SharedIOState -> IOConstants -> TVar IOState -> event -> IO [event]))]
findProcessors moduleConfigs getProcessorFunc
    = moduleProcessors
    where
        moduleProcessorsM = map (\moduleConfig -> (moduleId moduleConfig, ioConstants moduleConfig, ioStateT moduleConfig, getProcessorFunc moduleConfig)) moduleConfigs
        moduleProcessorsJ = filter (\(_, _, _, processFuncM) -> isJust processFuncM) moduleProcessorsM
        moduleProcessors = map (\(id, ioConst, iostate, (Just processFunc)) -> (id, ioConst, iostate, processFunc)) moduleProcessorsJ

        
eventloopSteps :: (progstateT -> In -> (progstateT, [Out])) {-^ eventloop function -}
               -> TVar progstateT
               -> [In]
               -> IO [Out]
eventloopSteps eventloop progstateT inEvents
    =  sequencedSteps >>= (return.concat)
    where
        inEventSteps = map (eventloopStep eventloop progstateT) inEvents
        sequencedSteps = sequence inEventSteps
    
        
eventloopStep :: (progstateT -> In -> (progstateT, [Out])) {-^ eventloop function -}
              -> TVar progstateT
              -> In
              -> IO [Out]
eventloopStep eventloop progStateT inEvent
    = do
        progState <- readTVarIO progStateT
        let
            (progState', outEvents) = eventloop progState inEvent
        atomically $ writeTVar progStateT progState'
        return outEvents