module Ki.Context
  ( Context (..),
    dummyContext,
    globalContext,
  )
where

import Ki.CancelToken (CancelToken)
import Ki.Ctx (Ctx)
import qualified Ki.Ctx as Ctx
import Ki.Prelude

data Context = Context
  { Context -> IO ()
cancelContext :: IO (),
    Context -> STM CancelToken
contextCancelTokenSTM :: STM CancelToken,
    -- | Derive a child context from a parent context.
    --
    --   * If the parent is already cancelled, so is the child.
    --   * If the parent isn't already canceled, the child registers itself with the
    --     parent such that:
    --       * When the parent is cancelled, so is the child
    --       * When the child is cancelled, it removes the parent's reference to it
    Context -> STM Context
deriveContext :: STM Context
  }

newContext :: Ctx -> Context
newContext :: Ctx -> Context
newContext Ctx
ctx =
  Context :: IO () -> STM CancelToken -> STM Context -> Context
Context
    { $sel:cancelContext:Context :: IO ()
cancelContext = Ctx -> IO ()
Ctx.cancelCtx Ctx
ctx,
      $sel:contextCancelTokenSTM:Context :: STM CancelToken
contextCancelTokenSTM = Ctx -> STM CancelToken
Ctx.ctxCancelToken Ctx
ctx,
      $sel:deriveContext:Context :: STM Context
deriveContext = Ctx -> Context
newContext (Ctx -> Context) -> STM Ctx -> STM Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx -> STM Ctx
Ctx.deriveCtx Ctx
ctx
    }

dummyContext :: Context
dummyContext :: Context
dummyContext =
  Context :: IO () -> STM CancelToken -> STM Context -> Context
Context
    { $sel:cancelContext:Context :: IO ()
cancelContext = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:contextCancelTokenSTM:Context :: STM CancelToken
contextCancelTokenSTM = STM CancelToken
forall a. STM a
retry,
      $sel:deriveContext:Context :: STM Context
deriveContext = Context -> STM Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
dummyContext
    }

-- | The global context. It cannot be cancelled.
globalContext :: Context
globalContext :: Context
globalContext =
  Context :: IO () -> STM CancelToken -> STM Context -> Context
Context
    { $sel:cancelContext:Context :: IO ()
cancelContext = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (),
      $sel:contextCancelTokenSTM:Context :: STM CancelToken
contextCancelTokenSTM = STM CancelToken
forall a. STM a
retry,
      $sel:deriveContext:Context :: STM Context
deriveContext = Ctx -> Context
newContext (Ctx -> Context) -> STM Ctx -> STM Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM Ctx
Ctx.newCtxSTM
    }