{-# LANGUAGE PatternSynonyms #-}

module Ki.Implicit
  ( -- * Context
    Context,
    withGlobalContext,

    -- * Scope
    Scope,
    scoped,
    Scope.wait,
    Scope.waitSTM,
    waitFor,

    -- * Spawning threads
    -- $spawning-threads
    Thread,

    -- ** Fork
    fork,
    fork_,
    forkWithUnmask,
    forkWithUnmask_,

    -- ** Async
    async,
    asyncWithUnmask,

    -- ** Await
    Thread.await,
    Thread.awaitSTM,
    Thread.awaitFor,

    -- * Soft-cancellation
    CancelToken,
    Scope.cancel,
    cancelled,
    cancelledSTM,

    -- * Miscellaneous
    Duration,
    Duration.microseconds,
    Duration.milliseconds,
    Duration.seconds,
    timeoutSTM,
    sleep,
  )
where

import Ki.CancelToken (CancelToken)
import qualified Ki.Context as Context
import Ki.Duration (Duration)
import qualified Ki.Duration as Duration
import Ki.Prelude
import Ki.Scope (Scope)
import qualified Ki.Scope as Scope
import Ki.Thread (Thread)
import qualified Ki.Thread as Thread
import Ki.Timeout (timeoutSTM)

-- $spawning-threads
--
-- There are two variants of __thread__-creating functions with different exception-propagation semantics.
--
-- * If a __thread__ created with 'fork' throws an exception, it is immediately propagated up the call tree to the
-- __thread__ that created its __scope__.
--
-- * If a __thread__ created with 'async' throws an exception, it is not propagated up the call tree, but can be
-- observed by 'Ki.Implicit.await'.

-- | A __context__ models a program's call tree, and is used as a mechanism to propagate /cancellation/ requests to
-- every __thread__ created within a __scope__.
--
-- Every __thread__ is provided its own __context__, which is derived from its __scope__.
--
-- A __thread__ can query whether its __context__ has been /cancelled/, which is a suggestion to perform a graceful
-- termination.
type Context =
  ?context :: Context.Context

-- | Create a __thread__ within a __scope__.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
async :: Scope -> (Context => IO a) -> IO (Thread (Either SomeException a))
async :: Scope -> (Context => IO a) -> IO (Thread (Either SomeException a))
async Scope
scope Context => IO a
action =
  Scope -> IO a -> IO (Thread (Either SomeException a))
forall a. Scope -> IO a -> IO (Thread (Either SomeException a))
Thread.async Scope
scope (Scope -> (Context => IO a) -> IO a
forall a. Scope -> (Context => a) -> a
with Scope
scope Context => IO a
action)

-- | Variant of 'async' that provides the __thread__ a function that unmasks asynchronous exceptions.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
asyncWithUnmask :: Scope -> (Context => (forall x. IO x -> IO x) -> IO a) -> IO (Thread (Either SomeException a))
asyncWithUnmask :: Scope
-> (Context => (forall x. IO x -> IO x) -> IO a)
-> IO (Thread (Either SomeException a))
asyncWithUnmask Scope
scope Context => (forall x. IO x -> IO x) -> IO a
action =
  Scope
-> ((forall x. IO x -> IO x) -> IO a)
-> IO (Thread (Either SomeException a))
forall a.
Scope
-> ((forall x. IO x -> IO x) -> IO a)
-> IO (Thread (Either SomeException a))
Thread.asyncWithUnmask Scope
scope (let ?context = Scope.context scope in Context => (forall x. IO x -> IO x) -> IO a
(forall x. IO x -> IO x) -> IO a
action)

-- | Return whether the current __context__ is /cancelled/.
--
-- __Threads__ running in a /cancelled/ __context__ should terminate as soon as possible. The cancel token may be thrown
-- to fulfill the /cancellation/ request in case the __thread__ is unable or unwilling to terminate normally with a
-- value.
cancelled :: Context => IO (Maybe CancelToken)
cancelled :: IO (Maybe CancelToken)
cancelled =
  STM (Maybe CancelToken) -> IO (Maybe CancelToken)
forall a. STM a -> IO a
atomically (STM CancelToken -> STM (Maybe CancelToken)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional STM CancelToken
Context => STM CancelToken
cancelledSTM)

-- | @STM@ variant of 'cancelled'; blocks until the current __context__ is /cancelled/.
cancelledSTM :: Context => STM CancelToken
cancelledSTM :: STM CancelToken
cancelledSTM =
  Context -> STM CancelToken
Context.contextCancelTokenSTM Context
Context
?context

-- | Create a __thread__ within a __scope__.
--
-- If the __thread__ throws an exception, the exception is immediately propagated up the call tree to the __thread__
-- that opened its __scope__, unless that exception is a 'CancelToken' that fulfills a /cancellation/ request.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
fork :: Scope -> (Context => IO a) -> IO (Thread a)
fork :: Scope -> (Context => IO a) -> IO (Thread a)
fork Scope
scope Context => IO a
action =
  Scope -> IO a -> IO (Thread a)
forall a. Scope -> IO a -> IO (Thread a)
Thread.fork Scope
scope (Scope -> (Context => IO a) -> IO a
forall a. Scope -> (Context => a) -> a
with Scope
scope Context => IO a
action)

-- | Variant of 'fork' that does not return a handle to the created __thread__.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
fork_ :: Scope -> (Context => IO ()) -> IO ()
fork_ :: Scope -> (Context => IO ()) -> IO ()
fork_ Scope
scope Context => IO ()
action =
  Scope -> IO () -> IO ()
Thread.fork_ Scope
scope (Scope -> (Context => IO ()) -> IO ()
forall a. Scope -> (Context => a) -> a
with Scope
scope Context => IO ()
action)

-- | Variant of 'fork' that provides the __thread__ a function that unmasks asynchronous exceptions.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
forkWithUnmask :: Scope -> (Context => (forall x. IO x -> IO x) -> IO a) -> IO (Thread a)
forkWithUnmask :: Scope
-> (Context => (forall x. IO x -> IO x) -> IO a) -> IO (Thread a)
forkWithUnmask Scope
scope Context => (forall x. IO x -> IO x) -> IO a
action =
  Scope -> ((forall x. IO x -> IO x) -> IO a) -> IO (Thread a)
forall a.
Scope -> ((forall x. IO x -> IO x) -> IO a) -> IO (Thread a)
Thread.forkWithUnmask Scope
scope (let ?context = Scope.context scope in Context => (forall x. IO x -> IO x) -> IO a
(forall x. IO x -> IO x) -> IO a
action)

-- | Variant of 'forkWithUnmask' that does not return a handle to the created __thread__.
--
-- /Throws/:
--
--   * Calls 'error' if the __scope__ is /closed/.
forkWithUnmask_ :: Scope -> (Context => (forall x. IO x -> IO x) -> IO ()) -> IO ()
forkWithUnmask_ :: Scope -> (Context => (forall x. IO x -> IO x) -> IO ()) -> IO ()
forkWithUnmask_ Scope
scope Context => (forall x. IO x -> IO x) -> IO ()
action =
  Scope -> ((forall x. IO x -> IO x) -> IO ()) -> IO ()
Thread.forkWithUnmask_ Scope
scope (let ?context = Scope.context scope in Context => (forall x. IO x -> IO x) -> IO ()
(forall x. IO x -> IO x) -> IO ()
action)

-- | Perform an @IO@ action in the global __context__. The global __context__ cannot be /cancelled/.
withGlobalContext :: (Context => IO a) -> IO a
withGlobalContext :: (Context => IO a) -> IO a
withGlobalContext Context => IO a
action =
  let ?context = Context.globalContext in IO a
Context => IO a
action

-- | Open a __scope__, perform an @IO@ action with it, then close the __scope__.
--
-- When the __scope__ is closed, all remaining __threads__ created within it are killed.
--
-- /Throws/:
--
--   * The exception thrown by the callback to 'scoped' itself, if any.
--   * The first exception thrown by or to a __thread__ created with 'fork', if any.
--
-- ==== __Examples__
--
-- @
-- 'scoped' \\scope -> do
--   'fork_' scope worker1
--   'fork_' scope worker2
--   'Ki.Implicit.wait' scope
-- @
scoped :: Context => (Context => Scope -> IO a) -> IO a
scoped :: (Context => Scope -> IO a) -> IO a
scoped Context => Scope -> IO a
action =
  Context -> (Scope -> IO a) -> IO a
forall a. Context -> (Scope -> IO a) -> IO a
Scope.scoped Context
Context
?context \Scope
scope -> Scope -> (Context => IO a) -> IO a
forall a. Scope -> (Context => a) -> a
with Scope
scope (Context => Scope -> IO a
Scope -> IO a
action Scope
scope)

-- | __Context__-aware, duration-based @threadDelay@.
--
-- /Throws/:
--
--   * Throws 'CancelToken' if the current __context__ is (or becomes) /cancelled/.
sleep :: Context => Duration -> IO ()
sleep :: Duration -> IO ()
sleep Duration
duration =
  Duration -> STM (IO ()) -> IO () -> IO ()
forall a. Duration -> STM (IO a) -> IO a -> IO a
timeoutSTM Duration
duration (STM CancelToken
Context => STM CancelToken
cancelledSTM STM CancelToken -> (CancelToken -> STM (IO ())) -> STM (IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CancelToken -> STM (IO ())
forall e a. Exception e => e -> STM a
throwSTM) (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Variant of 'Ki.Implicit.wait' that waits for up to the given duration. This is useful for giving __threads__ some
-- time to fulfill a /cancellation/ request before killing them.
waitFor :: Scope -> Duration -> IO ()
waitFor :: Scope -> Duration -> IO ()
waitFor =
  Scope -> Duration -> IO ()
Scope.waitFor

--

with :: Scope -> (Context => a) -> a
with :: Scope -> (Context => a) -> a
with Scope
scope Context => a
action =
  let ?context = Scope.context scope in a
Context => a
action