module Ki.Internal.Propagating
  ( Tid,
    peelOffPropagating,
    propagate,
  )
where

import Control.Concurrent (ThreadId)
import Control.Exception (Exception (..), SomeException, asyncExceptionFromException, asyncExceptionToException, throwTo)

-- Internal exception type thrown by a child thread to its parent, if the child fails unexpectedly.
data Propagating = Propagating
  { Propagating -> Tid
childId :: {-# UNPACK #-} !Tid,
    Propagating -> SomeException
exception :: !SomeException
  }

instance Exception Propagating where
  toException :: Propagating -> SomeException
toException = Propagating -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException
  fromException :: SomeException -> Maybe Propagating
fromException = SomeException -> Maybe Propagating
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException

instance Show Propagating where
  show :: Propagating -> String
show Propagating
_ = String
"<<internal ki exception: propagating>>"

pattern PropagatingThe :: SomeException -> SomeException
pattern $mPropagatingThe :: forall {r}.
SomeException -> (SomeException -> r) -> ((# #) -> r) -> r
PropagatingThe exception <- (fromException -> Just Propagating {exception})

-- A unique identifier for a thread within a scope. (Internal type alias)
type Tid =
  Int

-- Peel an outer Propagating layer off of some exception, if there is one.
peelOffPropagating :: SomeException -> SomeException
peelOffPropagating :: SomeException -> SomeException
peelOffPropagating = \case
  PropagatingThe SomeException
exception -> SomeException
exception
  SomeException
exception -> SomeException
exception

-- @propagate exception child parent@ propagates @exception@ from @child@ to @parent@.
propagate :: SomeException -> Tid -> ThreadId -> IO ()
propagate :: SomeException -> Tid -> ThreadId -> IO ()
propagate SomeException
exception Tid
childId ThreadId
parentThreadId =
  ThreadId -> Propagating -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
throwTo ThreadId
parentThreadId Propagating {Tid
$sel:childId:Propagating :: Tid
childId :: Tid
childId, SomeException
$sel:exception:Propagating :: SomeException
exception :: SomeException
exception}