{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Control.Monad.Class.MonadTimer
( MonadDelay (..)
, MonadTimer (..)
) where
import Control.Concurrent qualified as IO
import Control.Concurrent.Class.MonadSTM
import Control.Concurrent.STM.TVar qualified as STM
import Control.Monad.Reader (ReaderT (..))
import Control.Monad.Trans (lift)
import System.Timeout qualified as IO
class Monad m => MonadDelay m where
threadDelay :: Int -> m ()
class (MonadDelay m, MonadSTM m) => MonadTimer m where
registerDelay :: Int -> m (TVar m Bool)
timeout :: Int -> m a -> m (Maybe a)
instance MonadDelay IO where
threadDelay :: Int -> IO ()
threadDelay = Int -> IO ()
IO.threadDelay
instance MonadTimer IO where
registerDelay :: Int -> IO (TVar IO Bool)
registerDelay = Int -> IO (TVar Bool)
Int -> IO (TVar IO Bool)
STM.registerDelay
timeout :: forall a. Int -> IO a -> IO (Maybe a)
timeout = Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
IO.timeout
instance MonadDelay m => MonadDelay (ReaderT r m) where
threadDelay :: Int -> ReaderT r m ()
threadDelay = m () -> ReaderT r m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT r m ()) -> (Int -> m ()) -> Int -> ReaderT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance MonadTimer m => MonadTimer (ReaderT r m) where
registerDelay :: Int -> ReaderT r m (TVar (ReaderT r m) Bool)
registerDelay = m (TVar m Bool) -> ReaderT r m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> ReaderT r m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> ReaderT r m (TVar m Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => Int -> m (TVar m Bool)
registerDelay
timeout :: forall a. Int -> ReaderT r m a -> ReaderT r m (Maybe a)
timeout Int
d ReaderT r m a
f = (r -> m (Maybe a)) -> ReaderT r m (Maybe a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m (Maybe a)) -> ReaderT r m (Maybe a))
-> (r -> m (Maybe a)) -> ReaderT r m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \r
r -> Int -> m a -> m (Maybe a)
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
f r
r)