-- 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.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)