{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Control.Monad.Class.MonadTimer.Trans () where
import Control.Monad.Cont (ContT (..))
import Control.Monad.Except (ExceptT (..))
import Control.Monad.Trans (lift)
import qualified Control.Monad.RWS.Lazy as Lazy
import qualified Control.Monad.RWS.Strict as Strict
import qualified Control.Monad.State.Lazy as Lazy
import qualified Control.Monad.State.Strict as Strict
import qualified Control.Monad.Writer.Lazy as Lazy
import qualified Control.Monad.Writer.Strict as Strict
import Control.Monad.Class.MonadTimer
import Control.Monad.Class.MonadSTM.Trans ()
instance MonadDelay m => MonadDelay (ContT r m) where
threadDelay :: Int -> ContT r m ()
threadDelay = m () -> ContT r m ()
forall (m :: * -> *) a. Monad m => m a -> ContT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ContT r m ()) -> (Int -> m ()) -> Int -> ContT r m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance (Monoid w, MonadDelay m) => MonadDelay (Lazy.WriterT w m) where
threadDelay :: Int -> WriterT w m ()
threadDelay = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (Int -> m ()) -> Int -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance (Monoid w, MonadDelay m) => MonadDelay (Strict.WriterT w m) where
threadDelay :: Int -> WriterT w m ()
threadDelay = m () -> WriterT w m ()
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> WriterT w m ()) -> (Int -> m ()) -> Int -> WriterT w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance MonadDelay m => MonadDelay (Lazy.StateT s m) where
threadDelay :: Int -> StateT s m ()
threadDelay = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (Int -> m ()) -> Int -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance MonadDelay m => MonadDelay (Strict.StateT s m) where
threadDelay :: Int -> StateT s m ()
threadDelay = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> (Int -> m ()) -> Int -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance MonadDelay m => MonadDelay (ExceptT e m) where
threadDelay :: Int -> ExceptT e m ()
threadDelay = m () -> ExceptT e m ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT e m ()) -> (Int -> m ()) -> Int -> ExceptT e m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance (Monoid w, MonadDelay m) => MonadDelay (Lazy.RWST r w s m) where
threadDelay :: Int -> RWST r w s m ()
threadDelay = m () -> RWST r w s m ()
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ())
-> (Int -> m ()) -> Int -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance (Monoid w, MonadDelay m) => MonadDelay (Strict.RWST r w s m) where
threadDelay :: Int -> RWST r w s m ()
threadDelay = m () -> RWST r w s m ()
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> RWST r w s m ())
-> (Int -> m ()) -> Int -> RWST r w s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m ()
forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay
instance (Monoid w, MonadTimer m) => MonadTimer (Lazy.WriterT w m) where
registerDelay :: Int -> WriterT w m (TVar (WriterT w m) Bool)
registerDelay = m (TVar m Bool) -> WriterT w m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> WriterT w m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> WriterT w 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 -> WriterT w m a -> WriterT w m (Maybe a)
timeout Int
d WriterT w m a
f = m (Maybe a, w) -> WriterT w m (Maybe a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (Maybe a, w) -> WriterT w m (Maybe a))
-> m (Maybe a, w) -> WriterT w m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
Maybe (a, w)
r <- Int -> m (a, w) -> m (Maybe (a, w))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
f)
(Maybe a, w) -> m (Maybe a, w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, w) -> m (Maybe a, w)) -> (Maybe a, w) -> m (Maybe a, w)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, w)
r of
Maybe (a, w)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, w
forall a. Monoid a => a
mempty)
Just (a
a, w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, w
w)
instance (Monoid w, MonadTimer m) => MonadTimer (Strict.WriterT w m) where
registerDelay :: Int -> WriterT w m (TVar (WriterT w m) Bool)
registerDelay = m (TVar m Bool) -> WriterT w m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> WriterT w m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> WriterT w 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 -> WriterT w m a -> WriterT w m (Maybe a)
timeout Int
d WriterT w m a
f = m (Maybe a, w) -> WriterT w m (Maybe a)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (Maybe a, w) -> WriterT w m (Maybe a))
-> m (Maybe a, w) -> WriterT w m (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
Maybe (a, w)
r <- Int -> m (a, w) -> m (Maybe (a, w))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
f)
(Maybe a, w) -> m (Maybe a, w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, w) -> m (Maybe a, w)) -> (Maybe a, w) -> m (Maybe a, w)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, w)
r of
Maybe (a, w)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, w
forall a. Monoid a => a
mempty)
Just (a
a, w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, w
w)
instance MonadTimer m => MonadTimer (Lazy.StateT s m) where
registerDelay :: Int -> StateT s m (TVar (StateT s m) Bool)
registerDelay = m (TVar m Bool) -> StateT s m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> StateT s m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> StateT s 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 -> StateT s m a -> StateT s m (Maybe a)
timeout Int
d StateT s m a
f = (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (Maybe a, s)) -> StateT s m (Maybe a))
-> (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \s
s -> do
Maybe (a, s)
r <- Int -> m (a, s) -> m (Maybe (a, s))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
f s
s)
(Maybe a, s) -> m (Maybe a, s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, s) -> m (Maybe a, s)) -> (Maybe a, s) -> m (Maybe a, s)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, s)
r of
Maybe (a, s)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, s
s)
Just (a
a, s
s') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, s
s')
instance MonadTimer m => MonadTimer (Strict.StateT s m) where
registerDelay :: Int -> StateT s m (TVar (StateT s m) Bool)
registerDelay = m (TVar m Bool) -> StateT s m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> StateT s m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> StateT s 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 -> StateT s m a -> StateT s m (Maybe a)
timeout Int
d StateT s m a
f = (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (Maybe a, s)) -> StateT s m (Maybe a))
-> (s -> m (Maybe a, s)) -> StateT s m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \s
s -> do
Maybe (a, s)
r <- Int -> m (a, s) -> m (Maybe (a, s))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
f s
s)
(Maybe a, s) -> m (Maybe a, s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, s) -> m (Maybe a, s)) -> (Maybe a, s) -> m (Maybe a, s)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, s)
r of
Maybe (a, s)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, s
s)
Just (a
a, s
s') -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, s
s')
instance (Monoid w, MonadTimer m) => MonadTimer (Lazy.RWST r w s m) where
registerDelay :: Int -> RWST r w s m (TVar (RWST r w s m) Bool)
registerDelay = m (TVar m Bool) -> RWST r w s m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> RWST r w s m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> RWST r w s 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 -> RWST r w s m a -> RWST r w s m (Maybe a)
timeout Int
d (Lazy.RWST r -> s -> m (a, s, w)
f) = (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a))
-> (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> do
Maybe (a, s, w)
res <- Int -> m (a, s, w) -> m (Maybe (a, s, w))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (r -> s -> m (a, s, w)
f r
r s
s)
(Maybe a, s, w) -> m (Maybe a, s, w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, s, w) -> m (Maybe a, s, w))
-> (Maybe a, s, w) -> m (Maybe a, s, w)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, s, w)
res of
Maybe (a, s, w)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, s
s, w
forall a. Monoid a => a
mempty)
Just (a
a, s
s', w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, s
s', w
w)
instance (Monoid w, MonadTimer m) => MonadTimer (Strict.RWST r w s m) where
registerDelay :: Int -> RWST r w s m (TVar (RWST r w s m) Bool)
registerDelay = m (TVar m Bool) -> RWST r w s m (TVar m Bool)
forall (m :: * -> *) a. Monad m => m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (TVar m Bool) -> RWST r w s m (TVar m Bool))
-> (Int -> m (TVar m Bool)) -> Int -> RWST r w s 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 -> RWST r w s m a -> RWST r w s m (Maybe a)
timeout Int
d (Strict.RWST r -> s -> m (a, s, w)
f) = (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a))
-> (r -> s -> m (Maybe a, s, w)) -> RWST r w s m (Maybe a)
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> do
Maybe (a, s, w)
res <- Int -> m (a, s, w) -> m (Maybe (a, s, w))
forall a. Int -> m a -> m (Maybe a)
forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (r -> s -> m (a, s, w)
f r
r s
s)
(Maybe a, s, w) -> m (Maybe a, s, w)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe a, s, w) -> m (Maybe a, s, w))
-> (Maybe a, s, w) -> m (Maybe a, s, w)
forall a b. (a -> b) -> a -> b
$ case Maybe (a, s, w)
res of
Maybe (a, s, w)
Nothing -> (Maybe a
forall a. Maybe a
Nothing, s
s, w
forall a. Monoid a => a
mempty)
Just (a
a, s
s', w
w) -> (a -> Maybe a
forall a. a -> Maybe a
Just a
a, s
s', w
w)