{ This file is part of timeout.

 Written in 2016 by fr33domlover .

 ♡ 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
 .
}
{# LANGUAGE FlexibleInstances #}
{# LANGUAGE GeneralizedNewtypeDeriving #}
{# LANGUAGE MultiParamTypeClasses #}
  Monad transformer for running actions with a time limit. Provides a
 scalable @MonadTimeout@ instance (at least for the case of a constant number
 of longrunning threads). If you need to use timeouts often in a
 computation, this is probably better than "Control.Timeout".
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)
  Monad transformer which gives your monad stack an ability to run actions
 with a timeout, and abort them if they don't finish within the time limit.

 By default, e.g. if you 'lift' or 'liftIO' an action, it runs in the regular
 way without a timeout. Use one of the timeout functions, such as
 'withTimeoutThrow', to use the timeout.
newtype TimeoutT m a = TimeoutT
{ unTT :: AlarmT 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
)
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