ref: 466bdea5e6fed40315643a604fadedf864522088
dir: /lib/Control/Exception/Internal.hs/
-- Copyright 2024 Lennart Augustsson
-- See LICENSE file for full license.
module Control.Exception.Internal(
throw, catch,
Exception(..),
SomeException(..),
PatternMatchFail, NoMethodError, RecSelError, RecConError(..),
patternMatchFail, noMethodError, recSelError, recConError,
) where
import Prelude()
import Primitives(IO)
import Data.Char_Type
import Data.List_Type
import Data.Maybe_Type
import {-# SOURCE #-} Data.Typeable
import Text.Show
primRaise :: forall a . SomeException -> a
primRaise = primitive "raise"
primCatch :: forall a . IO a -> (SomeException -> IO a) -> IO a
primCatch = primitive "catch"
throw :: forall e a. Exception e => e -> a
throw e = primRaise (toException e)
catch :: forall e a .
Exception e
=> IO a
-> (e -> IO a)
-> IO a
catch io handler = primCatch io handler'
where handler' e = case fromException e of
Just e' -> handler e'
Nothing -> primRaise e
------------------
data SomeException = forall e . Exception e => SomeException e
deriving (Typeable)
-- NOTE: The runtime system knows about this class.
-- It uses displayException to show an uncaught exception.
-- Any changes here must be refleced in eval.c
class (Typeable e, Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
displayException :: e -> String
toException = SomeException
fromException (SomeException e) = cast e
displayException = show
------------------
-- Errors generated by the compiler
newtype PatternMatchFail = PatternMatchFail String deriving (Typeable)
newtype NoMethodError = NoMethodError String deriving (Typeable)
newtype RecSelError = RecSelError String deriving (Typeable)
newtype RecConError = RecConError String deriving (Typeable)
instance Show PatternMatchFail where showsPrec _ (PatternMatchFail s) r = showString "no match at " (showString s r)
instance Show NoMethodError where showsPrec _ (NoMethodError s) r = showString "no default for " (showString s r)
instance Show RecSelError where showsPrec _ (RecSelError s) r = showString "no field " (showString s r)
instance Show RecConError where showsPrec _ (RecConError s) r = showString "uninit field " (showString s r)
instance Exception PatternMatchFail
instance Exception NoMethodError
instance Exception RecSelError
instance Exception RecConError
patternMatchFail :: forall a . String -> a
noMethodError :: forall a . String -> a
recSelError :: forall a . String -> a
recConError :: forall a . String -> a
noMethodError s = throw (NoMethodError s)
patternMatchFail s = throw (PatternMatchFail s)
recSelError s = throw (RecSelError s)
recConError s = throw (RecConError s)