module Bluefin.Internal.Exception.Scoped
  ( Exception,
    try,
    throw,
  )
where

import Bluefin.Internal.Key (Key, eqKey, newKey)
import Control.Exception (throwIO, tryJust)
import qualified Control.Exception
import Data.Type.Equality ((:~~:) (HRefl))

try :: (Exception e -> IO a) -> IO (Either e a)
try :: forall e a. (Exception e -> IO a) -> IO (Either e a)
try Exception e -> IO a
k = do
  Key e
key <- IO (Key e)
forall {k} (a :: k). IO (Key a)
newKey
  (InFlight -> Maybe e) -> IO a -> IO (Either e a)
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> IO (Either b a)
tryJust
    (Key e -> InFlight -> Maybe e
forall a. Key a -> InFlight -> Maybe a
check Key e
key)
    (Exception e -> IO a
k (Key e -> Exception e
forall {k} (e :: k). Key e -> Exception e
MkException Key e
key))

throw :: Exception e -> e -> IO a
throw :: forall e a. Exception e -> e -> IO a
throw Exception e
ex e
e = InFlight -> IO a
forall e a. Exception e => e -> IO a
throwIO (Exception e -> e -> InFlight
forall e. Exception e -> e -> InFlight
MkInFlight Exception e
ex e
e)

newtype Exception e = MkException (Key e)

data InFlight = forall e. MkInFlight !(Exception e) !e

instance Show InFlight where
  show :: InFlight -> String
show InFlight
_ = String
"In-flight scoped exception"

instance Control.Exception.Exception InFlight

check :: Key a -> InFlight -> Maybe a
check :: forall a. Key a -> InFlight -> Maybe a
check Key a
k1 (MkInFlight (MkException Key e
k2) e
e) = ((a :~~: e) -> a) -> Maybe (a :~~: e) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a :~~: e
HRefl -> a
e
e) (Key a
k1 Key a -> Key e -> Maybe (a :~~: e)
forall {k1} {k2} (a :: k1) (b :: k2).
Key a -> Key b -> Maybe (a :~~: b)
`eqKey` Key e
k2)