{- |
This module supplies a general purpose monad transformer
that adds a syntactical "delay", or "waiting" side effect.
-}

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Control.Monad.Schedule.Trans where

-- base
import Data.Ord (comparing)
import Control.Arrow (Arrow(second))
import Control.Concurrent
import qualified Control.Concurrent as C
import Control.Category ((>>>))
import Control.Monad (join)
import Data.Functor.Classes
import Data.List.NonEmpty as N

-- transformers
import Control.Monad.IO.Class
import Control.Monad.Trans.Class

-- free
import Control.Monad.Trans.Free

-- time-domain
import Data.TimeDomain

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

-- TODO Implement Time via StateT

-- * Waiting action

-- | A functor implementing a syntactical "waiting" action.
data Wait diff a = Wait
  { Wait diff a -> diff
getDiff :: diff
      -- ^ The duration to wait.
  , Wait diff a -> a
awaited :: a
      -- ^ The encapsulated value.
  }
  deriving (a -> Wait diff b -> Wait diff a
(a -> b) -> Wait diff a -> Wait diff b
(forall a b. (a -> b) -> Wait diff a -> Wait diff b)
-> (forall a b. a -> Wait diff b -> Wait diff a)
-> Functor (Wait diff)
forall a b. a -> Wait diff b -> Wait diff a
forall a b. (a -> b) -> Wait diff a -> Wait diff b
forall diff a b. a -> Wait diff b -> Wait diff a
forall diff a b. (a -> b) -> Wait diff a -> Wait diff b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Wait diff b -> Wait diff a
$c<$ :: forall diff a b. a -> Wait diff b -> Wait diff a
fmap :: (a -> b) -> Wait diff a -> Wait diff b
$cfmap :: forall diff a b. (a -> b) -> Wait diff a -> Wait diff b
Functor, Wait diff a -> Wait diff a -> Bool
(Wait diff a -> Wait diff a -> Bool)
-> (Wait diff a -> Wait diff a -> Bool) -> Eq (Wait diff a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall diff a.
(Eq diff, Eq a) =>
Wait diff a -> Wait diff a -> Bool
/= :: Wait diff a -> Wait diff a -> Bool
$c/= :: forall diff a.
(Eq diff, Eq a) =>
Wait diff a -> Wait diff a -> Bool
== :: Wait diff a -> Wait diff a -> Bool
$c== :: forall diff a.
(Eq diff, Eq a) =>
Wait diff a -> Wait diff a -> Bool
Eq, Int -> Wait diff a -> ShowS
[Wait diff a] -> ShowS
Wait diff a -> String
(Int -> Wait diff a -> ShowS)
-> (Wait diff a -> String)
-> ([Wait diff a] -> ShowS)
-> Show (Wait diff a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall diff a. (Show diff, Show a) => Int -> Wait diff a -> ShowS
forall diff a. (Show diff, Show a) => [Wait diff a] -> ShowS
forall diff a. (Show diff, Show a) => Wait diff a -> String
showList :: [Wait diff a] -> ShowS
$cshowList :: forall diff a. (Show diff, Show a) => [Wait diff a] -> ShowS
show :: Wait diff a -> String
$cshow :: forall diff a. (Show diff, Show a) => Wait diff a -> String
showsPrec :: Int -> Wait diff a -> ShowS
$cshowsPrec :: forall diff a. (Show diff, Show a) => Int -> Wait diff a -> ShowS
Show)

instance Eq diff => Eq1 (Wait diff) where
  liftEq :: (a -> b -> Bool) -> Wait diff a -> Wait diff b -> Bool
liftEq a -> b -> Bool
eq (Wait diff
diff1 a
a) (Wait diff
diff2 b
b) = diff
diff1 diff -> diff -> Bool
forall a. Eq a => a -> a -> Bool
== diff
diff2 Bool -> Bool -> Bool
&& a -> b -> Bool
eq a
a b
b

-- | Compare by the time difference, regardless of the value.
compareWait :: Ord diff => Wait diff a -> Wait diff a -> Ordering
compareWait :: Wait diff a -> Wait diff a -> Ordering
compareWait = (Wait diff a -> diff) -> Wait diff a -> Wait diff a -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Wait diff a -> diff
forall diff a. Wait diff a -> diff
getDiff

-- * 'ScheduleT'

{- |
Values in @ScheduleT diff m@ are delayed computations with side effects in 'm'.
Delays can occur between any two side effects, with lengths specified by a 'diff' value.
These delays don't have any semantics, it can be given to them with 'runScheduleT'.
-}
type ScheduleT diff = FreeT (Wait diff)

-- | The side effect that waits for a specified amount.
wait :: Monad m => diff -> ScheduleT diff m ()
wait :: diff -> ScheduleT diff m ()
wait diff
diff = m (FreeF (Wait diff) () (ScheduleT diff m ()))
-> ScheduleT diff m ()
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (Wait diff) () (ScheduleT diff m ()))
 -> ScheduleT diff m ())
-> m (FreeF (Wait diff) () (ScheduleT diff m ()))
-> ScheduleT diff m ()
forall a b. (a -> b) -> a -> b
$ FreeF (Wait diff) () (ScheduleT diff m ())
-> m (FreeF (Wait diff) () (ScheduleT diff m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF (Wait diff) () (ScheduleT diff m ())
 -> m (FreeF (Wait diff) () (ScheduleT diff m ())))
-> FreeF (Wait diff) () (ScheduleT diff m ())
-> m (FreeF (Wait diff) () (ScheduleT diff m ()))
forall a b. (a -> b) -> a -> b
$ Wait diff (ScheduleT diff m ())
-> FreeF (Wait diff) () (ScheduleT diff m ())
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (Wait diff (ScheduleT diff m ())
 -> FreeF (Wait diff) () (ScheduleT diff m ()))
-> Wait diff (ScheduleT diff m ())
-> FreeF (Wait diff) () (ScheduleT diff m ())
forall a b. (a -> b) -> a -> b
$ diff -> ScheduleT diff m () -> Wait diff (ScheduleT diff m ())
forall diff a. diff -> a -> Wait diff a
Wait diff
diff (ScheduleT diff m () -> Wait diff (ScheduleT diff m ()))
-> ScheduleT diff m () -> Wait diff (ScheduleT diff m ())
forall a b. (a -> b) -> a -> b
$ () -> ScheduleT diff m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Supply a semantic meaning to 'Wait'.
--   For every occurrence of @Wait diff@ in the @ScheduleT diff m a@ value,
--   a waiting action is executed, depending on 'diff'.
runScheduleT :: Monad m => (diff -> m ()) -> ScheduleT diff m a -> m a
runScheduleT :: (diff -> m ()) -> ScheduleT diff m a -> m a
runScheduleT diff -> m ()
waitAction = (Wait diff (m a) -> m a) -> ScheduleT diff m a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FreeT f m a -> m a
iterT ((Wait diff (m a) -> m a) -> ScheduleT diff m a -> m a)
-> (Wait diff (m a) -> m a) -> ScheduleT diff m a -> m a
forall a b. (a -> b) -> a -> b
$ \(Wait diff
n m a
ma) -> diff -> m ()
waitAction diff
n m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
ma

-- | Run a 'ScheduleT' value in a 'MonadIO',
--   interpreting the times as milliseconds.
runScheduleIO
  :: (MonadIO m, Integral n)
  => ScheduleT n m a -> m a
runScheduleIO :: ScheduleT n m a -> m a
runScheduleIO = (n -> m ()) -> ScheduleT n m a -> m a
forall (m :: * -> *) diff a.
Monad m =>
(diff -> m ()) -> ScheduleT diff m a -> m a
runScheduleT ((n -> m ()) -> ScheduleT n m a -> m a)
-> (n -> m ()) -> ScheduleT n m a -> m a
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (n -> IO ()) -> n -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO ()
threadDelay (Int -> IO ()) -> (n -> Int) -> n -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000) (Int -> Int) -> (n -> Int) -> n -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Formally execute all waiting actions,
--   returning the final value and all moments when the schedule would have waited.
execScheduleT :: Monad m => ScheduleT diff m a -> m (a, [diff])
execScheduleT :: ScheduleT diff m a -> m (a, [diff])
execScheduleT ScheduleT diff m a
action = do
  FreeF (Wait diff) a (ScheduleT diff m a)
free <- ScheduleT diff m a -> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT ScheduleT diff m a
action
  case FreeF (Wait diff) a (ScheduleT diff m a)
free of
    Pure a
a -> (a, [diff]) -> m (a, [diff])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, [])
    Free (Wait diff
diff ScheduleT diff m a
cont) -> do
      (a
a, [diff]
diffs) <- ScheduleT diff m a -> m (a, [diff])
forall (m :: * -> *) diff a.
Monad m =>
ScheduleT diff m a -> m (a, [diff])
execScheduleT ScheduleT diff m a
cont
      (a, [diff]) -> m (a, [diff])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, diff
diff diff -> [diff] -> [diff]
forall a. a -> [a] -> [a]
: [diff]
diffs)

instance Ord diff => MonadSchedule (Wait diff) where
  schedule :: NonEmpty (Wait diff a) -> Wait diff (NonEmpty a, [Wait diff a])
schedule NonEmpty (Wait diff a)
waits = let (Wait diff a
smallestWait :| [Wait diff a]
waits') = (Wait diff a -> Wait diff a -> Ordering)
-> NonEmpty (Wait diff a) -> NonEmpty (Wait diff a)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
N.sortBy Wait diff a -> Wait diff a -> Ordering
forall diff a. Ord diff => Wait diff a -> Wait diff a -> Ordering
compareWait NonEmpty (Wait diff a)
waits in ((, [Wait diff a]
waits') (NonEmpty a -> (NonEmpty a, [Wait diff a]))
-> (a -> NonEmpty a) -> a -> (NonEmpty a, [Wait diff a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (a -> (NonEmpty a, [Wait diff a]))
-> Wait diff a -> Wait diff (NonEmpty a, [Wait diff a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Wait diff a
smallestWait

-- | Run each action one step until it is discovered which action(s) are pure, or yield next.
--   If there is a pure action, it is returned,
--   otherwise all actions are shifted to the time when the earliest action yields.
instance (Ord diff, TimeDifference diff, Monad m, MonadSchedule m) => MonadSchedule (ScheduleT diff m) where
  schedule :: NonEmpty (ScheduleT diff m a)
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
schedule NonEmpty (ScheduleT diff m a)
actions = do
    (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
frees, [m (FreeF (Wait diff) a (ScheduleT diff m a))]
delayed) <- m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
   [m (FreeF (Wait diff) a (ScheduleT diff m a))])
-> FreeT
     (Wait diff)
     m
     (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
      [m (FreeF (Wait diff) a (ScheduleT diff m a))])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
    [m (FreeF (Wait diff) a (ScheduleT diff m a))])
 -> FreeT
      (Wait diff)
      m
      (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
       [m (FreeF (Wait diff) a (ScheduleT diff m a))]))
-> m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
      [m (FreeF (Wait diff) a (ScheduleT diff m a))])
-> FreeT
     (Wait diff)
     m
     (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
      [m (FreeF (Wait diff) a (ScheduleT diff m a))])
forall a b. (a -> b) -> a -> b
$ NonEmpty (m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
      [m (FreeF (Wait diff) a (ScheduleT diff m a))])
forall (m :: * -> *) a.
MonadSchedule m =>
NonEmpty (m a) -> m (NonEmpty a, [m a])
schedule (NonEmpty (m (FreeF (Wait diff) a (ScheduleT diff m a)))
 -> m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
       [m (FreeF (Wait diff) a (ScheduleT diff m a))]))
-> NonEmpty (m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> m (NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a)),
      [m (FreeF (Wait diff) a (ScheduleT diff m a))])
forall a b. (a -> b) -> a -> b
$ ScheduleT diff m a -> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (ScheduleT diff m a
 -> m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> NonEmpty (ScheduleT diff m a)
-> NonEmpty (m (FreeF (Wait diff) a (ScheduleT diff m a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ScheduleT diff m a)
actions
    NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-> [ScheduleT diff m a]
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
forall diff (m :: * -> *) a.
(TimeDifference diff, Ord diff, Monad m, MonadSchedule m) =>
NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-> [ScheduleT diff m a]
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
shiftList ((FreeF (Wait diff) a (ScheduleT diff m a)
 -> FreeF (Wait diff) a (ScheduleT diff m a) -> Ordering)
-> NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-> NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
sortBy FreeF (Wait diff) a (ScheduleT diff m a)
-> FreeF (Wait diff) a (ScheduleT diff m a) -> Ordering
forall diff a b.
Ord diff =>
FreeF (Wait diff) a b -> FreeF (Wait diff) a b -> Ordering
compareFreeFWait NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
frees) ([ScheduleT diff m a]
 -> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a]))
-> [ScheduleT diff m a]
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
forall a b. (a -> b) -> a -> b
$ m (FreeF (Wait diff) a (ScheduleT diff m a)) -> ScheduleT diff m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (Wait diff) a (ScheduleT diff m a))
 -> ScheduleT diff m a)
-> [m (FreeF (Wait diff) a (ScheduleT diff m a))]
-> [ScheduleT diff m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [m (FreeF (Wait diff) a (ScheduleT diff m a))]
delayed
    where
      compareFreeFWait
        :: Ord diff
        => FreeF (Wait diff) a b
        -> FreeF (Wait diff) a b
        -> Ordering
      compareFreeFWait :: FreeF (Wait diff) a b -> FreeF (Wait diff) a b -> Ordering
compareFreeFWait (Pure a
_) (Pure a
_) = Ordering
EQ
      compareFreeFWait (Pure a
_) (Free Wait diff b
_) = Ordering
LT
      compareFreeFWait (Free Wait diff b
_) (Pure a
_) = Ordering
GT
      compareFreeFWait (Free Wait diff b
wait1) (Free Wait diff b
wait2) = Wait diff b -> Wait diff b -> Ordering
forall diff a. Ord diff => Wait diff a -> Wait diff a -> Ordering
compareWait Wait diff b
wait1 Wait diff b
wait2

      -- Separate pure from free values
      partitionFreeF
        :: [FreeF f a b]
        -> ([a], [f b])
      partitionFreeF :: [FreeF f a b] -> ([a], [f b])
partitionFreeF [] = ([], [])
      partitionFreeF (Pure a
a  : [FreeF f a b]
xs) = let ([a]
as, [f b]
fbs) = [FreeF f a b] -> ([a], [f b])
forall (f :: * -> *) a b. [FreeF f a b] -> ([a], [f b])
partitionFreeF [FreeF f a b]
xs in (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as, [f b]
fbs)
      partitionFreeF (Free f b
fb : [FreeF f a b]
xs) = let ([a]
as, [f b]
fbs) = [FreeF f a b] -> ([a], [f b])
forall (f :: * -> *) a b. [FreeF f a b] -> ([a], [f b])
partitionFreeF [FreeF f a b]
xs in ([a]
as, f b
fb f b -> [f b] -> [f b]
forall a. a -> [a] -> [a]
: [f b]
fbs)

      -- Shift a waiting action by some duration
      shift
        :: TimeDifference diff
        => diff
        -> Wait diff a
        -> Wait diff a
      shift :: diff -> Wait diff a -> Wait diff a
shift diff
diff1 (Wait diff
diff2 a
a) = diff -> a -> Wait diff a
forall diff a. diff -> a -> Wait diff a
Wait (diff
diff2 diff -> diff -> diff
forall d. TimeDifference d => d -> d -> d
`difference` diff
diff1) a
a

      -- Shift a list of free actions by the duration of the head
      -- (assuming the list is sorted).
      -- If the head is pure, return it with the remaining actions,
      -- otherwise wait the minimum duration, give the continuation of the head,
      -- and shift the remaining actions by that minimum duration.
      shiftListOnce
        :: TimeDifference diff
        => NonEmpty (FreeF (Wait diff) a b)
        -> Either
             (NonEmpty a, [Wait diff b]) -- Pure value has completed
             (Wait diff (b, [Wait diff b])) -- All values wait
      shiftListOnce :: NonEmpty (FreeF (Wait diff) a b)
-> Either
     (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b]))
shiftListOnce NonEmpty (FreeF (Wait diff) a b)
actions = case [FreeF (Wait diff) a b] -> ([a], [Wait diff b])
forall (f :: * -> *) a b. [FreeF f a b] -> ([a], [f b])
partitionFreeF ([FreeF (Wait diff) a b] -> ([a], [Wait diff b]))
-> [FreeF (Wait diff) a b] -> ([a], [Wait diff b])
forall a b. (a -> b) -> a -> b
$ NonEmpty (FreeF (Wait diff) a b) -> [FreeF (Wait diff) a b]
forall a. NonEmpty a -> [a]
toList NonEmpty (FreeF (Wait diff) a b)
actions of
        (a
a : [a]
as, [Wait diff b]
waits) -> (NonEmpty a, [Wait diff b])
-> Either
     (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b]))
forall a b. a -> Either a b
Left (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as, [Wait diff b]
waits)
        ([], Wait diff
diff b
cont : [Wait diff b]
waits) -> Wait diff (b, [Wait diff b])
-> Either
     (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b]))
forall a b. b -> Either a b
Right (Wait diff (b, [Wait diff b])
 -> Either
      (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b])))
-> Wait diff (b, [Wait diff b])
-> Either
     (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b]))
forall a b. (a -> b) -> a -> b
$ diff -> (b, [Wait diff b]) -> Wait diff (b, [Wait diff b])
forall diff a. diff -> a -> Wait diff a
Wait diff
diff (b
cont, diff -> Wait diff b -> Wait diff b
forall diff a.
TimeDifference diff =>
diff -> Wait diff a -> Wait diff a
shift diff
diff (Wait diff b -> Wait diff b) -> [Wait diff b] -> [Wait diff b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Wait diff b]
waits)

      -- Repeatedly shift the list by the smallest available waiting duration
      -- until one action returns as pure.
      -- Return its result, together with the remaining free actions.
      shiftList
        :: (TimeDifference diff, Ord diff, Monad m, MonadSchedule m)
        => NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
        -- ^ Actionable
        -> [ScheduleT diff m a]
        -- ^ Delayed
        -> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
      shiftList :: NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-> [ScheduleT diff m a]
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
shiftList NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
actions [ScheduleT diff m a]
delayed = case NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
-> Either
     (NonEmpty a, [Wait diff (ScheduleT diff m a)])
     (Wait diff (ScheduleT diff m a, [Wait diff (ScheduleT diff m a)]))
forall diff a b.
TimeDifference diff =>
NonEmpty (FreeF (Wait diff) a b)
-> Either
     (NonEmpty a, [Wait diff b]) (Wait diff (b, [Wait diff b]))
shiftListOnce NonEmpty (FreeF (Wait diff) a (ScheduleT diff m a))
actions of
        -- Some actions returned. Wrap up the remaining ones.
        Left (NonEmpty a
as, [Wait diff (ScheduleT diff m a)]
waits) -> (NonEmpty a, [ScheduleT diff m a])
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty a
as, [ScheduleT diff m a]
delayed [ScheduleT diff m a]
-> [ScheduleT diff m a] -> [ScheduleT diff m a]
forall a. [a] -> [a] -> [a]
++ ((m (FreeF (Wait diff) a (ScheduleT diff m a)) -> ScheduleT diff m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (Wait diff) a (ScheduleT diff m a))
 -> ScheduleT diff m a)
-> (Wait diff (ScheduleT diff m a)
    -> m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> Wait diff (ScheduleT diff m a)
-> ScheduleT diff m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeF (Wait diff) a (ScheduleT diff m a)
-> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF (Wait diff) a (ScheduleT diff m a)
 -> m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> (Wait diff (ScheduleT diff m a)
    -> FreeF (Wait diff) a (ScheduleT diff m a))
-> Wait diff (ScheduleT diff m a)
-> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wait diff (ScheduleT diff m a)
-> FreeF (Wait diff) a (ScheduleT diff m a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free) (Wait diff (ScheduleT diff m a) -> ScheduleT diff m a)
-> [Wait diff (ScheduleT diff m a)] -> [ScheduleT diff m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Wait diff (ScheduleT diff m a)]
waits))
        -- No action has returned.
        -- Wait the remaining time and start scheduling again.
        Right (Wait diff
diff (ScheduleT diff m a
cont, [Wait diff (ScheduleT diff m a)]
waits)) -> do
          diff -> ScheduleT diff m ()
forall (m :: * -> *) diff. Monad m => diff -> ScheduleT diff m ()
wait diff
diff
          NonEmpty (ScheduleT diff m a)
-> ScheduleT diff m (NonEmpty a, [ScheduleT diff m a])
forall (m :: * -> *) a.
MonadSchedule m =>
NonEmpty (m a) -> m (NonEmpty a, [m a])
schedule (ScheduleT diff m a
cont ScheduleT diff m a
-> [ScheduleT diff m a] -> NonEmpty (ScheduleT diff m a)
forall a. a -> [a] -> NonEmpty a
:| [ScheduleT diff m a]
delayed [ScheduleT diff m a]
-> [ScheduleT diff m a] -> [ScheduleT diff m a]
forall a. [a] -> [a] -> [a]
++ ((m (FreeF (Wait diff) a (ScheduleT diff m a)) -> ScheduleT diff m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (Wait diff) a (ScheduleT diff m a))
 -> ScheduleT diff m a)
-> (Wait diff (ScheduleT diff m a)
    -> m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> Wait diff (ScheduleT diff m a)
-> ScheduleT diff m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeF (Wait diff) a (ScheduleT diff m a)
-> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall (m :: * -> *) a. Monad m => a -> m a
return (FreeF (Wait diff) a (ScheduleT diff m a)
 -> m (FreeF (Wait diff) a (ScheduleT diff m a)))
-> (Wait diff (ScheduleT diff m a)
    -> FreeF (Wait diff) a (ScheduleT diff m a))
-> Wait diff (ScheduleT diff m a)
-> m (FreeF (Wait diff) a (ScheduleT diff m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wait diff (ScheduleT diff m a)
-> FreeF (Wait diff) a (ScheduleT diff m a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free) (Wait diff (ScheduleT diff m a) -> ScheduleT diff m a)
-> [Wait diff (ScheduleT diff m a)] -> [ScheduleT diff m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Wait diff (ScheduleT diff m a)]
waits))