{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TupleSections #-}

module Control.Monad.Schedule.Sequence where

-- base
import Control.Arrow ((>>>))
import Control.Monad.IO.Class
import Data.Functor.Identity
import qualified Data.List.NonEmpty as NonEmpty

-- transformers
import Control.Monad.Trans.Class

-- monad-schedule
import Control.Monad.Schedule.Class

-- | Any monad can be trivially scheduled by executing all actions sequentially.
newtype SequenceT m a = SequenceT {forall (m :: * -> *) a. SequenceT m a -> m a
unSequence :: m a}
  deriving ((forall a b. (a -> b) -> SequenceT m a -> SequenceT m b)
-> (forall a b. a -> SequenceT m b -> SequenceT m a)
-> Functor (SequenceT m)
forall a b. a -> SequenceT m b -> SequenceT m a
forall a b. (a -> b) -> SequenceT m a -> SequenceT m b
forall (m :: * -> *) a b.
Functor m =>
a -> SequenceT m b -> SequenceT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SequenceT m a -> SequenceT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> SequenceT m a -> SequenceT m b
fmap :: forall a b. (a -> b) -> SequenceT m a -> SequenceT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> SequenceT m b -> SequenceT m a
<$ :: forall a b. a -> SequenceT m b -> SequenceT m a
Functor, Functor (SequenceT m)
Functor (SequenceT m) =>
(forall a. a -> SequenceT m a)
-> (forall a b.
    SequenceT m (a -> b) -> SequenceT m a -> SequenceT m b)
-> (forall a b c.
    (a -> b -> c) -> SequenceT m a -> SequenceT m b -> SequenceT m c)
-> (forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b)
-> (forall a b. SequenceT m a -> SequenceT m b -> SequenceT m a)
-> Applicative (SequenceT m)
forall a. a -> SequenceT m a
forall a b. SequenceT m a -> SequenceT m b -> SequenceT m a
forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b
forall a b. SequenceT m (a -> b) -> SequenceT m a -> SequenceT m b
forall a b c.
(a -> b -> c) -> SequenceT m a -> SequenceT m b -> SequenceT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (SequenceT m)
forall (m :: * -> *) a. Applicative m => a -> SequenceT m a
forall (m :: * -> *) a b.
Applicative m =>
SequenceT m a -> SequenceT m b -> SequenceT m a
forall (m :: * -> *) a b.
Applicative m =>
SequenceT m a -> SequenceT m b -> SequenceT m b
forall (m :: * -> *) a b.
Applicative m =>
SequenceT m (a -> b) -> SequenceT m a -> SequenceT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SequenceT m a -> SequenceT m b -> SequenceT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> SequenceT m a
pure :: forall a. a -> SequenceT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
SequenceT m (a -> b) -> SequenceT m a -> SequenceT m b
<*> :: forall a b. SequenceT m (a -> b) -> SequenceT m a -> SequenceT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> SequenceT m a -> SequenceT m b -> SequenceT m c
liftA2 :: forall a b c.
(a -> b -> c) -> SequenceT m a -> SequenceT m b -> SequenceT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
SequenceT m a -> SequenceT m b -> SequenceT m b
*> :: forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
SequenceT m a -> SequenceT m b -> SequenceT m a
<* :: forall a b. SequenceT m a -> SequenceT m b -> SequenceT m a
Applicative, Applicative (SequenceT m)
Applicative (SequenceT m) =>
(forall a b.
 SequenceT m a -> (a -> SequenceT m b) -> SequenceT m b)
-> (forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b)
-> (forall a. a -> SequenceT m a)
-> Monad (SequenceT m)
forall a. a -> SequenceT m a
forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b
forall a b. SequenceT m a -> (a -> SequenceT m b) -> SequenceT m b
forall (m :: * -> *). Monad m => Applicative (SequenceT m)
forall (m :: * -> *) a. Monad m => a -> SequenceT m a
forall (m :: * -> *) a b.
Monad m =>
SequenceT m a -> SequenceT m b -> SequenceT m b
forall (m :: * -> *) a b.
Monad m =>
SequenceT m a -> (a -> SequenceT m b) -> SequenceT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
SequenceT m a -> (a -> SequenceT m b) -> SequenceT m b
>>= :: forall a b. SequenceT m a -> (a -> SequenceT m b) -> SequenceT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
SequenceT m a -> SequenceT m b -> SequenceT m b
>> :: forall a b. SequenceT m a -> SequenceT m b -> SequenceT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> SequenceT m a
return :: forall a. a -> SequenceT m a
Monad, Monad (SequenceT m)
Monad (SequenceT m) =>
(forall a. IO a -> SequenceT m a) -> MonadIO (SequenceT m)
forall a. IO a -> SequenceT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (SequenceT m)
forall (m :: * -> *) a. MonadIO m => IO a -> SequenceT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> SequenceT m a
liftIO :: forall a. IO a -> SequenceT m a
MonadIO)

instance MonadTrans SequenceT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> SequenceT m a
lift = m a -> SequenceT m a
forall (m :: * -> *) a. m a -> SequenceT m a
SequenceT

{- | Execute all actions in sequence and return their result when all of them are done.
  Essentially, this is 'sequenceA'.
-}
instance (Monad m) => MonadSchedule (SequenceT m) where
  schedule :: forall a.
NonEmpty (SequenceT m a)
-> SequenceT m (NonEmpty a, [SequenceT m a])
schedule = NonEmpty (SequenceT m a) -> SequenceT m (NonEmpty a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
NonEmpty (f a) -> f (NonEmpty a)
sequenceA (NonEmpty (SequenceT m a) -> SequenceT m (NonEmpty a))
-> (SequenceT m (NonEmpty a)
    -> SequenceT m (NonEmpty a, [SequenceT m a]))
-> NonEmpty (SequenceT m a)
-> SequenceT m (NonEmpty a, [SequenceT m a])
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (NonEmpty a -> (NonEmpty a, [SequenceT m a]))
-> SequenceT m (NonEmpty a)
-> SequenceT m (NonEmpty a, [SequenceT m a])
forall a b. (a -> b) -> SequenceT m a -> SequenceT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,[])

type Sequence = SequenceT Identity