    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE OverloadedStrings #-}
    module SDL.Time
      ( -- * Time Measurement
        ticks
      , time

        -- * Timer
      , delay
      , TimerCallback
      , Timer
      , RetriggerTimer(..)
      , addTimer
      , removeTimer
      ) where

    import Control.Monad.IO.Class (MonadIO, liftIO)
    import Data.Data (Data)
    import Data.Typeable
    import Data.Word
    import Foreign
    import GHC.Generics (Generic)

    import SDL.Internal.Exception

    import qualified SDL.Raw.Timer as Raw
    import qualified SDL.Raw.Types as Raw

    -- | Number of milliseconds since library initialization.
    --
    -- See @<https://wiki.libsdl.org/SDL_GetTicks SDL_GetTicks>@ for C documentation.
    ticks :: MonadIO m => m Word32
    ticks = Raw.getTicks

    -- | The current time in seconds since some arbitrary starting point (consist over the life of the application).
    --
    -- This time is derived from the system's performance counter - see @<https://wiki.libsdl.org/SDL_GetPerformanceFrequency SDL_GetPerformanceFrequency>@ and @<https://wiki.libsdl.org/SDL_GetPerformanceCounter SDL_GetPerformanceCounter>@ for C documentation about the implementation.
    time :: (Fractional a, MonadIO m) => m a
    time = do
      freq <- Raw.getPerformanceFrequency
      cnt <- Raw.getPerformanceCounter
      return $ fromIntegral cnt / fromIntegral freq

    -- | Wait a specified number of milliseconds before returning.
    --
    -- Users are generally recommended to use 'threadDelay' instead, to take advantage of the abilities of the Haskell runtime.
    --
    -- See @<https://wiki.libsdl.org/SDL_Delay SDL_Delay>@ for C documentation.
    delay :: MonadIO m => Word32 -> m ()
    delay = Raw.delay

    -- | 'RetriggerTimer' allows a callback to inform SDL if the timer should be retriggered or cancelled
    data RetriggerTimer
      = Reschedule Word32
        -- ^ Retrigger the timer again in a given number of milliseconds.
      | Cancel
        -- ^ Cancel future invocations of this timer.
      deriving (Data, Eq, Generic, Ord, Read, Show, Typeable)

    -- | A 'TimerCallback' is called with the interval size of the callback. It can return information as to whether or not the timer should continue to exist.
    type TimerCallback = Word32 -> IO RetriggerTimer

    -- | A timer created by 'addTimer'. This 'Timer' can be removed with 'removeTimer'.
    newtype Timer =
      Timer {runTimerRemoval :: IO Bool}

    -- | Set up a callback function to be run on a separate thread after the specified number of milliseconds has elapsed.
    --
    -- See @<https://wiki.libsdl.org/SDL_AddTimer SDL_AddTimer>@ for C documentation.
    addTimer :: MonadIO m => Word32 -> TimerCallback -> m Timer
    addTimer timeout callback = liftIO $ do
        cb <- Raw.mkTimerCallback wrappedCb
        tid <- throwIf0 "addTimer" "SDL_AddTimer" $ Raw.addTimer timeout cb nullPtr
        return (Timer $ auxRemove cb tid)
      where
        wrappedCb :: Word32 -> Ptr () -> IO Word32
        wrappedCb w _ = do
          next <- callback w
          return $ case next of
            Cancel       -> 0
            Reschedule n -> n

        auxRemove :: Raw.TimerCallback -> Raw.TimerID -> IO Bool
        auxRemove cb tid = do
          isSuccess <- Raw.removeTimer tid
          if (isSuccess)
            then freeHaskellFunPtr cb >> return True
            else return False

    -- | Remove a 'Timer'.
    --
    -- See @<https://wiki.libsdl.org/SDL_RemoveTimer SDL_RemoveTimer>@ for C documentation.
    removeTimer :: MonadIO m => Timer -> m Bool
    removeTimer f = liftIO $ runTimerRemoval f