module Text.Show.Text.Control.Exception (
showbSomeExceptionPrec
, showbIOException
, showbArithException
, showbArrayException
, showbAssertionFailed
#if MIN_VERSION_base(4,7,0)
, showbSomeAsyncException
#endif
, showbAsyncException
, showbNonTermination
, showbNestedAtomically
, showbBlockedIndefinitelyOnMVar
, showbBlockedIndefinitelyOnSTM
, showbDeadlock
, showbNoMethodError
, showbPatternMatchFail
, showbRecConError
, showbRecSelError
, showbRecUpdError
, showbErrorCall
, showbMaskingState
) where
import Control.Exception.Base
import Data.Monoid (mempty)
import Data.Text.Lazy.Builder (Builder, fromString)
import qualified Prelude as P
import Prelude hiding (Show)
import Text.Show.Text.Class (Show(showb, showbPrec))
import Text.Show.Text.TH.Internal (deriveShow)
import Text.Show.Text.Utils ((<>))
showbSomeExceptionPrec :: Int -> SomeException -> Builder
showbSomeExceptionPrec p (SomeException e) = fromString $ P.showsPrec p e ""
showbIOException :: IOException -> Builder
showbIOException = fromString . show
showbArithException :: ArithException -> Builder
showbArithException Overflow = "arithmetic overflow"
showbArithException Underflow = "arithmetic underflow"
showbArithException LossOfPrecision = "loss of precision"
showbArithException DivideByZero = "divide by zero"
showbArithException Denormal = "denormal"
#if MIN_VERSION_base(4,6,0)
showbArithException RatioZeroDenominator = "Ratio has zero denominator"
#endif
showbArrayException :: ArrayException -> Builder
showbArrayException (IndexOutOfBounds s)
= "array index out of range"
<> (if not $ null s then ": " <> fromString s
else mempty)
showbArrayException (UndefinedElement s)
= "undefined array element"
<> (if not $ null s then ": " <> fromString s
else mempty)
showbAssertionFailed :: AssertionFailed -> Builder
showbAssertionFailed (AssertionFailed err) = fromString err
#if MIN_VERSION_base(4,7,0)
showbSomeAsyncException :: SomeAsyncException -> Builder
showbSomeAsyncException (SomeAsyncException e) = fromString $ P.show e
#endif
showbAsyncException :: AsyncException -> Builder
showbAsyncException StackOverflow = "stack overflow"
showbAsyncException HeapOverflow = "heap overflow"
showbAsyncException ThreadKilled = "thread killed"
showbAsyncException UserInterrupt = "user interrupt"
showbNonTermination :: NonTermination -> Builder
showbNonTermination NonTermination = "<<loop>>"
showbNestedAtomically :: NestedAtomically -> Builder
showbNestedAtomically NestedAtomically = "Control.Concurrent.STM.atomically was nested"
showbBlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar -> Builder
showbBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation"
showbBlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM -> Builder
showbBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction"
showbDeadlock :: Deadlock -> Builder
showbDeadlock Deadlock = "<<deadlock>>"
showbNoMethodError :: NoMethodError -> Builder
showbNoMethodError (NoMethodError err) = fromString err
showbPatternMatchFail :: PatternMatchFail -> Builder
showbPatternMatchFail (PatternMatchFail err) = fromString err
showbRecConError :: RecConError -> Builder
showbRecConError (RecConError err) = fromString err
showbRecSelError :: RecSelError -> Builder
showbRecSelError (RecSelError err) = fromString err
showbRecUpdError :: RecUpdError -> Builder
showbRecUpdError (RecUpdError err) = fromString err
showbErrorCall :: ErrorCall -> Builder
showbErrorCall (ErrorCall err) = fromString err
showbMaskingState :: MaskingState -> Builder
showbMaskingState = showb
instance Show SomeException where
showbPrec = showbSomeExceptionPrec
instance Show IOException where
showb = showbIOException
instance Show ArithException where
showb = showbArithException
instance Show ArrayException where
showb = showbArrayException
instance Show AssertionFailed where
showb = showbAssertionFailed
#if MIN_VERSION_base(4,7,0)
instance Show SomeAsyncException where
showb = showbSomeAsyncException
#endif
instance Show AsyncException where
showb = showbAsyncException
instance Show NonTermination where
showb = showbNonTermination
instance Show NestedAtomically where
showb = showbNestedAtomically
instance Show BlockedIndefinitelyOnMVar where
showb = showbBlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnSTM where
showb = showbBlockedIndefinitelyOnSTM
instance Show Deadlock where
showb = showbDeadlock
instance Show NoMethodError where
showb = showbNoMethodError
instance Show PatternMatchFail where
showb = showbPatternMatchFail
instance Show RecConError where
showb = showbRecConError
instance Show RecSelError where
showb = showbRecSelError
instance Show RecUpdError where
showb = showbRecUpdError
instance Show ErrorCall where
showb = showbErrorCall
$(deriveShow ''MaskingState)