{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
-------------------------------------------------------------------------------
-- |
-- Module : System.Timeout.Lifted
-- Copyright : (c) The University of Glasgow 2007
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : non-portable
--
-- Attach a timeout event to monadic computations
-- which are instances of 'MonadBaseControl'.
--
-------------------------------------------------------------------------------
module System.Timeout.Lifted ( timeout ) where
-- from base:
import Prelude ( (.) )
import Data.Int ( Int )
import Data.Maybe ( Maybe(Nothing, Just), maybe )
import Control.Monad ( (>>=), return, liftM )
import System.IO ( IO )
import qualified System.Timeout as T ( timeout )
-- from monad-control:
import Control.Monad.Trans.Control ( MonadBaseControl, restoreM, liftBaseWith )
#include "inlinable.h"
-- | Generalized version of 'T.timeout'.
--
-- Note that when the given computation times out any side effects of @m@ are
-- discarded. When the computation completes within the given time the
-- side-effects are restored on return.
timeout :: MonadBaseControl IO m => Int -> m a -> m (Maybe a)
timeout t m = liftBaseWith (\runInIO -> T.timeout t (runInIO m)) >>=
maybe (return Nothing) (liftM Just . restoreM)
{-# INLINABLE timeout #-}