{-# 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