module Eventloop.EventloopCore
    ( startMainloop
    ) where
               
import Eventloop.Types.EventTypes

import Data.Maybe
import Control.Exception

type HasToStop = Bool
type PhaseDescription = [Char]
type ProcessingDescription = [Char]

putStrLnIf :: Bool -> String -> IO ()
putStrLnIf doIf str | doIf      = putStrLn str
                    | otherwise = return ()

                    
startMainloop :: EventloopConfiguration progstateT -> IO ()
startMainloop eventloopConfig 
    = do
        (eventloopConfig', initHasToStop) <- initialisePhase eventloopConfig
        case initHasToStop of
            True ->    do
                            putStrLn "Something went wrong during initialisation"
                            (_, emTeardownHasToStop) <- teardownPhase eventloopConfig'
                            putStrLnIf emTeardownHasToStop "Something also went wrong at teardown"
            False  ->    do
                            eventloopConfig'' <- startMainloopWithStart eventloopConfig'
                            (eventloopConfig''', teardownHasToStop) <- teardownPhase eventloopConfig''
                            putStrLnIf teardownHasToStop "Something went wrong during teardown"
        putStrLn "Stopping system..."


initialisePhase :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, HasToStop)
initialisePhase eventloopConfig
    = do
        let
            sharedIO = sharedIOState eventloopConfig
            moduleConfigs = moduleConfigurations eventloopConfig
        (sharedIO', moduleConfigs', hasToStop) <- handlePhaseModuleConfigurations sharedIO moduleConfigs initializer "initialisation"
        return (eventloopConfig {sharedIOState = sharedIO', moduleConfigurations = moduleConfigs'}, hasToStop)
         
         
teardownPhase :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, HasToStop)
teardownPhase eventloopConfig
    = do
        let
            sharedIO = sharedIOState eventloopConfig
            moduleConfigs = moduleConfigurations eventloopConfig
        (sharedIO', moduleConfigs', hasToStop) <- handlePhaseModuleConfigurations sharedIO moduleConfigs teardown "teardown"
        return (eventloopConfig {sharedIOState = sharedIO', moduleConfigurations = moduleConfigs'}, hasToStop)
            
    
handlePhaseModuleConfigurations :: SharedIOState
                                         -> [EventloopModuleConfiguration]
                                         -> (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> IO (SharedIOState, IOState)))
                                         -> PhaseDescription
                                         -> IO (SharedIOState, [EventloopModuleConfiguration], HasToStop)
handlePhaseModuleConfigurations sharedIO [] _ _ = return (sharedIO, [], False)
handlePhaseModuleConfigurations sharedIO (mc:mcs) phaseFunc phaseDescription
    = do
        (sharedIO', mc', hasToStop) <- handlePhaseModuleConfiguration sharedIO mc phaseFunc phaseDescription
        (sharedIO'', mcs', hasToStopOther) <- handlePhaseModuleConfigurations sharedIO' mcs phaseFunc phaseDescription
        return (sharedIO'', mc':mcs', hasToStop || hasToStopOther)
        
        
handlePhaseModuleConfiguration :: SharedIOState 
                               -> EventloopModuleConfiguration
                               -> (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> IO (SharedIOState, IOState)))
                               -> PhaseDescription
                               -> IO (SharedIOState, EventloopModuleConfiguration, HasToStop)         
handlePhaseModuleConfiguration sharedIO mc phaseFunc phaseDescription
    = do
        let
            name = moduleIdentifier mc
            modulePhaseFuncM = phaseFunc mc
            moduleIOState = iostate mc
        handle
            ( \exception -> do
                putStrLn ("Exception during " ++ phaseDescription ++ " in module " ++ name)
                putStrLn ("  " ++ show (exception :: SomeException))
                return (sharedIO, mc, True)
            )
            ( case modulePhaseFuncM of
                (Just modulePhaseFunc) -> do
                                            (sharedIO', moduleIOState') <- modulePhaseFunc sharedIO moduleIOState
                                            return (sharedIO', mc {iostate=moduleIOState'}, False)
                Nothing -> return (sharedIO, mc, False)
            )
                                
                                                                                
startMainloopWithStart :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT)
startMainloopWithStart ec = handleMainloopUsingSource (return (ec, [Start], False))
                                                                                        

handleMainloopUsingSource :: IO (EventloopConfiguration progstateT, [In], HasToStop) -> IO (EventloopConfiguration progstateT)
handleMainloopUsingSource source = do
                                    (ec', inEvents, hasToStopSource) <- source
                                    case hasToStopSource of
                                        True -> return ec'
                                        False  -> do
                                            (ec'', inEvents', hasToStopPreProcess) <- processEvents "preprocess" ec' preprocessor inEvents -- Do preprocess step
                                            case hasToStopPreProcess of
                                                True -> return ec''
                                                False -> do
                                                    (ec''', hasToStopInEvents) <- handleInEvents inEvents' ec''
                                                    case hasToStopInEvents of
                                                        True -> return ec'''
                                                        False -> handleMainloopUsingSource (receiveEvents ec''')


receiveEvents :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, [In], HasToStop)
receiveEvents eventloopConfig = do
                                    let
                                        (moduleConfig:mcs) = moduleConfigurations eventloopConfig
                                        eventRetrieverM = eventRetriever moduleConfig
                                        sharedIO = sharedIOState eventloopConfig
                                        checkNextModule sio mc = receiveEvents (eventloopConfig {moduleConfigurations=(mcs++[mc]), sharedIOState=sio})
                                    case eventRetrieverM of
                                        Nothing -> checkNextModule sharedIO moduleConfig
                                        Just er -> handle
                                                    ( \exception -> do
                                                        putStrLn "Exception when receiving events"
                                                        putStrLn ("  " ++ show (exception :: SomeException))
                                                        return (eventloopConfig, [], True)
                                                    )
                                                    ( do
                                                        (sharedIO', iostate', inEvents) <- er sharedIO (iostate moduleConfig)
                                                        let
                                                            moduleConfig' = moduleConfig {iostate=iostate'}
                                                        case inEvents of
                                                            [] -> checkNextModule sharedIO' moduleConfig'
                                                            _  -> return (eventloopConfig {moduleConfigurations=(mcs++[moduleConfig']), sharedIOState=sharedIO'}, inEvents, False)
                                                    )

                                                        
handleInEvents :: [In] -> EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, HasToStop)
handleInEvents [] ec
    = return (ec, False)
    
handleInEvents (i:is) ec
    = do
        (ec', hasToStop) <- handleSingleInEvent i ec
        case hasToStop of
            True -> return (ec', True)
            False -> handleInEvents is ec'
            
                     
handleSingleInEvent :: In -> EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, HasToStop)
handleSingleInEvent inEvent ec
    = handle
        ( \exception -> do
            putStrLn "Exception in eventloop function"
            putStrLn ("  " ++ show (exception :: SomeException))
            return (ec, True)
        )
        ( do
            let
                (ec', outEvents) = doEventloop ec inEvent -- Do eventloop step
            (ec'', outEvents', hasToStopPostProcess) <- processEvents "postprocess" ec' postprocessor outEvents -- Do postprocess step
            case hasToStopPostProcess of
                False -> sendOutEvents ec'' outEvents' -- Do send outEvents step
                True  -> do
                            putStrLn "Exception when postprocessing outEvents"
                            return (ec'', True)
        )
 
 
doEventloop :: EventloopConfiguration progstateT -> In -> (EventloopConfiguration progstateT, [Out])
doEventloop ec inEvent = (ec', outEvents)
                      where
                        (progState', outEvents) = (eventloopFunc ec) (progState ec) inEvent
                        ec' = ec {progState = progState'}
 

sendOutEvents :: EventloopConfiguration progstateT -> [Out] -> IO (EventloopConfiguration progstateT, HasToStop)
sendOutEvents ec [] = return (ec, False)
sendOutEvents ec (Stop:_) = return (ec, True)
sendOutEvents ec (out:outs) 
    = handle
        ( \exception -> do
            putStrLn "Exception when sending outEvent"
            putStrLn ("  OutEvent: " ++ show out)
            putStrLn ("  Exception: " ++ show (exception :: SomeException))
            return (ec, True)
        )
        ( do
            let
                moduleConfigs = moduleConfigurations ec
                moduleToSendWith = (outRouter ec) out
                sharedIO = sharedIOState ec
            (sharedIO', moduleConfigs') <- sendOutEventWithModule sharedIO moduleToSendWith out moduleConfigs
            let
                ec' = ec {sharedIOState=sharedIO', moduleConfigurations=moduleConfigs'}
            sendOutEvents ec' outs
        )
 

sendOutEventWithModule :: SharedIOState -> EventloopModuleIdentifier -> Out -> [EventloopModuleConfiguration] -> IO (SharedIOState, [EventloopModuleConfiguration])
sendOutEventWithModule _ sendWith out [] 
    = error ("Could not send outEvent because module is not configured. Wanted to use module: " ++ (show sendWith) ++ " Event: " ++ (show out))
    
sendOutEventWithModule sharedIO sendWith out (mc:mcs)
    | sendWith == moduleId = case eventSenderFuncM of
                                Nothing -> error ("Could not send outEvent because module " ++ (show sendWith) ++ " does not have an eventsender configured")
                                Just eventSenderFunc -> do
                                                            (sharedIO', moduleIOState') <- eventSenderFunc sharedIO moduleIOState out
                                                            return (sharedIO', (mc {iostate=moduleIOState'}):mcs)
    | otherwise = do
                    (sharedIO', mcs') <- sendOutEventWithModule sharedIO sendWith out mcs
                    return (sharedIO, mc:mcs')
    where
        moduleId = moduleIdentifier mc
        eventSenderFuncM = eventSender mc
        moduleIOState = iostate mc
   
   
processEventModule :: SharedIOState 
                   -> EventloopModuleConfiguration
                   -> (EventloopModuleConfiguration 
                   -> Maybe (SharedIOState -> IOState -> event -> IO (SharedIOState, IOState, [event])))  -- Function from moduleconfig to pre-/postprocess function
                   -> event 
                   -> IO (SharedIOState, EventloopModuleConfiguration, [event])
processEventModule sharedIO eventloopModuleConfig getFunc event = do
                                                                    let
                                                                        processFuncM = getFunc eventloopModuleConfig
                                                                    case processFuncM of
                                                                        Nothing          -> return (sharedIO, eventloopModuleConfig, [event])
                                                                        Just processFunc -> do
                                                                                                (sharedIO', iostate', events) <- processFunc sharedIO (iostate eventloopModuleConfig) event
                                                                                                return (sharedIO', eventloopModuleConfig {iostate=iostate'}, events)


processEventsModules :: ProcessingDescription
                     -> SharedIOState 
                     -> [EventloopModuleConfiguration] 
                     -> (EventloopModuleConfiguration 
                     -> Maybe (SharedIOState -> IOState -> event -> IO (SharedIOState, IOState, [event]))) -- Function from moduleconfig to pre-/postprocess function
                     -> [event] 
                     -> IO (SharedIOState, [EventloopModuleConfiguration], [event], HasToStop)
processEventsModules _ sharedIO mcs _ []
    = return (sharedIO, mcs, [], False)
    
processEventsModules _ sharedIO [] _ events
    = return (sharedIO, [], events, False)
    
processEventsModules processingDescription sharedIO (moduleConfig:mcs) getFunc (event:events) 
    = handle
        ( \exception -> do
            putStrLn ("Exception when " ++ (show processingDescription))
            putStrLn (show (exception :: SomeException))
            return (sharedIO, moduleConfig:mcs, event:events, True)
        )
        ( do
            (sharedIO', moduleConfig', moreEvents) <- processEventModule sharedIO moduleConfig getFunc event
            (sharedIO'', mcs', moreEvents', hasToStopResultingEvents) <- processEventsModules processingDescription sharedIO' mcs getFunc moreEvents
            (sharedIO''', mcs'', events', hasToStopOtherEvents) <- processEventsModules processingDescription sharedIO'' (moduleConfig':mcs') getFunc events
            return (sharedIO''', mcs'', moreEvents' ++ events', hasToStopResultingEvents || hasToStopOtherEvents)
        )
                                  
                                  
processEvents :: ProcessingDescription
              -> EventloopConfiguration progstateT 
              -> (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> event -> IO (SharedIOState, IOState, [event]))) -- Function from moduleconfig to pre-/postprocess function
              -> [event] 
              -> IO (EventloopConfiguration progstateT, [event], HasToStop)
processEvents processingDescription eventloopConfig getFunc events 
    = do
        let
            moduleConfigs = moduleConfigurations eventloopConfig
            sharedIO = sharedIOState eventloopConfig
        (sharedIO', moduleConfigs', events', hasToStop) <- processEventsModules processingDescription sharedIO moduleConfigs getFunc events
        return (eventloopConfig {moduleConfigurations=moduleConfigs', sharedIOState=sharedIO'}, events', hasToStop)