{-# LANGUAGE TupleSections #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Control.Monad.Schedule.RoundRobin where

-- base
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 after each other,
--   step by step.
newtype RoundRobinT m a = RoundRobinT { RoundRobinT m a -> m a
unRoundRobin :: m a }
  deriving (a -> RoundRobinT m b -> RoundRobinT m a
(a -> b) -> RoundRobinT m a -> RoundRobinT m b
(forall a b. (a -> b) -> RoundRobinT m a -> RoundRobinT m b)
-> (forall a b. a -> RoundRobinT m b -> RoundRobinT m a)
-> Functor (RoundRobinT m)
forall a b. a -> RoundRobinT m b -> RoundRobinT m a
forall a b. (a -> b) -> RoundRobinT m a -> RoundRobinT m b
forall (m :: * -> *) a b.
Functor m =>
a -> RoundRobinT m b -> RoundRobinT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RoundRobinT m a -> RoundRobinT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RoundRobinT m b -> RoundRobinT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RoundRobinT m b -> RoundRobinT m a
fmap :: (a -> b) -> RoundRobinT m a -> RoundRobinT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RoundRobinT m a -> RoundRobinT m b
Functor, Functor (RoundRobinT m)
a -> RoundRobinT m a
Functor (RoundRobinT m)
-> (forall a. a -> RoundRobinT m a)
-> (forall a b.
    RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b)
-> (forall a b c.
    (a -> b -> c)
    -> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m c)
-> (forall a b.
    RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b)
-> (forall a b.
    RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a)
-> Applicative (RoundRobinT m)
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a
RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b
(a -> b -> c)
-> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m c
forall a. a -> RoundRobinT m a
forall a b. RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a
forall a b. RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
forall a b.
RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b
forall a b c.
(a -> b -> c)
-> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT 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 (RoundRobinT m)
forall (m :: * -> *) a. Applicative m => a -> RoundRobinT m a
forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a
forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m c
<* :: RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m a
*> :: RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
liftA2 :: (a -> b -> c)
-> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m c
<*> :: RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
RoundRobinT m (a -> b) -> RoundRobinT m a -> RoundRobinT m b
pure :: a -> RoundRobinT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> RoundRobinT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (RoundRobinT m)
Applicative, Applicative (RoundRobinT m)
a -> RoundRobinT m a
Applicative (RoundRobinT m)
-> (forall a b.
    RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT m b)
-> (forall a b.
    RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b)
-> (forall a. a -> RoundRobinT m a)
-> Monad (RoundRobinT m)
RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT m b
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
forall a. a -> RoundRobinT m a
forall a b. RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
forall a b.
RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT m b
forall (m :: * -> *). Monad m => Applicative (RoundRobinT m)
forall (m :: * -> *) a. Monad m => a -> RoundRobinT m a
forall (m :: * -> *) a b.
Monad m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
forall (m :: * -> *) a b.
Monad m =>
RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT 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
return :: a -> RoundRobinT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> RoundRobinT m a
>> :: RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
RoundRobinT m a -> RoundRobinT m b -> RoundRobinT m b
>>= :: RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
RoundRobinT m a -> (a -> RoundRobinT m b) -> RoundRobinT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (RoundRobinT m)
Monad, Monad (RoundRobinT m)
Monad (RoundRobinT m)
-> (forall a. IO a -> RoundRobinT m a) -> MonadIO (RoundRobinT m)
IO a -> RoundRobinT m a
forall a. IO a -> RoundRobinT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (RoundRobinT m)
forall (m :: * -> *) a. MonadIO m => IO a -> RoundRobinT m a
liftIO :: IO a -> RoundRobinT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RoundRobinT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (RoundRobinT m)
MonadIO)

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

-- | Execute only the first action, and leave the others for later, preserving the order.
instance Monad m => MonadSchedule (RoundRobinT m) where
  schedule :: NonEmpty (RoundRobinT m a)
-> RoundRobinT m (NonEmpty a, [RoundRobinT m a])
schedule NonEmpty (RoundRobinT m a)
actions = ( , NonEmpty (RoundRobinT m a) -> [RoundRobinT m a]
forall a. NonEmpty a -> [a]
NonEmpty.tail NonEmpty (RoundRobinT m a)
actions) (NonEmpty a -> (NonEmpty a, [RoundRobinT m a]))
-> RoundRobinT m (NonEmpty a)
-> RoundRobinT m (NonEmpty a, [RoundRobinT m a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> NonEmpty a) -> RoundRobinT m a -> RoundRobinT m (NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (RoundRobinT m a) -> RoundRobinT m a
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (RoundRobinT m a)
actions)

type RoundRobin = RoundRobinT Identity