{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
module Control.Scheduler
(
Scheduler
, SchedulerWS
, Results(..)
, withScheduler
, withScheduler_
, withSchedulerR
, withSchedulerWS
, withSchedulerWS_
, withSchedulerWSR
, unwrapSchedulerWS
, trivialScheduler_
, withTrivialScheduler
, withTrivialSchedulerR
, scheduleWork
, scheduleWork_
, scheduleWorkId
, scheduleWorkId_
, scheduleWorkState
, scheduleWorkState_
, replicateWork
, Batch
, runBatch
, runBatch_
, runBatchR
, cancelBatch
, cancelBatch_
, cancelBatchWith
, hasBatchFinished
, getCurrentBatch
, terminate
, terminate_
, terminateWith
, WorkerId(..)
, WorkerStates
, numWorkers
, workerStatesComp
, initWorkerStates
, Comp(..)
, getCompWorkers
, replicateConcurrently
, replicateConcurrently_
, traverseConcurrently
, traverseConcurrently_
, traverse_
, MutexException(..)
) where
import Control.Monad
import Control.Monad.IO.Unlift
import Control.Monad.Primitive (PrimMonad)
import Control.Scheduler.Computation
import Control.Scheduler.Internal
import Control.Scheduler.Types
import Control.Scheduler.Queue
import qualified Data.Foldable as F (traverse_, toList)
import Data.Primitive.SmallArray
import Data.Traversable
unwrapSchedulerWS :: SchedulerWS s m a -> Scheduler m a
unwrapSchedulerWS :: SchedulerWS s m a -> Scheduler m a
unwrapSchedulerWS = SchedulerWS s m a -> Scheduler m a
forall s (m :: * -> *) a. SchedulerWS s m a -> Scheduler m a
_getScheduler
workerStatesComp :: WorkerStates s -> Comp
workerStatesComp :: WorkerStates s -> Comp
workerStatesComp = WorkerStates s -> Comp
forall s. WorkerStates s -> Comp
_workerStatesComp
withSchedulerWS :: MonadUnliftIO m => WorkerStates s -> (SchedulerWS s m a -> m b) -> m [a]
withSchedulerWS :: WorkerStates s -> (SchedulerWS s m a -> m b) -> m [a]
withSchedulerWS = (Comp -> (Scheduler m a -> m b) -> m [a])
-> WorkerStates s -> (SchedulerWS s m a -> m b) -> m [a]
forall (m :: * -> *) a t b s.
MonadUnliftIO m =>
(Comp -> (Scheduler m a -> t) -> m b)
-> WorkerStates s -> (SchedulerWS s m a -> t) -> m b
withSchedulerWSInternal Comp -> (Scheduler m a -> m b) -> m [a]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m [a]
withScheduler
withSchedulerWS_ :: MonadUnliftIO m => WorkerStates s -> (SchedulerWS s m () -> m b) -> m ()
withSchedulerWS_ :: WorkerStates s -> (SchedulerWS s m () -> m b) -> m ()
withSchedulerWS_ = (Comp -> (Scheduler m () -> m b) -> m ())
-> WorkerStates s -> (SchedulerWS s m () -> m b) -> m ()
forall (m :: * -> *) a t b s.
MonadUnliftIO m =>
(Comp -> (Scheduler m a -> t) -> m b)
-> WorkerStates s -> (SchedulerWS s m a -> t) -> m b
withSchedulerWSInternal Comp -> (Scheduler m () -> m b) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m ()
withScheduler_
withSchedulerWSR :: MonadUnliftIO m => WorkerStates s -> (SchedulerWS s m a -> m b) -> m (Results a)
withSchedulerWSR :: WorkerStates s -> (SchedulerWS s m a -> m b) -> m (Results a)
withSchedulerWSR = (Comp -> (Scheduler m a -> m b) -> m (Results a))
-> WorkerStates s -> (SchedulerWS s m a -> m b) -> m (Results a)
forall (m :: * -> *) a t b s.
MonadUnliftIO m =>
(Comp -> (Scheduler m a -> t) -> m b)
-> WorkerStates s -> (SchedulerWS s m a -> t) -> m b
withSchedulerWSInternal Comp -> (Scheduler m a -> m b) -> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m (Results a)
withSchedulerR
scheduleWorkState :: SchedulerWS s m a -> (s -> m a) -> m ()
scheduleWorkState :: SchedulerWS s m a -> (s -> m a) -> m ()
scheduleWorkState SchedulerWS s m a
schedulerS s -> m a
withState =
Scheduler m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a. Scheduler m a -> (WorkerId -> m a) -> m ()
scheduleWorkId (SchedulerWS s m a -> Scheduler m a
forall s (m :: * -> *) a. SchedulerWS s m a -> Scheduler m a
_getScheduler SchedulerWS s m a
schedulerS) ((WorkerId -> m a) -> m ()) -> (WorkerId -> m a) -> m ()
forall a b. (a -> b) -> a -> b
$ \(WorkerId Int
i) ->
s -> m a
withState (SmallArray s -> Int -> s
forall a. SmallArray a -> Int -> a
indexSmallArray (WorkerStates s -> SmallArray s
forall s. WorkerStates s -> SmallArray s
_workerStatesArray (SchedulerWS s m a -> WorkerStates s
forall s (m :: * -> *) a. SchedulerWS s m a -> WorkerStates s
_workerStates SchedulerWS s m a
schedulerS)) Int
i)
scheduleWorkState_ :: SchedulerWS s m () -> (s -> m ()) -> m ()
scheduleWorkState_ :: SchedulerWS s m () -> (s -> m ()) -> m ()
scheduleWorkState_ SchedulerWS s m ()
schedulerS s -> m ()
withState =
Scheduler m () -> (WorkerId -> m ()) -> m ()
forall (m :: * -> *). Scheduler m () -> (WorkerId -> m ()) -> m ()
scheduleWorkId_ (SchedulerWS s m () -> Scheduler m ()
forall s (m :: * -> *) a. SchedulerWS s m a -> Scheduler m a
_getScheduler SchedulerWS s m ()
schedulerS) ((WorkerId -> m ()) -> m ()) -> (WorkerId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(WorkerId Int
i) ->
s -> m ()
withState (SmallArray s -> Int -> s
forall a. SmallArray a -> Int -> a
indexSmallArray (WorkerStates s -> SmallArray s
forall s. WorkerStates s -> SmallArray s
_workerStatesArray (SchedulerWS s m () -> WorkerStates s
forall s (m :: * -> *) a. SchedulerWS s m a -> WorkerStates s
_workerStates SchedulerWS s m ()
schedulerS)) Int
i)
numWorkers :: Scheduler m a -> Int
numWorkers :: Scheduler m a -> Int
numWorkers = Scheduler m a -> Int
forall (m :: * -> *) a. Scheduler m a -> Int
_numWorkers
scheduleWorkId :: Scheduler m a -> (WorkerId -> m a) -> m ()
scheduleWorkId :: Scheduler m a -> (WorkerId -> m a) -> m ()
scheduleWorkId =Scheduler m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a. Scheduler m a -> (WorkerId -> m a) -> m ()
_scheduleWorkId
terminate :: Scheduler m a -> a -> m a
terminate :: Scheduler m a -> a -> m a
terminate Scheduler m a
scheduler a
a = Scheduler m a -> Early a -> m a
forall (m :: * -> *) a. Scheduler m a -> Early a -> m a
_terminate Scheduler m a
scheduler (a -> Early a
forall a. a -> Early a
Early a
a)
terminateWith :: Scheduler m a -> a -> m a
terminateWith :: Scheduler m a -> a -> m a
terminateWith Scheduler m a
scheduler a
a = Scheduler m a -> Early a -> m a
forall (m :: * -> *) a. Scheduler m a -> Early a -> m a
_terminate Scheduler m a
scheduler (a -> Early a
forall a. a -> Early a
EarlyWith a
a)
scheduleWork :: Scheduler m a -> m a -> m ()
scheduleWork :: Scheduler m a -> m a -> m ()
scheduleWork Scheduler m a
scheduler m a
f = Scheduler m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a. Scheduler m a -> (WorkerId -> m a) -> m ()
_scheduleWorkId Scheduler m a
scheduler (m a -> WorkerId -> m a
forall a b. a -> b -> a
const m a
f)
scheduleWork_ :: Scheduler m () -> m () -> m ()
scheduleWork_ :: Scheduler m () -> m () -> m ()
scheduleWork_ = Scheduler m () -> m () -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork
scheduleWorkId_ :: Scheduler m () -> (WorkerId -> m ()) -> m ()
scheduleWorkId_ :: Scheduler m () -> (WorkerId -> m ()) -> m ()
scheduleWorkId_ = Scheduler m () -> (WorkerId -> m ()) -> m ()
forall (m :: * -> *) a. Scheduler m a -> (WorkerId -> m a) -> m ()
_scheduleWorkId
replicateWork :: Applicative m => Int -> Scheduler m a -> m a -> m ()
replicateWork :: Int -> Scheduler m a -> m a -> m ()
replicateWork !Int
n Scheduler m a
scheduler m a
f = Int -> m ()
forall t. (Ord t, Num t) => t -> m ()
go Int
n
where
go :: t -> m ()
go !t
k
| t
k t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = Scheduler m a -> m a -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m a
scheduler m a
f m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> t -> m ()
go (t
k t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
terminate_ :: Scheduler m () -> m ()
terminate_ :: Scheduler m () -> m ()
terminate_ = (Scheduler m () -> Early () -> m ()
forall (m :: * -> *) a. Scheduler m a -> Early a -> m a
`_terminate` () -> Early ()
forall a. a -> Early a
Early ())
withTrivialScheduler :: PrimMonad m => (Scheduler m a -> m b) -> m [a]
withTrivialScheduler :: (Scheduler m a -> m b) -> m [a]
withTrivialScheduler Scheduler m a -> m b
action = Results a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Results a -> [a]) -> m (Results a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Scheduler m a -> m b) -> m (Results a)
forall (m :: * -> *) a b.
PrimMonad m =>
(Scheduler m a -> m b) -> m (Results a)
withTrivialSchedulerR Scheduler m a -> m b
action
traverseConcurrently :: (MonadUnliftIO m, Traversable t) => Comp -> (a -> m b) -> t a -> m (t b)
traverseConcurrently :: Comp -> (a -> m b) -> t a -> m (t b)
traverseConcurrently Comp
comp a -> m b
f t a
xs = do
[b]
ys <- Comp -> (Scheduler m b -> m ()) -> m [b]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m [a]
withScheduler Comp
comp ((Scheduler m b -> m ()) -> m [b])
-> (Scheduler m b -> m ()) -> m [b]
forall a b. (a -> b) -> a -> b
$ \Scheduler m b
s -> (a -> m ()) -> t a -> m ()
forall (f :: * -> *) (t :: * -> *) a.
(Applicative f, Foldable t) =>
(a -> f ()) -> t a -> f ()
traverse_ (Scheduler m b -> m b -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m b
s (m b -> m ()) -> (a -> m b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) t a
xs
t b -> m (t b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t b -> m (t b)) -> t b -> m (t b)
forall a b. (a -> b) -> a -> b
$ [b] -> t a -> t b
forall (t :: * -> *) a b. Traversable t => [a] -> t b -> t a
transList [b]
ys t a
xs
transList :: Traversable t => [a] -> t b -> t a
transList :: [a] -> t b -> t a
transList [a]
xs' = ([a], t a) -> t a
forall a b. (a, b) -> b
snd (([a], t a) -> t a) -> (t b -> ([a], t a)) -> t b -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> b -> ([a], a)) -> [a] -> t b -> ([a], t a)
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [a] -> b -> ([a], a)
forall b p. [b] -> p -> ([b], b)
withR [a]
xs'
where
withR :: [b] -> p -> ([b], b)
withR (b
x:[b]
xs) p
_ = ([b]
xs, b
x)
withR [b]
_ p
_ = [Char] -> ([b], b)
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"Impossible<traverseConcurrently> - Mismatched sizes"
traverseConcurrently_ :: (MonadUnliftIO m, Foldable t) => Comp -> (a -> m b) -> t a -> m ()
traverseConcurrently_ :: Comp -> (a -> m b) -> t a -> m ()
traverseConcurrently_ Comp
comp a -> m b
f t a
xs =
Comp -> (Scheduler m () -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m ()
withScheduler_ Comp
comp ((Scheduler m () -> m ()) -> m ())
-> (Scheduler m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Scheduler m ()
s -> Scheduler m () -> m () -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m ()
s (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> m ()) -> t a -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
F.traverse_ (Scheduler m () -> m () -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m ()
s (m () -> m ()) -> (a -> m ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> (a -> m b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) t a
xs
replicateConcurrently :: MonadUnliftIO m => Comp -> Int -> m a -> m [a]
replicateConcurrently :: Comp -> Int -> m a -> m [a]
replicateConcurrently Comp
comp Int
n m a
f =
Comp -> (Scheduler m a -> m ()) -> m [a]
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m [a]
withScheduler Comp
comp ((Scheduler m a -> m ()) -> m [a])
-> (Scheduler m a -> m ()) -> m [a]
forall a b. (a -> b) -> a -> b
$ \Scheduler m a
s -> Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Scheduler m a -> m a -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m a
s m a
f
replicateConcurrently_ :: MonadUnliftIO m => Comp -> Int -> m a -> m ()
replicateConcurrently_ :: Comp -> Int -> m a -> m ()
replicateConcurrently_ Comp
comp Int
n m a
f =
Comp -> (Scheduler m () -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp -> (Scheduler m a -> m b) -> m ()
withScheduler_ Comp
comp ((Scheduler m () -> m ()) -> m ())
-> (Scheduler m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Scheduler m ()
s -> Scheduler m () -> m () -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m ()
s (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (Scheduler m () -> m () -> m ()
forall (m :: * -> *) a. Scheduler m a -> m a -> m ()
scheduleWork Scheduler m ()
s (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m a -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
f)
withScheduler ::
MonadUnliftIO m
=> Comp
-> (Scheduler m a -> m b)
-> m [a]
withScheduler :: Comp -> (Scheduler m a -> m b) -> m [a]
withScheduler Comp
Seq = (Results a -> [a]) -> m (Results a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Results a -> [a]) -> Results a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results a -> [a]
forall a. Results a -> [a]
resultsToList) (m (Results a) -> m [a])
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scheduler m a -> m b) -> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
(Scheduler m a -> m b) -> m (Results a)
withTrivialSchedulerRIO
withScheduler Comp
comp =
(Results a -> [a]) -> m (Results a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Results a -> [a]) -> Results a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results a -> [a]
forall a. Results a -> [a]
resultsToList) (m (Results a) -> m [a])
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
withSchedulerInternal Comp
comp Jobs m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Jobs m a -> (WorkerId -> m a) -> m ()
scheduleJobs JQueue m a -> m [a]
forall (m :: * -> *) a. MonadIO m => JQueue m a -> m [a]
readResults
{-# INLINE withScheduler #-}
withSchedulerR ::
MonadUnliftIO m
=> Comp
-> (Scheduler m a -> m b)
-> m (Results a)
withSchedulerR :: Comp -> (Scheduler m a -> m b) -> m (Results a)
withSchedulerR Comp
Seq = (Results a -> Results a) -> m (Results a) -> m (Results a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Results a -> Results a
forall a. Results a -> Results a
reverseResults (m (Results a) -> m (Results a))
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m (Results a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scheduler m a -> m b) -> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
(Scheduler m a -> m b) -> m (Results a)
withTrivialSchedulerRIO
withSchedulerR Comp
comp = (Results a -> Results a) -> m (Results a) -> m (Results a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Results a -> Results a
forall a. Results a -> Results a
reverseResults (m (Results a) -> m (Results a))
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m (Results a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
withSchedulerInternal Comp
comp Jobs m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a.
MonadIO m =>
Jobs m a -> (WorkerId -> m a) -> m ()
scheduleJobs JQueue m a -> m [a]
forall (m :: * -> *) a. MonadIO m => JQueue m a -> m [a]
readResults
{-# INLINE withSchedulerR #-}
withScheduler_ ::
MonadUnliftIO m
=> Comp
-> (Scheduler m a -> m b)
-> m ()
withScheduler_ :: Comp -> (Scheduler m a -> m b) -> m ()
withScheduler_ Comp
Seq = m (Results a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Results a) -> m ())
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scheduler m a -> m b) -> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
(Scheduler m a -> m b) -> m (Results a)
withTrivialSchedulerRIO
withScheduler_ Comp
comp = m (Results a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Results a) -> m ())
-> ((Scheduler m a -> m b) -> m (Results a))
-> (Scheduler m a -> m b)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
Comp
-> (Jobs m a -> (WorkerId -> m a) -> m ())
-> (JQueue m a -> m [a])
-> (Scheduler m a -> m b)
-> m (Results a)
withSchedulerInternal Comp
comp Jobs m a -> (WorkerId -> m a) -> m ()
forall (m :: * -> *) a b.
MonadIO m =>
Jobs m a -> (WorkerId -> m b) -> m ()
scheduleJobs_ (m [a] -> JQueue m a -> m [a]
forall a b. a -> b -> a
const ([a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []))
{-# INLINE withScheduler_ #-}
hasBatchFinished :: Functor m => Batch m a -> m Bool
hasBatchFinished :: Batch m a -> m Bool
hasBatchFinished = Batch m a -> m Bool
forall (m :: * -> *) a. Batch m a -> m Bool
batchHasFinished
{-# INLINE hasBatchFinished #-}
cancelBatch :: Batch m a -> a -> m Bool
cancelBatch :: Batch m a -> a -> m Bool
cancelBatch = Batch m a -> a -> m Bool
forall (m :: * -> *) a. Batch m a -> a -> m Bool
batchCancel
{-# INLINE cancelBatch #-}
cancelBatch_ :: Batch m () -> m Bool
cancelBatch_ :: Batch m () -> m Bool
cancelBatch_ Batch m ()
b = Batch m () -> () -> m Bool
forall (m :: * -> *) a. Batch m a -> a -> m Bool
batchCancel Batch m ()
b ()
{-# INLINE cancelBatch_ #-}
cancelBatchWith :: Batch m a -> a -> m Bool
cancelBatchWith :: Batch m a -> a -> m Bool
cancelBatchWith = Batch m a -> a -> m Bool
forall (m :: * -> *) a. Batch m a -> a -> m Bool
batchCancelWith
{-# INLINE cancelBatchWith #-}
getCurrentBatch ::
Monad m => Scheduler m a -> m (Batch m a)
getCurrentBatch :: Scheduler m a -> m (Batch m a)
getCurrentBatch Scheduler m a
scheduler = do
BatchId
batchId <- Scheduler m a -> m BatchId
forall (m :: * -> *) a. Scheduler m a -> m BatchId
_currentBatchId Scheduler m a
scheduler
Batch m a -> m (Batch m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Batch m a -> m (Batch m a)) -> Batch m a -> m (Batch m a)
forall a b. (a -> b) -> a -> b
$ Batch :: forall (m :: * -> *) a.
(a -> m Bool) -> (a -> m Bool) -> m Bool -> Batch m a
Batch
{ batchCancel :: a -> m Bool
batchCancel = Scheduler m a -> BatchId -> Early a -> m Bool
forall (m :: * -> *) a.
Scheduler m a -> BatchId -> Early a -> m Bool
_cancelBatch Scheduler m a
scheduler BatchId
batchId (Early a -> m Bool) -> (a -> Early a) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Early a
forall a. a -> Early a
Early
, batchCancelWith :: a -> m Bool
batchCancelWith = Scheduler m a -> BatchId -> Early a -> m Bool
forall (m :: * -> *) a.
Scheduler m a -> BatchId -> Early a -> m Bool
_cancelBatch Scheduler m a
scheduler BatchId
batchId (Early a -> m Bool) -> (a -> Early a) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Early a
forall a. a -> Early a
EarlyWith
, batchHasFinished :: m Bool
batchHasFinished = (BatchId
batchId BatchId -> BatchId -> Bool
forall a. Eq a => a -> a -> Bool
/=) (BatchId -> Bool) -> m BatchId -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scheduler m a -> m BatchId
forall (m :: * -> *) a. Scheduler m a -> m BatchId
_currentBatchId Scheduler m a
scheduler
}
{-# INLINE getCurrentBatch #-}
runBatch ::
Monad m => Scheduler m a -> (Batch m a -> m c) -> m [a]
runBatch :: Scheduler m a -> (Batch m a -> m c) -> m [a]
runBatch Scheduler m a
scheduler Batch m a -> m c
f = do
c
_ <- Batch m a -> m c
f (Batch m a -> m c) -> m (Batch m a) -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scheduler m a -> m (Batch m a)
forall (m :: * -> *) a. Monad m => Scheduler m a -> m (Batch m a)
getCurrentBatch Scheduler m a
scheduler
[a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> (Results a -> [a]) -> Results a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Results a -> [a]
forall a. Results a -> [a]
resultsToList (Results a -> [a]) -> m (Results a) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scheduler m a -> m (Results a)
forall (m :: * -> *) a. Scheduler m a -> m (Results a)
_waitForCurrentBatch Scheduler m a
scheduler
{-# INLINE runBatch #-}
runBatch_ ::
Monad m => Scheduler m () -> (Batch m () -> m c) -> m ()
runBatch_ :: Scheduler m () -> (Batch m () -> m c) -> m ()
runBatch_ Scheduler m ()
scheduler Batch m () -> m c
f = do
c
_ <- Batch m () -> m c
f (Batch m () -> m c) -> m (Batch m ()) -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scheduler m () -> m (Batch m ())
forall (m :: * -> *) a. Monad m => Scheduler m a -> m (Batch m a)
getCurrentBatch Scheduler m ()
scheduler
m (Results ()) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Scheduler m () -> m (Results ())
forall (m :: * -> *) a. Scheduler m a -> m (Results a)
_waitForCurrentBatch Scheduler m ()
scheduler)
{-# INLINE runBatch_ #-}
runBatchR ::
Monad m => Scheduler m a -> (Batch m a -> m c) -> m (Results a)
runBatchR :: Scheduler m a -> (Batch m a -> m c) -> m (Results a)
runBatchR Scheduler m a
scheduler Batch m a -> m c
f = do
c
_ <- Batch m a -> m c
f (Batch m a -> m c) -> m (Batch m a) -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scheduler m a -> m (Batch m a)
forall (m :: * -> *) a. Monad m => Scheduler m a -> m (Batch m a)
getCurrentBatch Scheduler m a
scheduler
Results a -> Results a
forall a. Results a -> Results a
reverseResults (Results a -> Results a) -> m (Results a) -> m (Results a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scheduler m a -> m (Results a)
forall (m :: * -> *) a. Scheduler m a -> m (Results a)
_waitForCurrentBatch Scheduler m a
scheduler
{-# INLINE runBatchR #-}