module Eventloop.System.OutRouterThread where

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

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

{- | Grab an outEvent from the outEventQueue and route it to the correct module sender if any.
If there isn't one, throw a NoOutRouteException. The router will continue until it:
- Comes across a Stop outEvent: Raises a RequestShutdownException
- Raises an exception
- Receives an exception (Only possibility is ShutdownException)
In all cases, a Stop outEvent is sent to all module senders.
-}
startOutRouting :: EventloopSystemConfiguration progstateT
                -> IO ()
startOutRouting systemConfig
    = catch (forever $ do
                outEvent <- takeFromBlockingConcurrentQueue outEventQueue_
                case outEvent of
                    Stop -> throwIO RequestShutdownException
                    _    -> outRouteOne moduleIdsSenderQueues outEvent
            )
            (\exception -> do
                outRouteBroadcastStop moduleIdsSenderQueues
                throwIO (exception :: SomeException)
            )
    where
        moduleIdsSenderQueues = outRoutes (moduleConfigs systemConfig)
        outEventQueue_ = outEventQueue (eventloopConfig systemConfig)
        

outRoutes :: [EventloopModuleConfiguration] -> [(EventloopModuleIdentifier, SenderEventQueue)]
outRoutes [] = []
outRoutes (moduleConfig:mcs) = case (senderConfigM moduleConfig) of
                                    Nothing                   -> outRoutes mcs
                                    (Just moduleSenderConfig) -> (moduleId moduleConfig, senderEventQueue moduleSenderConfig):(outRoutes mcs)
        
        
outRouteOne :: [(EventloopModuleIdentifier, SenderEventQueue)]
            -> Out
            -> IO ()
outRouteOne targetIdsSenderQueues outEvent
    = case targetSenderQueueM of
        Nothing                  -> 
            throwIO (NoOutRouteException outEvent)
        (Just targetSenderQueue) ->
            putInBlockingConcurrentQueue targetSenderQueue outEvent
    where
        targetModuleIdentifier = routeOutEvent outEvent
        targetSenderQueueM = lookup targetModuleIdentifier targetIdsSenderQueues


outRouteBroadcastStop :: [(EventloopModuleIdentifier, SenderEventQueue)]
                      -> IO ()
outRouteBroadcastStop []
    = return ()
outRouteBroadcastStop targetIdsSenderQueues
    = mapM_ broadcastAction (map snd targetIdsSenderQueues)
    where
        broadcastAction targetSenderQueue =
            putInBlockingConcurrentQueue targetSenderQueue Stop