-- 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay

instance (Monoid w, MonadDelay m) => MonadDelay (Lazy.WriterT w m) where
  threadDelay :: Int -> WriterT w m ()
threadDelay = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay

instance (Monoid w, MonadDelay m) => MonadDelay (Strict.WriterT w m) where
  threadDelay :: Int -> WriterT w m ()
threadDelay = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay

instance MonadDelay m => MonadDelay (Lazy.StateT s m) where
  threadDelay :: Int -> StateT s m ()
threadDelay = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay

instance MonadDelay m => MonadDelay (Strict.StateT s m) where
  threadDelay :: Int -> StateT s m ()
threadDelay = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay

instance MonadDelay m => MonadDelay (ExceptT e m) where
  threadDelay :: Int -> ExceptT e m ()
threadDelay = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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   = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall a b. (a -> b) -> a -> b
$ do
    Maybe (a, w)
r <- forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT WriterT w m a
f)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, w)
r of
      Maybe (a, w)
Nothing     -> (forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
      Just (a
a, w
w) -> (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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   = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall a b. (a -> b) -> a -> b
$ do
    Maybe (a, w)
r <- forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT WriterT w m a
f)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, w)
r of
      Maybe (a, w)
Nothing     -> (forall a. Maybe a
Nothing, forall a. Monoid a => a
mempty)
      Just (a
a, w
w) -> (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> do
    Maybe (a, s)
r <- forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
f s
s)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, s)
r of
      Maybe (a, s)
Nothing      -> (forall a. Maybe a
Nothing, s
s)
      Just (a
a, s
s') -> (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \s
s -> do
    Maybe (a, s)
r <- forall (m :: * -> *) a. MonadTimer m => Int -> m a -> m (Maybe a)
timeout Int
d (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
f s
s)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, s)
r of
      Maybe (a, s)
Nothing      -> (forall a. Maybe a
Nothing, s
s)
      Just (a
a, s
s') -> (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> do
    Maybe (a, s, w)
res <- 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)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, s, w)
res of
      Maybe (a, s, w)
Nothing         -> (forall a. Maybe a
Nothing, s
s, forall a. Monoid a => a
mempty)
      Just (a
a, s
s', w
w) -> (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 = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
r s
s -> do
    Maybe (a, s, w)
res <- 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)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (a, s, w)
res of
      Maybe (a, s, w)
Nothing         -> (forall a. Maybe a
Nothing, s
s, forall a. Monoid a => a
mempty)
      Just (a
a, s
s', w
w) -> (forall a. a -> Maybe a
Just a
a, s
s', w
w)