module Eventloop.System.RetrieverThread where



import Control.Exception

import Control.Monad

import Control.Concurrent.STM

import Control.Concurrent.Datastructures.BlockingConcurrentQueue



import Eventloop.Types.Common

import Eventloop.Types.Exception

import Eventloop.Types.System



startRetrieving :: EventloopSystemConfiguration progstateT

                -> (EventloopModuleConfiguration, EventRetriever)

                -> IO ()

startRetrieving systemConfig (moduleConfig, retriever)

    = forever (retrieveOne moduleId_ sharedConst sharedIOStateT_ ioConst ioStateT_ retriever inEventQueue_)

    where

        moduleId_ = moduleId moduleConfig

        eventloopConfiguration = eventloopConfig systemConfig

        sharedConst = sharedIOConstants systemConfig

        sharedIOStateT_ = sharedIOStateT systemConfig

        inEventQueue_ = inEventQueue eventloopConfiguration

        ioConst = ioConstants moduleConfig

        ioStateT_ = ioStateT moduleConfig





retrieveOne :: EventloopModuleIdentifier ->

               SharedIOConstants ->

               TVar SharedIOState ->

               IOConstants ->

               TVar IOState ->

               EventRetriever ->

               InEventQueue ->

               IO ()

retrieveOne moduleId sharedConst sharedIOT ioConst iostateT retriever inEventQueue

    = handle ( \exception ->

                -- Wrap the exception if it isn't a ShuttingDownException

                case (fromException exception) of

                    (Just ShuttingDownException) -> throwIO ShuttingDownException

                    _                            -> throwIO (RetrievingException moduleId exception)

            )

            ( do

                inEvents <- retriever sharedConst sharedIOT ioConst iostateT

                putAllInBlockingConcurrentQueue inEventQueue inEvents

            )