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

import Data.Maybe

                                                                                        
startMainloop :: EventloopConfiguration progstateT -> IO ()
startMainloop eventloopConfig@(EventloopConfiguration { moduleConfigurations = moduleConfigs
                                                      , sharedIOState = sharedIO
                                                      }) = do
                                                               (sharedIO', moduleConfigs') <- withIOStateModules sharedIO initializer moduleConfigs
                                                               eventloopConfig'' <- startMainloopWithStart (eventloopConfig {moduleConfigurations=moduleConfigs', sharedIOState=sharedIO'})
                                                               let
                                                                moduleConfigs'' = moduleConfigurations eventloopConfig''
                                                                sharedIO''      = sharedIOState eventloopConfig''
                                                               (sharedIO''', moduleStates''') <- withIOStateModules sharedIO'' teardown moduleConfigs''
                                                               return ()

withIOStateModules :: SharedIOState -> 
                      (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> IO (SharedIOState, IOState))) ->
                      [EventloopModuleConfiguration] ->
                      IO (SharedIOState, [EventloopModuleConfiguration])
withIOStateModules sharedIO _ [] = return (sharedIO, [])
withIOStateModules sharedIO getFunc (mc:mcs) = do
                                                (sharedIO', mc') <- withIOStateModule sharedIO getFunc mc
                                                (sharedIO'', mcs') <- withIOStateModules sharedIO' getFunc mcs
                                                return (sharedIO'', mc':mcs')
                                                               
withIOStateModule :: SharedIOState -> 
                    (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> IO (SharedIOState, IOState))) -> 
                    EventloopModuleConfiguration ->
                    IO (SharedIOState, EventloopModuleConfiguration)
withIOStateModule sharedIO getFunc mc = case (getFunc mc) of
                                            Nothing     -> return (sharedIO, mc)
                                            Just (func) -> do
                                                            (sharedIO', iostate') <- func sharedIO (iostate mc)
                                                            return (sharedIO', mc {iostate=iostate'})
                                
                                                                                
startMainloopWithStart :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT)
startMainloopWithStart ec = handleMainloopUsingSource (return (ec, [Start]))
                                                                                        

handleMainloopUsingSource :: IO (EventloopConfiguration progstateT, [In]) -> IO (EventloopConfiguration progstateT)
handleMainloopUsingSource source = do
                                    (ec', inEvents) <- source
                                    (ec'', inEvents') <- processEvents ec' preprocessor inEvents -- Do preprocess step
                                    (ec'', stopFound) <- foldl (>>=) (return (ec'', False)) (map handleSingleInEvent inEvents') -- Handle each inEvent
                                    if stopFound
                                        then (return ec'')
                                        else (handleMainloopUsingSource (receiveEvents ec''))


receiveEvents :: EventloopConfiguration progstateT -> IO (EventloopConfiguration progstateT, [In])
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 -> 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)

                     
handleSingleInEvent :: In -> (EventloopConfiguration progstateT, Bool) -> IO (EventloopConfiguration progstateT, Bool)
handleSingleInEvent inEvent (ec, stopFound)  | stopFound = return (ec, stopFound)
                                             | otherwise = do
                                                            let
                                                             (ec', outEvents) = doEventloop ec inEvent -- Do eventloop step
                                                            (ec'', outEvents') <- processEvents ec' postprocessor outEvents -- Do postprocess step
                                                            sendOutEvents ec'' outEvents' -- Do send outEvents step
 
 
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, Bool)
sendOutEvents ec [] = return (ec, False)
sendOutEvents ec (Stop:outs) = return (ec, True)
sendOutEvents ec (out:outs) = case sendModuleConfigM of
                                Nothing -> error ("Could not send outEvent because module is not configured. Wanted to use module: " ++ (show moduleToRoute) ++ " Event: " ++ (show out))
                                Just sendModuleConfig -> do
                                                            let
                                                                eventSenderFuncM = eventSender sendModuleConfig
                                                                moduleIOState = iostate sendModuleConfig
                                                            case eventSenderFuncM of
                                                                    Nothing -> error ("Could not send outEvent because module eventsender is not configured. Using module: " ++ (show moduleToRoute) ++ " Event:  " ++ (show out))
                                                                    Just eventSenderFunc -> do
                                                                                                (sharedIO', moduleIOState') <- eventSenderFunc sharedIO moduleIOState out
                                                                                                let
                                                                                                    sendModuleConfig' = sendModuleConfig {iostate=moduleIOState'}
                                                                                                    ec' = ec {moduleConfigurations=(replaceModuleConfiguration sendModuleConfig' moduleConfigs), sharedIOState=sharedIO'}
                                                                                                sendOutEvents ec' outs
                            where
                                sharedIO = sharedIOState ec
                                moduleToRoute = (outRouter ec) out
                                moduleConfigs = moduleConfigurations ec
                                sendModuleConfigM = findModuleConfiguration moduleToRoute moduleConfigs
                                
   
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 :: SharedIOState ->
                        [EventloopModuleConfiguration] -> 
                        (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> event -> IO (SharedIOState, IOState, [event]))) -> -- Function from moduleconfig to pre-/postprocess function
                        [event] -> 
                        IO (SharedIOState, [EventloopModuleConfiguration], [event])
processEventsModules sharedIO mcs _ []    = return (sharedIO, mcs, [])
processEventsModules sharedIO [] _ events = return (sharedIO, [], events)
processEventsModules sharedIO (moduleConfig:mcs) getFunc (event:events) = do
                                                                    (sharedIO', moduleConfig', moreEvents) <- processEventModule sharedIO moduleConfig getFunc event
                                                                    (sharedIO'', mcs', moreEvents') <- processEventsModules sharedIO' mcs getFunc moreEvents
                                                                    (sharedIO''', mcs'', events') <- processEventsModules sharedIO'' (moduleConfig':mcs') getFunc events
                                                                    return (sharedIO''', mcs'', moreEvents' ++ events')
                                  
                                  
processEvents :: EventloopConfiguration progstateT ->
                (EventloopModuleConfiguration -> Maybe (SharedIOState -> IOState -> event -> IO (SharedIOState, IOState, [event]))) -> -- Function from moduleconfig to pre-/postprocess function
                [event] ->
                IO (EventloopConfiguration progstateT, [event])
processEvents eventloopConfig getFunc events = do
                                                let
                                                    moduleConfigs = moduleConfigurations eventloopConfig
                                                    sharedIO = sharedIOState eventloopConfig
                                                (sharedIO', moduleConfigs', events') <- processEventsModules sharedIO moduleConfigs getFunc events
                                                return (eventloopConfig {moduleConfigurations=moduleConfigs', sharedIOState=sharedIO'}, events')
                                                

findModuleConfiguration :: EventloopModuleIdentifier -> [EventloopModuleConfiguration] -> Maybe EventloopModuleConfiguration
findModuleConfiguration _ [] = Nothing
findModuleConfiguration id (mc:mcs) | id == moduleId = Just mc
                                    | otherwise = findModuleConfiguration id mcs
                                    where
                                        moduleId = moduleIdentifier mc
                                        
replaceModuleConfiguration :: EventloopModuleConfiguration -> [EventloopModuleConfiguration] -> [EventloopModuleConfiguration]
replaceModuleConfiguration _ [] = []
replaceModuleConfiguration mc (mc':mcs) | moduleIdentifier mc == moduleIdentifier mc' = (mc:mcs)
                                        | otherwise = (mc':(replaceModuleConfiguration mc mcs))