module Eventloop.Module.Timer.Timer
    ( setupTimerModuleConfiguration
    , timerModuleIdentifier
    , timerInitializer
    , timerEventRetriever
    , timerEventSender
    , timerTeardown
    ) where

import Control.Concurrent.Datastructures.BlockingConcurrentQueue
import Control.Concurrent.STM
import Control.Concurrent.Timer
import Control.Concurrent.Suspend.Lifted
import Data.Maybe
import Data.List

import Eventloop.Module.Timer.Types
import Eventloop.Types.Common
import Eventloop.Types.Events
import Eventloop.Types.System


setupTimerModuleConfiguration :: EventloopSetupModuleConfiguration
setupTimerModuleConfiguration = ( EventloopSetupModuleConfiguration 
                                        timerModuleIdentifier
                                        (Just timerInitializer)
                                        (Just timerEventRetriever)
                                        Nothing
                                        Nothing
                                        (Just timerEventSender)
                                        (Just timerTeardown)
                                 )

timerModuleIdentifier :: EventloopModuleIdentifier
timerModuleIdentifier = "timer"

                             
timerInitializer :: Initializer
timerInitializer sharedConst sharedIO
    = do
        inQueue <- createBlockingConcurrentQueue
        return (sharedConst, sharedIO, TimerConstants inQueue, TimerState [] [])
                        
                                
timerEventRetriever :: EventRetriever
timerEventRetriever sharedConst sharedIOT ioConst ioStateT
    = do
        inTicks <- takeAllFromBlockingConcurrentQueue inQueue
        ioState <- readTVarIO ioStateT -- This first read is just a snapshot
        let
            toStop = map (\(Tick id) -> id) inTicks
            startedTimers_  = startedTimers ioState
        sequence $ map (haltTimer startedTimers_) toStop
        atomically $ do
            ioState' <- readTVar ioStateT
            let
                startedTimers_'  = startedTimers ioState'
                startedTimers_'' = foldl unregisterTimer startedTimers_' toStop
            writeTVar ioStateT (ioState'{startedTimers = startedTimers_'})

        return (map InTimer inTicks)
    where
        inQueue = tickInQueue ioConst


timerEventSender :: EventSender
timerEventSender _ _ _ _ Stop = return ()
timerEventSender sharedConst sharedIOT ioConst ioStateT (OutTimer a)
    = timerEventSender' ioStateT tickBuffer a
    where
        tickBuffer = tickInQueue ioConst

                                    
timerEventSender' :: TVar IOState -> TickBuffer -> TimerOut -> IO ()
timerEventSender' ioStateT tickBuffer (SetTimer id delay)
    = do
        startedTimer <- startTimer tickBuffer id delay (oneShotStart)
        atomically $ do
            ioState <- readTVar ioStateT
            let
                startedTimers_' = registerTimer (startedTimers ioState) startedTimer
            writeTVar ioStateT ioState{startedTimers=startedTimers_'}

timerEventSender' ioStateT tickBuffer (SetIntervalTimer id delay)
    = do
        startedTimer <- startTimer tickBuffer id delay (repeatedStart)
        atomically $ do
            ioState <- readTVar ioStateT
            let
                startedITimers_' = registerTimer (startedIntervalTimers ioState) startedTimer
            writeTVar ioStateT ioState{startedIntervalTimers=startedITimers_'}

timerEventSender' ioStateT tickBuffer (UnsetTimer id)
    = do
        ioState <- readTVarIO ioStateT -- This first read is just a snapshot
        let
            startedTimers_  = startedTimers ioState
            startedITimers_ = startedIntervalTimers ioState
        haltTimer startedTimers_ id
        haltTimer startedITimers_ id
        atomically $ do
            ioState' <- readTVar ioStateT
            let
                startedTimers_'  = startedTimers ioState'
                startedITimers_' = startedIntervalTimers ioState'
            writeTVar ioStateT ioState'{ startedTimers = startedTimers_'
                                       , startedIntervalTimers = startedITimers_'
                                       }

           
timerTeardown :: Teardown
timerTeardown sharedConst sharedIO ioConst ioState
    = do
        let
            allStartedTimers = (startedTimers ioState) ++ (startedIntervalTimers ioState)
            allStartedIds = map fst allStartedTimers
        sequence_ $ map (haltTimer allStartedTimers) allStartedIds
        return sharedIO

           
registerTimer :: [StartedTimer] -> StartedTimer -> [StartedTimer]
registerTimer startedTimers startedTimer
    = startedTimers ++ [startedTimer]


startTimer :: TickBuffer -> TimerId -> MicroSecondDelay -> TimerStartFunction -> IO StartedTimer
startTimer incTickBuff id delay startFunc
    = do
        timer <- newTimer
        startFunc timer (tick id incTickBuff) ((usDelay.fromIntegral) delay)
        return (id, timer)


unregisterTimer :: [StartedTimer] -> TimerId -> [StartedTimer]
unregisterTimer startedTimers id
    = filter (\(id', _) -> id /= id') startedTimers


haltTimer :: [StartedTimer] -> TimerId -> IO ()
haltTimer startedTimers id
    = do
        let
            startedTimerM = findStartedTimer startedTimers id
            stopAction (Just (_, timer)) = stopTimer timer
            stopAction Nothing           = return ()
        stopAction startedTimerM


findStartedTimer :: [StartedTimer] -> TimerId -> Maybe StartedTimer
findStartedTimer startedTimers id = find (\(id', timer) -> id == id') startedTimers
                                        
       
tick :: TimerId -> TickBuffer -> IO ()
tick id tickBuffer = putInBlockingConcurrentQueue tickBuffer (Tick id)