{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK hide, not-home #-}
-- |
-- Module      : Control.Scheduler.Types
-- Copyright   : (c) Alexey Kuleshevich 2018-2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Control.Scheduler.Types
  ( Scheduler(..)
  , WorkerStates(..)
  , SchedulerWS(..)
  , GlobalScheduler(..)
  , Batch(..)
  , BatchId(..)
  , Jobs(..)
  , Early(..)
  , unEarly
  , Results(..)
  , SchedulerStatus(..)
  , WorkerException(..)
  , CancelBatchException(..)
  , TerminateEarlyException(..)
  , WorkerTerminateException(..)
  , MutexException(..)
  ) where

import Control.Concurrent (ThreadId)
import Control.Concurrent.MVar
import Control.Exception
import Control.Scheduler.Computation
import Control.Scheduler.Queue
import Data.IORef
import Data.Primitive.SmallArray
import Data.Primitive.PVar

-- | Computed results of scheduled jobs.
--
-- @since 1.4.2
data Results a
  = Finished [a]
  -- ^ Finished normally with all scheduled jobs completed
  | FinishedEarly [a] !a
  -- ^ Finished early by the means of `Control.Scheduler.cancelBatch` or
  -- `Control.Scheduler.terminate`.
  | FinishedEarlyWith !a
  -- ^ Finished early by the means of `Control.Scheduler.cancelBatchWith` or
  -- `Control.Scheduler.terminateWith`.
  deriving (Int -> Results a -> ShowS
[Results a] -> ShowS
Results a -> String
(Int -> Results a -> ShowS)
-> (Results a -> String)
-> ([Results a] -> ShowS)
-> Show (Results a)
forall a. Show a => Int -> Results a -> ShowS
forall a. Show a => [Results a] -> ShowS
forall a. Show a => Results a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Results a] -> ShowS
$cshowList :: forall a. Show a => [Results a] -> ShowS
show :: Results a -> String
$cshow :: forall a. Show a => Results a -> String
showsPrec :: Int -> Results a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Results a -> ShowS
Show, ReadPrec [Results a]
ReadPrec (Results a)
Int -> ReadS (Results a)
ReadS [Results a]
(Int -> ReadS (Results a))
-> ReadS [Results a]
-> ReadPrec (Results a)
-> ReadPrec [Results a]
-> Read (Results a)
forall a. Read a => ReadPrec [Results a]
forall a. Read a => ReadPrec (Results a)
forall a. Read a => Int -> ReadS (Results a)
forall a. Read a => ReadS [Results a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Results a]
$creadListPrec :: forall a. Read a => ReadPrec [Results a]
readPrec :: ReadPrec (Results a)
$creadPrec :: forall a. Read a => ReadPrec (Results a)
readList :: ReadS [Results a]
$creadList :: forall a. Read a => ReadS [Results a]
readsPrec :: Int -> ReadS (Results a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Results a)
Read, Results a -> Results a -> Bool
(Results a -> Results a -> Bool)
-> (Results a -> Results a -> Bool) -> Eq (Results a)
forall a. Eq a => Results a -> Results a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Results a -> Results a -> Bool
$c/= :: forall a. Eq a => Results a -> Results a -> Bool
== :: Results a -> Results a -> Bool
$c== :: forall a. Eq a => Results a -> Results a -> Bool
Eq)

instance Functor Results where
  fmap :: (a -> b) -> Results a -> Results b
fmap a -> b
f =
    \case
      Finished [a]
xs -> [b] -> Results b
forall a. [a] -> Results a
Finished ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)
      FinishedEarly [a]
xs a
x -> [b] -> b -> Results b
forall a. [a] -> a -> Results a
FinishedEarly ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs) (a -> b
f a
x)
      FinishedEarlyWith a
x -> b -> Results b
forall a. a -> Results a
FinishedEarlyWith (a -> b
f a
x)

instance Foldable Results where
  foldr :: (a -> b -> b) -> b -> Results a -> b
foldr a -> b -> b
f b
acc =
    \case
      Finished [a]
xs -> (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
acc [a]
xs
      FinishedEarly [a]
xs a
x -> (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f (a -> b -> b
f a
x b
acc) [a]
xs
      FinishedEarlyWith a
x -> a -> b -> b
f a
x b
acc
  foldr1 :: (a -> a -> a) -> Results a -> a
foldr1 a -> a -> a
f =
    \case
      Finished [a]
xs -> (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f [a]
xs
      FinishedEarly [a]
xs a
x -> (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
f a
x [a]
xs
      FinishedEarlyWith a
x -> a
x

instance Traversable Results where
  traverse :: (a -> f b) -> Results a -> f (Results b)
traverse a -> f b
f =
    \case
      Finished [a]
xs -> [b] -> Results b
forall a. [a] -> Results a
Finished ([b] -> Results b) -> f [b] -> f (Results b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
xs
      FinishedEarly [a]
xs a
x -> [b] -> b -> Results b
forall a. [a] -> a -> Results a
FinishedEarly ([b] -> b -> Results b) -> f [b] -> f (b -> Results b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f [a]
xs f (b -> Results b) -> f b -> f (Results b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
x
      FinishedEarlyWith a
x -> b -> Results b
forall a. a -> Results a
FinishedEarlyWith (b -> Results b) -> f b -> f (Results b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x

data Jobs m a = Jobs
  { Jobs m a -> Int
jobsNumWorkers       :: {-# UNPACK #-} !Int
  , Jobs m a -> JQueue m a
jobsQueue            :: !(JQueue m a)
#if MIN_VERSION_pvar(1,0,0)
  , Jobs m a -> PVar Int RealWorld
jobsQueueCount       :: !(PVar Int RealWorld)
#else
  , jobsQueueCount       :: !(PVar IO Int)
#endif
  , Jobs m a -> MVar SchedulerStatus
jobsSchedulerStatus  :: !(MVar SchedulerStatus)
  }


-- | This is a result for premature ending of computation.
data Early a
  = Early a
  -- ^ This value along with all results computed up to the moment when computation was
  -- cancelled or termianted will be returned
  | EarlyWith a
  -- ^ Only this value will be returned all other results will get discarded

unEarly :: Early a -> a
unEarly :: Early a -> a
unEarly (Early a
r) = a
r
unEarly (EarlyWith a
r) = a
r

-- | Main type for scheduling work. See `Control.Scheduler.withScheduler` or
-- `Control.Scheduler.withScheduler_` for ways to construct and use this data type.
--
-- @since 1.0.0
data Scheduler s a = Scheduler
  { Scheduler s a -> Int
_numWorkers          :: {-# UNPACK #-} !Int
  , Scheduler s a -> (WorkerId -> ST s a) -> ST s ()
_scheduleWorkId      :: (WorkerId -> ST s a) -> ST s ()
  , Scheduler s a -> Early a -> ST s a
_terminate           :: Early a -> ST s a
  , Scheduler s a -> ST s (Results a)
_waitForCurrentBatch :: ST s (Results a)
  , Scheduler s a -> ST s (Maybe (Results a))
_earlyResults        :: ST s (Maybe (Results a))
  , Scheduler s a -> ST s BatchId
_currentBatchId      :: ST s BatchId
  -- ^ Returns an opaque identifier for current batch of jobs, which can be used to either
  -- cancel the batch early or simply check if the batch has finished or not.
  , Scheduler s a -> BatchId -> Early a -> ST s Bool
_cancelBatch         :: BatchId -> Early a -> ST s Bool
  -- ^ Stops current batch and cancells all the outstanding jobs and the ones that are
  -- currently in progress.
  , Scheduler s a -> ST s (Maybe (Early a))
_batchEarly          :: ST s (Maybe (Early a))
  }


-- | This is a wrapper around `Scheduler`, but it also keeps a separate state for each
-- individual worker. See `Control.Scheduler.withSchedulerWS` or
-- `Control.Scheduler.withSchedulerWS_` for ways to construct and use this data type.
--
-- @since 1.4.0
data SchedulerWS ws a = SchedulerWS
  { SchedulerWS ws a -> WorkerStates ws
_workerStates :: !(WorkerStates ws)
  , SchedulerWS ws a -> Scheduler RealWorld a
_getScheduler :: !(Scheduler RealWorld a)
  }

-- | Each worker is capable of keeping it's own state, that can be share for different
-- schedulers, but not at the same time. In other words using the same `WorkerStates` on
-- `Control.Scheduler.withSchedulerS` concurrently will result in an error. Can be initialized with
-- `Control.Scheduler.initWorkerStates`
--
-- @since 1.4.0
data WorkerStates ws = WorkerStates
  { WorkerStates ws -> Comp
_workerStatesComp  :: !Comp
  , WorkerStates ws -> SmallArray ws
_workerStatesArray :: !(SmallArray ws)
#if MIN_VERSION_pvar(1,0,0)
  , WorkerStates ws -> PVar Int RealWorld
_workerStatesMutex :: !(PVar Int RealWorld)
#else
  , _workerStatesMutex :: !(PVar IO Int)
#endif
  }

-- | This identifier is needed for tracking batches.
newtype BatchId = BatchId { BatchId -> Int
getBatchId :: Int }
  deriving (Int -> BatchId -> ShowS
[BatchId] -> ShowS
BatchId -> String
(Int -> BatchId -> ShowS)
-> (BatchId -> String) -> ([BatchId] -> ShowS) -> Show BatchId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchId] -> ShowS
$cshowList :: [BatchId] -> ShowS
show :: BatchId -> String
$cshow :: BatchId -> String
showsPrec :: Int -> BatchId -> ShowS
$cshowsPrec :: Int -> BatchId -> ShowS
Show, BatchId -> BatchId -> Bool
(BatchId -> BatchId -> Bool)
-> (BatchId -> BatchId -> Bool) -> Eq BatchId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchId -> BatchId -> Bool
$c/= :: BatchId -> BatchId -> Bool
== :: BatchId -> BatchId -> Bool
$c== :: BatchId -> BatchId -> Bool
Eq, Eq BatchId
Eq BatchId
-> (BatchId -> BatchId -> Ordering)
-> (BatchId -> BatchId -> Bool)
-> (BatchId -> BatchId -> Bool)
-> (BatchId -> BatchId -> Bool)
-> (BatchId -> BatchId -> Bool)
-> (BatchId -> BatchId -> BatchId)
-> (BatchId -> BatchId -> BatchId)
-> Ord BatchId
BatchId -> BatchId -> Bool
BatchId -> BatchId -> Ordering
BatchId -> BatchId -> BatchId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BatchId -> BatchId -> BatchId
$cmin :: BatchId -> BatchId -> BatchId
max :: BatchId -> BatchId -> BatchId
$cmax :: BatchId -> BatchId -> BatchId
>= :: BatchId -> BatchId -> Bool
$c>= :: BatchId -> BatchId -> Bool
> :: BatchId -> BatchId -> Bool
$c> :: BatchId -> BatchId -> Bool
<= :: BatchId -> BatchId -> Bool
$c<= :: BatchId -> BatchId -> Bool
< :: BatchId -> BatchId -> Bool
$c< :: BatchId -> BatchId -> Bool
compare :: BatchId -> BatchId -> Ordering
$ccompare :: BatchId -> BatchId -> Ordering
$cp1Ord :: Eq BatchId
Ord)


-- | Batch is an artifical checkpoint that can be controlled by the user throughout the
-- lifetime of a scheduler.
--
-- @since 1.5.0
data Batch s a = Batch
  { Batch s a -> a -> ST s Bool
batchCancel      :: a -> ST s Bool
  , Batch s a -> a -> ST s Bool
batchCancelWith  :: a -> ST s Bool
  , Batch s a -> ST s Bool
batchHasFinished :: ST s Bool
  }


-- | A thread safe wrapper around `Scheduler`, which allows it to be reused indefinitely
-- and globally if need be. There is one already created in this library:
-- `Control.Scheduler.Global.globalScheduler`
--
-- @since 1.5.0
data GlobalScheduler =
  GlobalScheduler
    { GlobalScheduler -> Comp
globalSchedulerComp :: !Comp
    , GlobalScheduler -> MVar (Scheduler RealWorld ())
globalSchedulerMVar :: !(MVar (Scheduler RealWorld ()))
    , GlobalScheduler -> IORef [ThreadId]
globalSchedulerThreadIdsRef :: !(IORef [ThreadId])
    }


data SchedulerStatus
  = SchedulerIdle
  | SchedulerWorkerException WorkerException

data TerminateEarlyException =
  TerminateEarlyException
  deriving (Int -> TerminateEarlyException -> ShowS
[TerminateEarlyException] -> ShowS
TerminateEarlyException -> String
(Int -> TerminateEarlyException -> ShowS)
-> (TerminateEarlyException -> String)
-> ([TerminateEarlyException] -> ShowS)
-> Show TerminateEarlyException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TerminateEarlyException] -> ShowS
$cshowList :: [TerminateEarlyException] -> ShowS
show :: TerminateEarlyException -> String
$cshow :: TerminateEarlyException -> String
showsPrec :: Int -> TerminateEarlyException -> ShowS
$cshowsPrec :: Int -> TerminateEarlyException -> ShowS
Show)

instance Exception TerminateEarlyException

data CancelBatchException =
  CancelBatchException
  deriving (Int -> CancelBatchException -> ShowS
[CancelBatchException] -> ShowS
CancelBatchException -> String
(Int -> CancelBatchException -> ShowS)
-> (CancelBatchException -> String)
-> ([CancelBatchException] -> ShowS)
-> Show CancelBatchException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelBatchException] -> ShowS
$cshowList :: [CancelBatchException] -> ShowS
show :: CancelBatchException -> String
$cshow :: CancelBatchException -> String
showsPrec :: Int -> CancelBatchException -> ShowS
$cshowsPrec :: Int -> CancelBatchException -> ShowS
Show)

instance Exception CancelBatchException

-- | This exception should normally be never seen in the wild and is for internal use only.
newtype WorkerException =
  WorkerException SomeException
  -- ^ One of workers experienced an exception, main thread will receive the same `SomeException`.
  deriving (Int -> WorkerException -> ShowS
[WorkerException] -> ShowS
WorkerException -> String
(Int -> WorkerException -> ShowS)
-> (WorkerException -> String)
-> ([WorkerException] -> ShowS)
-> Show WorkerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkerException] -> ShowS
$cshowList :: [WorkerException] -> ShowS
show :: WorkerException -> String
$cshow :: WorkerException -> String
showsPrec :: Int -> WorkerException -> ShowS
$cshowsPrec :: Int -> WorkerException -> ShowS
Show)

instance Exception WorkerException

data WorkerTerminateException =
  WorkerTerminateException
  -- ^ When a co-worker dies of some exception, all the other ones will be terminated
  -- asynchronously with this one.
  deriving (Int -> WorkerTerminateException -> ShowS
[WorkerTerminateException] -> ShowS
WorkerTerminateException -> String
(Int -> WorkerTerminateException -> ShowS)
-> (WorkerTerminateException -> String)
-> ([WorkerTerminateException] -> ShowS)
-> Show WorkerTerminateException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkerTerminateException] -> ShowS
$cshowList :: [WorkerTerminateException] -> ShowS
show :: WorkerTerminateException -> String
$cshow :: WorkerTerminateException -> String
showsPrec :: Int -> WorkerTerminateException -> ShowS
$cshowsPrec :: Int -> WorkerTerminateException -> ShowS
Show)


instance Exception WorkerTerminateException

-- | Exception that gets thrown whenever concurrent access is attempted to the `WorkerStates`
--
-- @since 1.4.0
data MutexException =
  MutexException
  deriving (MutexException -> MutexException -> Bool
(MutexException -> MutexException -> Bool)
-> (MutexException -> MutexException -> Bool) -> Eq MutexException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MutexException -> MutexException -> Bool
$c/= :: MutexException -> MutexException -> Bool
== :: MutexException -> MutexException -> Bool
$c== :: MutexException -> MutexException -> Bool
Eq, Int -> MutexException -> ShowS
[MutexException] -> ShowS
MutexException -> String
(Int -> MutexException -> ShowS)
-> (MutexException -> String)
-> ([MutexException] -> ShowS)
-> Show MutexException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MutexException] -> ShowS
$cshowList :: [MutexException] -> ShowS
show :: MutexException -> String
$cshow :: MutexException -> String
showsPrec :: Int -> MutexException -> ShowS
$cshowsPrec :: Int -> MutexException -> ShowS
Show)

instance Exception MutexException where
  displayException :: MutexException -> String
displayException MutexException
MutexException =
    String
"MutexException: WorkerStates cannot be used at the same time by different schedulers"