{-# LANGUAGE CPP, NoImplicitPrelude, FlexibleContexts #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}
#endif
module System.Timeout.Lifted ( timeout ) where
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 )
import Control.Monad.Trans.Control ( MonadBaseControl, restoreM, liftBaseWith )
#include "inlinable.h"
timeout :: MonadBaseControl IO m => Int -> m a -> m (Maybe a)
timeout :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Maybe a)
timeout Int
t m a
m = (RunInBase m IO -> IO (Maybe (StM m a))) -> m (Maybe (StM m a))
forall a. (RunInBase m IO -> IO a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith (\RunInBase m IO
runInIO -> Int -> IO (StM m a) -> IO (Maybe (StM m a))
forall a. Int -> IO a -> IO (Maybe a)
T.timeout Int
t (m a -> IO (StM m a)
RunInBase m IO
runInIO m a
m)) m (Maybe (StM m a))
-> (Maybe (StM m a) -> m (Maybe a)) -> m (Maybe a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
m (Maybe a)
-> (StM m a -> m (Maybe a)) -> Maybe (StM m a) -> m (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> m a -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just (m a -> m (Maybe a)) -> (StM m a -> m a) -> StM m a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall a. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)
{-# INLINABLE timeout #-}