module Control.Monad.Trans.Timeout
( TimeoutT ()
, runTimeoutT
, withTimeoutThrow
, withTimeoutThrow'
, withTimeoutCatch
, withTimeoutCatch'
)
where
import Control.Monad.Catch
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class
import Control.Monad.Timeout.Class
import Control.Monad.Trans.Alarm
import Control.Monad.Trans.Class
import Data.Time.Units (TimeUnit)
newtype TimeoutT m a = TimeoutT
{ unTT :: AlarmT m a
}
deriving
(
Functor
, Applicative
, Monad
, MonadFix
, MonadIO
, MonadTrans
, MonadCatch
, MonadThrow
, MonadMask
)
instance (MonadIO m, MonadCatch m) => MonadTimeout (TimeoutT m) m where
timeoutThrow = withTimeoutThrow'
timeoutCatch = withTimeoutCatch'
runTimeoutT :: (TimeUnit t, MonadIO m, MonadMask m) => TimeoutT m a -> t -> m a
runTimeoutT act t = runAlarmT (unTT act) t
withTimeoutThrow :: (MonadIO m, MonadCatch m) => m a -> TimeoutT m a
withTimeoutThrow act = do
mresult <- withTimeoutCatch act
case mresult of
Nothing -> throwM Timeout
Just result -> return result
withTimeoutThrow'
:: (TimeUnit t, MonadIO m, MonadCatch m)
=> t
-> m a
-> TimeoutT m a
withTimeoutThrow' t act = do
mresult <- withTimeoutCatch' t act
case mresult of
Nothing -> throwM Timeout
Just result -> return result
withTimeoutCatch :: (MonadIO m, MonadCatch m) => m a -> TimeoutT m (Maybe a)
withTimeoutCatch act = TimeoutT $ alarm act
withTimeoutCatch'
:: (TimeUnit t, MonadCatch m, MonadIO m)
=> t
-> m a
-> TimeoutT m (Maybe a)
withTimeoutCatch' t act = TimeoutT $ alarm' t act