{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
ExistentialQuantification, ImplicitParams #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_HADDOCK not-home #-}
module GHC.IO.Exception (
BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
Deadlock(..),
AllocationLimitExceeded(..), allocationLimitExceeded,
AssertionFailed(..),
CompactionFailed(..),
cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,
SomeAsyncException(..),
asyncExceptionToException, asyncExceptionFromException,
AsyncException(..), stackOverflow, heapOverflow,
ArrayException(..),
ExitCode(..),
FixIOException (..),
ioException,
ioError,
IOError,
IOException(..),
IOErrorType(..),
userError,
assertError,
unsupportedOperation,
untangle,
) where
import GHC.Base
import GHC.Generics
import GHC.List
import GHC.IO
import GHC.Show
import GHC.Read
import GHC.Exception
import GHC.IO.Handle.Types
import GHC.OldList ( intercalate )
import {-# SOURCE #-} GHC.Stack.CCS
import Foreign.C.Types
import Data.Typeable ( cast )
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
instance Exception BlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnMVar where
showsPrec :: Int -> BlockedIndefinitelyOnMVar -> ShowS
showsPrec Int
_ BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar = String -> ShowS
showString String
"thread blocked indefinitely in an MVar operation"
blockedIndefinitelyOnMVar :: SomeException
blockedIndefinitelyOnMVar :: SomeException
blockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar -> SomeException
forall e. Exception e => e -> SomeException
toException BlockedIndefinitelyOnMVar
BlockedIndefinitelyOnMVar
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
instance Exception BlockedIndefinitelyOnSTM
instance Show BlockedIndefinitelyOnSTM where
showsPrec :: Int -> BlockedIndefinitelyOnSTM -> ShowS
showsPrec Int
_ BlockedIndefinitelyOnSTM
BlockedIndefinitelyOnSTM = String -> ShowS
showString String
"thread blocked indefinitely in an STM transaction"
blockedIndefinitelyOnSTM :: SomeException
blockedIndefinitelyOnSTM :: SomeException
blockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM -> SomeException
forall e. Exception e => e -> SomeException
toException BlockedIndefinitelyOnSTM
BlockedIndefinitelyOnSTM
data Deadlock = Deadlock
instance Exception Deadlock
instance Show Deadlock where
showsPrec :: Int -> Deadlock -> ShowS
showsPrec Int
_ Deadlock
Deadlock = String -> ShowS
showString String
"<<deadlock>>"
data AllocationLimitExceeded = AllocationLimitExceeded
instance Exception AllocationLimitExceeded where
toException :: AllocationLimitExceeded -> SomeException
toException = AllocationLimitExceeded -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException
fromException :: SomeException -> Maybe AllocationLimitExceeded
fromException = SomeException -> Maybe AllocationLimitExceeded
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException
instance Show AllocationLimitExceeded where
showsPrec :: Int -> AllocationLimitExceeded -> ShowS
showsPrec Int
_ AllocationLimitExceeded
AllocationLimitExceeded =
String -> ShowS
showString String
"allocation limit exceeded"
allocationLimitExceeded :: SomeException
allocationLimitExceeded :: SomeException
allocationLimitExceeded = AllocationLimitExceeded -> SomeException
forall e. Exception e => e -> SomeException
toException AllocationLimitExceeded
AllocationLimitExceeded
newtype CompactionFailed = CompactionFailed String
instance Exception CompactionFailed where
instance Show CompactionFailed where
showsPrec :: Int -> CompactionFailed -> ShowS
showsPrec Int
_ (CompactionFailed String
why) =
String -> ShowS
showString (String
"compaction failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
why)
cannotCompactFunction :: SomeException
cannotCompactFunction :: SomeException
cannotCompactFunction =
CompactionFailed -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> CompactionFailed
CompactionFailed String
"cannot compact functions")
cannotCompactPinned :: SomeException
cannotCompactPinned :: SomeException
cannotCompactPinned =
CompactionFailed -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> CompactionFailed
CompactionFailed String
"cannot compact pinned objects")
cannotCompactMutable :: SomeException
cannotCompactMutable :: SomeException
cannotCompactMutable =
CompactionFailed -> SomeException
forall e. Exception e => e -> SomeException
toException (String -> CompactionFailed
CompactionFailed String
"cannot compact mutable objects")
newtype AssertionFailed = AssertionFailed String
instance Exception AssertionFailed
instance Show AssertionFailed where
showsPrec :: Int -> AssertionFailed -> ShowS
showsPrec Int
_ (AssertionFailed String
err) = String -> ShowS
showString String
err
data SomeAsyncException = forall e . Exception e => SomeAsyncException e
instance Show SomeAsyncException where
showsPrec :: Int -> SomeAsyncException -> ShowS
showsPrec Int
p (SomeAsyncException e
e) = Int -> e -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p e
e
instance Exception SomeAsyncException
asyncExceptionToException :: Exception e => e -> SomeException
asyncExceptionToException :: forall e. Exception e => e -> SomeException
asyncExceptionToException = SomeAsyncException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeAsyncException -> SomeException)
-> (e -> SomeAsyncException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeAsyncException
forall e. Exception e => e -> SomeAsyncException
SomeAsyncException
asyncExceptionFromException :: Exception e => SomeException -> Maybe e
asyncExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException SomeException
x = do
SomeAsyncException e
a <- SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a
data AsyncException
= StackOverflow
| HeapOverflow
| ThreadKilled
| UserInterrupt
deriving ( AsyncException -> AsyncException -> Bool
(AsyncException -> AsyncException -> Bool)
-> (AsyncException -> AsyncException -> Bool) -> Eq AsyncException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AsyncException -> AsyncException -> Bool
== :: AsyncException -> AsyncException -> Bool
$c/= :: AsyncException -> AsyncException -> Bool
/= :: AsyncException -> AsyncException -> Bool
Eq
, Eq AsyncException
Eq AsyncException =>
(AsyncException -> AsyncException -> Ordering)
-> (AsyncException -> AsyncException -> Bool)
-> (AsyncException -> AsyncException -> Bool)
-> (AsyncException -> AsyncException -> Bool)
-> (AsyncException -> AsyncException -> Bool)
-> (AsyncException -> AsyncException -> AsyncException)
-> (AsyncException -> AsyncException -> AsyncException)
-> Ord AsyncException
AsyncException -> AsyncException -> Bool
AsyncException -> AsyncException -> Ordering
AsyncException -> AsyncException -> AsyncException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AsyncException -> AsyncException -> Ordering
compare :: AsyncException -> AsyncException -> Ordering
$c< :: AsyncException -> AsyncException -> Bool
< :: AsyncException -> AsyncException -> Bool
$c<= :: AsyncException -> AsyncException -> Bool
<= :: AsyncException -> AsyncException -> Bool
$c> :: AsyncException -> AsyncException -> Bool
> :: AsyncException -> AsyncException -> Bool
$c>= :: AsyncException -> AsyncException -> Bool
>= :: AsyncException -> AsyncException -> Bool
$cmax :: AsyncException -> AsyncException -> AsyncException
max :: AsyncException -> AsyncException -> AsyncException
$cmin :: AsyncException -> AsyncException -> AsyncException
min :: AsyncException -> AsyncException -> AsyncException
Ord
)
instance Exception AsyncException where
toException :: AsyncException -> SomeException
toException = AsyncException -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException
fromException :: SomeException -> Maybe AsyncException
fromException = SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException
data ArrayException
= IndexOutOfBounds String
| UndefinedElement String
deriving ( ArrayException -> ArrayException -> Bool
(ArrayException -> ArrayException -> Bool)
-> (ArrayException -> ArrayException -> Bool) -> Eq ArrayException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ArrayException -> ArrayException -> Bool
== :: ArrayException -> ArrayException -> Bool
$c/= :: ArrayException -> ArrayException -> Bool
/= :: ArrayException -> ArrayException -> Bool
Eq
, Eq ArrayException
Eq ArrayException =>
(ArrayException -> ArrayException -> Ordering)
-> (ArrayException -> ArrayException -> Bool)
-> (ArrayException -> ArrayException -> Bool)
-> (ArrayException -> ArrayException -> Bool)
-> (ArrayException -> ArrayException -> Bool)
-> (ArrayException -> ArrayException -> ArrayException)
-> (ArrayException -> ArrayException -> ArrayException)
-> Ord ArrayException
ArrayException -> ArrayException -> Bool
ArrayException -> ArrayException -> Ordering
ArrayException -> ArrayException -> ArrayException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ArrayException -> ArrayException -> Ordering
compare :: ArrayException -> ArrayException -> Ordering
$c< :: ArrayException -> ArrayException -> Bool
< :: ArrayException -> ArrayException -> Bool
$c<= :: ArrayException -> ArrayException -> Bool
<= :: ArrayException -> ArrayException -> Bool
$c> :: ArrayException -> ArrayException -> Bool
> :: ArrayException -> ArrayException -> Bool
$c>= :: ArrayException -> ArrayException -> Bool
>= :: ArrayException -> ArrayException -> Bool
$cmax :: ArrayException -> ArrayException -> ArrayException
max :: ArrayException -> ArrayException -> ArrayException
$cmin :: ArrayException -> ArrayException -> ArrayException
min :: ArrayException -> ArrayException -> ArrayException
Ord
)
instance Exception ArrayException
stackOverflow, heapOverflow :: SomeException
stackOverflow :: SomeException
stackOverflow = AsyncException -> SomeException
forall e. Exception e => e -> SomeException
toException AsyncException
StackOverflow
heapOverflow :: SomeException
heapOverflow = AsyncException -> SomeException
forall e. Exception e => e -> SomeException
toException AsyncException
HeapOverflow
instance Show AsyncException where
showsPrec :: Int -> AsyncException -> ShowS
showsPrec Int
_ AsyncException
StackOverflow = String -> ShowS
showString String
"stack overflow"
showsPrec Int
_ AsyncException
HeapOverflow = String -> ShowS
showString String
"heap overflow"
showsPrec Int
_ AsyncException
ThreadKilled = String -> ShowS
showString String
"thread killed"
showsPrec Int
_ AsyncException
UserInterrupt = String -> ShowS
showString String
"user interrupt"
instance Show ArrayException where
showsPrec :: Int -> ArrayException -> ShowS
showsPrec Int
_ (IndexOutOfBounds String
s)
= String -> ShowS
showString String
"array index out of range"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
null String
s) then String -> ShowS
showString String
": " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s
else ShowS
forall a. a -> a
id)
showsPrec Int
_ (UndefinedElement String
s)
= String -> ShowS
showString String
"undefined array element"
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
null String
s) then String -> ShowS
showString String
": " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s
else ShowS
forall a. a -> a
id)
data FixIOException = FixIOException
instance Exception FixIOException
instance Show FixIOException where
showsPrec :: Int -> FixIOException -> ShowS
showsPrec Int
_ FixIOException
FixIOException = String -> ShowS
showString String
"cyclic evaluation in fixIO"
data ExitCode
= ExitSuccess
| ExitFailure Int
deriving (ExitCode -> ExitCode -> Bool
(ExitCode -> ExitCode -> Bool)
-> (ExitCode -> ExitCode -> Bool) -> Eq ExitCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExitCode -> ExitCode -> Bool
== :: ExitCode -> ExitCode -> Bool
$c/= :: ExitCode -> ExitCode -> Bool
/= :: ExitCode -> ExitCode -> Bool
Eq, Eq ExitCode
Eq ExitCode =>
(ExitCode -> ExitCode -> Ordering)
-> (ExitCode -> ExitCode -> Bool)
-> (ExitCode -> ExitCode -> Bool)
-> (ExitCode -> ExitCode -> Bool)
-> (ExitCode -> ExitCode -> Bool)
-> (ExitCode -> ExitCode -> ExitCode)
-> (ExitCode -> ExitCode -> ExitCode)
-> Ord ExitCode
ExitCode -> ExitCode -> Bool
ExitCode -> ExitCode -> Ordering
ExitCode -> ExitCode -> ExitCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExitCode -> ExitCode -> Ordering
compare :: ExitCode -> ExitCode -> Ordering
$c< :: ExitCode -> ExitCode -> Bool
< :: ExitCode -> ExitCode -> Bool
$c<= :: ExitCode -> ExitCode -> Bool
<= :: ExitCode -> ExitCode -> Bool
$c> :: ExitCode -> ExitCode -> Bool
> :: ExitCode -> ExitCode -> Bool
$c>= :: ExitCode -> ExitCode -> Bool
>= :: ExitCode -> ExitCode -> Bool
$cmax :: ExitCode -> ExitCode -> ExitCode
max :: ExitCode -> ExitCode -> ExitCode
$cmin :: ExitCode -> ExitCode -> ExitCode
min :: ExitCode -> ExitCode -> ExitCode
Ord, ReadPrec [ExitCode]
ReadPrec ExitCode
Int -> ReadS ExitCode
ReadS [ExitCode]
(Int -> ReadS ExitCode)
-> ReadS [ExitCode]
-> ReadPrec ExitCode
-> ReadPrec [ExitCode]
-> Read ExitCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ExitCode
readsPrec :: Int -> ReadS ExitCode
$creadList :: ReadS [ExitCode]
readList :: ReadS [ExitCode]
$creadPrec :: ReadPrec ExitCode
readPrec :: ReadPrec ExitCode
$creadListPrec :: ReadPrec [ExitCode]
readListPrec :: ReadPrec [ExitCode]
Read, Int -> ExitCode -> ShowS
[ExitCode] -> ShowS
ExitCode -> String
(Int -> ExitCode -> ShowS)
-> (ExitCode -> String) -> ([ExitCode] -> ShowS) -> Show ExitCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExitCode -> ShowS
showsPrec :: Int -> ExitCode -> ShowS
$cshow :: ExitCode -> String
show :: ExitCode -> String
$cshowList :: [ExitCode] -> ShowS
showList :: [ExitCode] -> ShowS
Show, (forall x. ExitCode -> Rep ExitCode x)
-> (forall x. Rep ExitCode x -> ExitCode) -> Generic ExitCode
forall x. Rep ExitCode x -> ExitCode
forall x. ExitCode -> Rep ExitCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExitCode -> Rep ExitCode x
from :: forall x. ExitCode -> Rep ExitCode x
$cto :: forall x. Rep ExitCode x -> ExitCode
to :: forall x. Rep ExitCode x -> ExitCode
Generic)
instance Exception ExitCode
ioException :: IOException -> IO a
ioException :: forall a. IOException -> IO a
ioException IOException
err = IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO IOException
err
ioError :: IOError -> IO a
ioError :: forall a. IOException -> IO a
ioError = IOException -> IO a
forall a. IOException -> IO a
ioException
type IOError = IOException
data IOException
= IOError {
IOException -> Maybe Handle
ioe_handle :: Maybe Handle,
IOException -> IOErrorType
ioe_type :: IOErrorType,
IOException -> String
ioe_location :: String,
IOException -> String
ioe_description :: String,
IOException -> Maybe CInt
ioe_errno :: Maybe CInt,
IOException -> Maybe String
ioe_filename :: Maybe FilePath
}
instance Exception IOException
instance Eq IOException where
(IOError Maybe Handle
h1 IOErrorType
e1 String
loc1 String
str1 Maybe CInt
en1 Maybe String
fn1) == :: IOException -> IOException -> Bool
== (IOError Maybe Handle
h2 IOErrorType
e2 String
loc2 String
str2 Maybe CInt
en2 Maybe String
fn2) =
IOErrorType
e1IOErrorType -> IOErrorType -> Bool
forall a. Eq a => a -> a -> Bool
==IOErrorType
e2 Bool -> Bool -> Bool
&& String
str1String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
str2 Bool -> Bool -> Bool
&& Maybe Handle
h1Maybe Handle -> Maybe Handle -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe Handle
h2 Bool -> Bool -> Bool
&& String
loc1String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
loc2 Bool -> Bool -> Bool
&& Maybe CInt
en1Maybe CInt -> Maybe CInt -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe CInt
en2 Bool -> Bool -> Bool
&& Maybe String
fn1Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe String
fn2
data IOErrorType
= AlreadyExists
| NoSuchThing
| ResourceBusy
| ResourceExhausted
| EOF
| IllegalOperation
| PermissionDenied
| UserError
| UnsatisfiedConstraints
| SystemError
| ProtocolError
| OtherError
| InvalidArgument
| InappropriateType
| HardwareFault
| UnsupportedOperation
| TimeExpired
| ResourceVanished
| Interrupted
instance Eq IOErrorType where
IOErrorType
x == :: IOErrorType -> IOErrorType -> Bool
== IOErrorType
y = Int# -> Bool
isTrue# (IOErrorType -> Int#
forall a. a -> Int#
getTag IOErrorType
x Int# -> Int# -> Int#
==# IOErrorType -> Int#
forall a. a -> Int#
getTag IOErrorType
y)
instance Show IOErrorType where
showsPrec :: Int -> IOErrorType -> ShowS
showsPrec Int
_ IOErrorType
e =
String -> ShowS
showString (String -> ShowS) -> String -> ShowS
forall a b. (a -> b) -> a -> b
$
case IOErrorType
e of
IOErrorType
AlreadyExists -> String
"already exists"
IOErrorType
NoSuchThing -> String
"does not exist"
IOErrorType
ResourceBusy -> String
"resource busy"
IOErrorType
ResourceExhausted -> String
"resource exhausted"
IOErrorType
EOF -> String
"end of file"
IOErrorType
IllegalOperation -> String
"illegal operation"
IOErrorType
PermissionDenied -> String
"permission denied"
IOErrorType
UserError -> String
"user error"
IOErrorType
HardwareFault -> String
"hardware fault"
IOErrorType
InappropriateType -> String
"inappropriate type"
IOErrorType
Interrupted -> String
"interrupted"
IOErrorType
InvalidArgument -> String
"invalid argument"
IOErrorType
OtherError -> String
"failed"
IOErrorType
ProtocolError -> String
"protocol error"
IOErrorType
ResourceVanished -> String
"resource vanished"
IOErrorType
SystemError -> String
"system error"
IOErrorType
TimeExpired -> String
"timeout"
IOErrorType
UnsatisfiedConstraints -> String
"unsatisfied constraints"
IOErrorType
UnsupportedOperation -> String
"unsupported operation"
userError :: String -> IOError
userError :: String -> IOException
userError String
str = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
UserError String
"" String
str Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
instance Show IOException where
showsPrec :: Int -> IOException -> ShowS
showsPrec Int
p (IOError Maybe Handle
hdl IOErrorType
iot String
loc String
s Maybe CInt
_ Maybe String
fn) =
(case Maybe String
fn of
Maybe String
Nothing -> case Maybe Handle
hdl of
Maybe Handle
Nothing -> ShowS
forall a. a -> a
id
Just Handle
h -> Int -> Handle -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Handle
h ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": "
Just String
name -> String -> ShowS
showString String
name ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case String
loc of
String
"" -> ShowS
forall a. a -> a
id
String
_ -> String -> ShowS
showString String
loc ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
": ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> IOErrorType -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p IOErrorType
iot ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(case String
s of
String
"" -> ShowS
forall a. a -> a
id
String
_ -> String -> ShowS
showString String
" (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
")")
assertError :: (?callStack :: CallStack) => Bool -> a -> a
assertError :: forall a. (?callStack::CallStack) => Bool -> a -> a
assertError Bool
predicate a
v
| Bool
predicate = a -> a
forall a. a -> a
lazy a
v
| Bool
otherwise = IO a -> a
forall a. IO a -> a
unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
[String]
ccsStack <- IO [String]
currentCallStack
let
implicitParamCallStack :: [String]
implicitParamCallStack = CallStack -> [String]
prettyCallStackLines ?callStack::CallStack
CallStack
?callStack
ccsCallStack :: [String]
ccsCallStack = [String] -> [String]
showCCSStack [String]
ccsStack
stack :: String
stack = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
implicitParamCallStack [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
ccsCallStack
AssertionFailed -> IO a
forall e a. Exception e => e -> IO a
throwIO (String -> AssertionFailed
AssertionFailed (String
"Assertion failed\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
stack))
unsupportedOperation :: IOError
unsupportedOperation :: IOException
unsupportedOperation =
(Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing IOErrorType
UnsupportedOperation String
""
String
"Operation is not supported" Maybe CInt
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing)
untangle :: Addr# -> String -> String
untangle :: Addr# -> ShowS
untangle Addr#
coded String
message
= String
location
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
message
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
details
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
where
coded_str :: String
coded_str = Addr# -> String
unpackCStringUtf8# Addr#
coded
(String
location, String
details)
= case ((Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
not_bar String
coded_str) of { (String
loc, String
rest) ->
case String
rest of
(Char
'|':String
det) -> (String
loc, Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
det)
String
_ -> (String
loc, String
"")
}
not_bar :: Char -> Bool
not_bar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|'