Introduce throwFailure

This commit is contained in:
Edsko de Vries 2023-03-21 13:14:22 +01:00
parent ad7043bb75
commit 5c420970c1

View file

@ -2,10 +2,13 @@ module Foreign.Rust.Failure (
Failure -- Opaque Failure -- Opaque
, failureMessage , failureMessage
, mkFailure , mkFailure
, throwFailure
, throwFailureIO
) where ) where
import GHC.Stack import Control.Exception
import Data.Text (Text) import Data.Text (Text)
import GHC.Stack
-- | Failure reported by a Rust function -- | Failure reported by a Rust function
-- --
@ -14,7 +17,8 @@ data Failure = Failure {
failureMessage :: Text failureMessage :: Text
, failureCallstackHaskell :: PrettyCallStack , failureCallstackHaskell :: PrettyCallStack
} }
deriving (Show) deriving stock (Show)
deriving anyclass (Exception)
mkFailure :: HasCallStack => Text -> Failure mkFailure :: HasCallStack => Text -> Failure
mkFailure e = Failure e (PrettyCallStack callStack) mkFailure e = Failure e (PrettyCallStack callStack)
@ -24,4 +28,10 @@ newtype PrettyCallStack = PrettyCallStack CallStack
instance Show PrettyCallStack where instance Show PrettyCallStack where
show (PrettyCallStack stack) = prettyCallStack stack show (PrettyCallStack stack) = prettyCallStack stack
throwFailure :: Either Failure a -> a
throwFailure (Left err) = throw err
throwFailure (Right a) = a
throwFailureIO :: Either Failure a -> IO a
throwFailureIO (Left err) = throwIO err
throwFailureIO (Right a) = return a