-- undecidable instances needed for 'ContTSTM' instances of
-- 'MonadThrow' and 'MonadCatch' type classes.
{-# 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.RWS.Lazy qualified as Lazy
import Control.Monad.RWS.Strict qualified as Strict
import Control.Monad.State.Lazy qualified as Lazy
import Control.Monad.State.Strict qualified as Strict
import Control.Monad.Trans (lift)
import Control.Monad.Writer.Lazy qualified as Lazy
import Control.Monad.Writer.Strict qualified 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)