Timer.hs

{- This file is part of time-out.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Monad transformer for managing a timer.
module Control.Monad.Trans.Timer
    ( -- * Transformer
      TimerT ()
    , runTimerT
      -- * Starting a timer
    , startTimer
    , startTimer'
    , startTimerWith
      -- * Stopping a timer
    , stopTimer
      -- * Restarting a timer
    , restartTimer
    , restartTimer'
    , restartTimerWith
    )
where

import Control.Monad.Catch
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (MonadTrans)
import Control.Monad.Trans.Reader
import Data.Time.Units (TimeUnit)

import qualified Control.Timer as T

newtype TimerT n m a = TimerT
    { unTT :: ReaderT (T.Timer n) m a
    }
    deriving
        ( -- Basics
          Functor
        , Applicative
        , Monad
          -- Extra monads from base
        , MonadFix
          -- Thread operations are IO
        , MonadIO
          -- This is a transformer after all
        , MonadTrans
          -- Exceptions
        , MonadCatch
        , MonadThrow
        , MonadMask
        )

askTimer :: Monad m => TimerT n m (T.Timer n)
askTimer = TimerT ask

runTimerT
    :: (MonadIO m, MonadMask m, MonadIO n, MonadCatch n)
    => TimerT n m a
    -> T.TimerSettings n
    -> m a
runTimerT act sets = T.withTimer sets $ runReaderT $ unTT act

startTimer :: MonadIO m => TimerT n m ()
startTimer = askTimer >>= T.startTimer

startTimer' :: (MonadIO m, TimeUnit t) => t -> TimerT n m ()
startTimer' t = askTimer >>= flip T.startTimer' t

startTimerWith
    :: (TimeUnit t, MonadIO m)
    => Maybe t
    -> Maybe (n ())
    -> TimerT n m ()
startTimerWith mtime maction =
    askTimer >>= \ timer -> T.startTimerWith timer mtime maction

stopTimer :: MonadIO m => TimerT n m ()
stopTimer = askTimer >>= T.stopTimer

restartTimer :: MonadIO m => TimerT n m ()
restartTimer = askTimer >>= T.restartTimer

restartTimer' :: (TimeUnit t, MonadIO m) => t -> TimerT n m ()
restartTimer' t = askTimer >>= flip T.restartTimer' t

restartTimerWith
    :: (TimeUnit t, MonadIO m)
    => Maybe t
    -> Maybe (n ())
    -> TimerT n m ()
restartTimerWith mtime maction =
    askTimer >>= \ timer -> T.restartTimerWith timer mtime maction