(original) (raw)

{-# 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 "<>"

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 /= :: AsyncException -> AsyncException -> Bool $c/= :: AsyncException -> AsyncException -> Bool == :: AsyncException -> AsyncException -> Bool $c== :: 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 min :: AsyncException -> AsyncException -> AsyncException $cmin :: AsyncException -> AsyncException -> AsyncException max :: AsyncException -> AsyncException -> AsyncException $cmax :: AsyncException -> AsyncException -> AsyncException

= :: AsyncException -> AsyncException -> Bool $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 compare :: AsyncException -> AsyncException -> Ordering $ccompare :: AsyncException -> AsyncException -> Ordering 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 /= :: ArrayException -> ArrayException -> Bool $c/= :: ArrayException -> ArrayException -> Bool == :: ArrayException -> ArrayException -> Bool $c== :: 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 min :: ArrayException -> ArrayException -> ArrayException $cmin :: ArrayException -> ArrayException -> ArrayException max :: ArrayException -> ArrayException -> ArrayException $cmax :: ArrayException -> ArrayException -> ArrayException

= :: ArrayException -> ArrayException -> Bool $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 compare :: ArrayException -> ArrayException -> Ordering $ccompare :: ArrayException -> ArrayException -> Ordering 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 /= :: ExitCode -> ExitCode -> Bool $c/= :: ExitCode -> ExitCode -> Bool == :: ExitCode -> ExitCode -> Bool $c== :: 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 min :: ExitCode -> ExitCode -> ExitCode $cmin :: ExitCode -> ExitCode -> ExitCode max :: ExitCode -> ExitCode -> ExitCode $cmax :: ExitCode -> ExitCode -> ExitCode

= :: ExitCode -> ExitCode -> Bool $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 compare :: ExitCode -> ExitCode -> Ordering $ccompare :: ExitCode -> ExitCode -> Ordering 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 readListPrec :: ReadPrec [ExitCode] $creadListPrec :: ReadPrec [ExitCode] readPrec :: ReadPrec ExitCode $creadPrec :: ReadPrec ExitCode readList :: ReadS [ExitCode] $creadList :: ReadS [ExitCode] readsPrec :: Int -> ReadS ExitCode $creadsPrec :: Int -> ReadS 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 showList :: [ExitCode] -> ShowS $cshowList :: [ExitCode] -> ShowS show :: ExitCode -> String $cshow :: ExitCode -> String showsPrec :: Int -> ExitCode -> ShowS $cshowsPrec :: Int -> 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 $cto :: forall x. Rep ExitCode x -> ExitCode $cfrom :: forall x. ExitCode -> Rep ExitCode x 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 '|'