module Ki.ThreadFailed
  ( ThreadFailed (..),
    ThreadFailedAsync (..),
  )
where

import Control.Exception (Exception (..), asyncExceptionFromException, asyncExceptionToException)
import Ki.Prelude

-- | A __thread__ failed, either by throwing or being thrown an exception.
data ThreadFailed = ThreadFailed
  { ThreadFailed -> ThreadId
threadId :: ThreadId,
    ThreadFailed -> SomeException
exception :: SomeException
  }
  deriving stock (Int -> ThreadFailed -> ShowS
[ThreadFailed] -> ShowS
ThreadFailed -> String
(Int -> ThreadFailed -> ShowS)
-> (ThreadFailed -> String)
-> ([ThreadFailed] -> ShowS)
-> Show ThreadFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadFailed] -> ShowS
$cshowList :: [ThreadFailed] -> ShowS
show :: ThreadFailed -> String
$cshow :: ThreadFailed -> String
showsPrec :: Int -> ThreadFailed -> ShowS
$cshowsPrec :: Int -> ThreadFailed -> ShowS
Show)
  deriving anyclass (Show ThreadFailed
Typeable ThreadFailed
Typeable ThreadFailed
-> Show ThreadFailed
-> (ThreadFailed -> SomeException)
-> (SomeException -> Maybe ThreadFailed)
-> (ThreadFailed -> String)
-> Exception ThreadFailed
SomeException -> Maybe ThreadFailed
ThreadFailed -> String
ThreadFailed -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ThreadFailed -> String
$cdisplayException :: ThreadFailed -> String
fromException :: SomeException -> Maybe ThreadFailed
$cfromException :: SomeException -> Maybe ThreadFailed
toException :: ThreadFailed -> SomeException
$ctoException :: ThreadFailed -> SomeException
$cp2Exception :: Show ThreadFailed
$cp1Exception :: Typeable ThreadFailed
Exception)

-- | An async wrapper around 'ThreadFailed', used when a child __thread__ communicates its failure to its parent. This
-- is preferred to throwing 'ThreadFailed' directly, so that client code (outside of this library) can follow
-- best-practices when encountering a mysterious async exception: clean up resources and re-throw it.
newtype ThreadFailedAsync
  = ThreadFailedAsync ThreadFailed
  deriving stock (Int -> ThreadFailedAsync -> ShowS
[ThreadFailedAsync] -> ShowS
ThreadFailedAsync -> String
(Int -> ThreadFailedAsync -> ShowS)
-> (ThreadFailedAsync -> String)
-> ([ThreadFailedAsync] -> ShowS)
-> Show ThreadFailedAsync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ThreadFailedAsync] -> ShowS
$cshowList :: [ThreadFailedAsync] -> ShowS
show :: ThreadFailedAsync -> String
$cshow :: ThreadFailedAsync -> String
showsPrec :: Int -> ThreadFailedAsync -> ShowS
$cshowsPrec :: Int -> ThreadFailedAsync -> ShowS
Show)

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