{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
module Control.Exception.Optic (
non'
, unlifted
, exmapped
, exception
, pattern Exception
, throws
, throws_
, throwsTo
, tries
, tries_
, catches
, catches_
, handles
, handles_
, ioException
, ioeLocation
, ioeDescription
, ioeHandle
, ioeFileName
, ioeErrno
, ioeErrorType
, alreadyExists
, noSuchThing
, resourceBusy
, resourceExhausted
, eof
, illegalOperation
, permissionDenied
, userError
, unsatisfiedConstraints
, systemError
, protocolError
, otherError
, invalidArgument
, inappropriateType
, hardwareFault
, unsupportedOperation
, sync
, async
, asyncException
, pattern AsyncException
, timeExpired
, resourceVanished
, interrupted
, stackOverflow
, heapOverflow
, threadKilled
, userInterrupt
, overflow
, underflow
, lossOfPrecision
, divideByZero
, denormal
, ratioZeroDenominator
, indexOutOfBounds
, undefinedElement
, illegal
, assertionFailed
, nonTermination
, nestedAtomically
, blockedIndefinitelyOnMVar
, blockedIndefinitelyOnSTM
, deadlock
, noMethodError
, patternMatchFail
, recConError
, recSelError
, recUpdError
, errorCall
, allocationLimitExceeded
) where
import Control.Exception (Exception(..), SomeException,
AsyncException(..), IOException, ArithException(..), ArrayException(..))
import Data.Maybe (fromMaybe)
import Data.Profunctor.Optic
import Data.Profunctor.Optic.Import
import Foreign.C.Types
import GHC.IO.Exception (IOErrorType)
import System.IO
import qualified Control.Exception as Ex
import qualified GHC.IO.Exception as Ghc
pattern Exception :: forall a. Exception a => a -> SomeException
pattern Exception e <- (preview exception -> Just e) where Exception e = review exception e
pattern AsyncException :: forall a. Exception a => a -> SomeException
pattern AsyncException e <- (preview asyncException -> Just e) where AsyncException e = review asyncException e
non' :: Prism' a () -> Iso' (Maybe a) a
non' p = iso (fromMaybe def) go where
def = review p ()
go b | p `isnt` b = Just b
| otherwise = Nothing
{-# INLINE non' #-}
ioException :: Prism' SomeException IOException
ioException = exception
ioeLocation :: Lens' IOException String
ioeLocation = lens Ghc.ioe_location $ \s e -> s { Ghc.ioe_location = e }
ioeDescription :: Lens' IOException String
ioeDescription = lens Ghc.ioe_description $ \s e -> s { Ghc.ioe_description = e }
ioeHandle :: Lens' IOException (Maybe Handle)
ioeHandle = lens Ghc.ioe_handle $ \s e -> s { Ghc.ioe_handle = e }
ioeFileName :: Lens' IOException (Maybe FilePath)
ioeFileName = lens Ghc.ioe_filename $ \s e -> s { Ghc.ioe_filename = e }
ioeErrno :: Lens' IOException (Maybe CInt)
ioeErrno = lens Ghc.ioe_errno $ \s e -> s { Ghc.ioe_errno = e }
ioeErrorType :: Lens' IOException IOErrorType
ioeErrorType = lens Ghc.ioe_type $ \s e -> s { Ghc.ioe_type = e }
alreadyExists :: Prism' IOErrorType ()
alreadyExists = only Ghc.AlreadyExists
noSuchThing :: Prism' IOErrorType ()
noSuchThing = only Ghc.NoSuchThing
resourceBusy :: Prism' IOErrorType ()
resourceBusy = only Ghc.ResourceBusy
resourceExhausted :: Prism' IOErrorType ()
resourceExhausted = only Ghc.ResourceExhausted
eof :: Prism' IOErrorType ()
eof = only Ghc.EOF
illegalOperation :: Prism' IOErrorType ()
illegalOperation = only Ghc.IllegalOperation
permissionDenied :: Prism' IOErrorType ()
permissionDenied = only Ghc.PermissionDenied
userError :: Prism' IOErrorType ()
userError = only Ghc.UserError
unsatisfiedConstraints :: Prism' IOErrorType ()
unsatisfiedConstraints = only Ghc.UnsatisfiedConstraints
systemError :: Prism' IOErrorType ()
systemError = only Ghc.SystemError
protocolError :: Prism' IOErrorType ()
protocolError = only Ghc.ProtocolError
otherError :: Prism' IOErrorType ()
otherError = only Ghc.OtherError
invalidArgument :: Prism' IOErrorType ()
invalidArgument = only Ghc.InvalidArgument
inappropriateType :: Prism' IOErrorType ()
inappropriateType = only Ghc.InappropriateType
hardwareFault :: Prism' IOErrorType ()
hardwareFault = only Ghc.HardwareFault
unsupportedOperation :: Prism' IOErrorType ()
unsupportedOperation = only Ghc.UnsupportedOperation
timeExpired :: Prism' IOErrorType ()
timeExpired = only Ghc.TimeExpired
resourceVanished :: Prism' IOErrorType ()
resourceVanished = only Ghc.ResourceVanished
interrupted :: Prism' IOErrorType ()
interrupted = only Ghc.Interrupted
stackOverflow :: Prism' AsyncException ()
stackOverflow = only Ex.StackOverflow
heapOverflow :: Prism' AsyncException ()
heapOverflow = only Ex.HeapOverflow
threadKilled :: Prism' AsyncException ()
threadKilled = only Ex.ThreadKilled
userInterrupt :: Prism' AsyncException ()
userInterrupt = only Ex.UserInterrupt
overflow :: Prism' ArithException ()
overflow = only Ex.Overflow
underflow :: Prism' ArithException ()
underflow = only Ex.Underflow
lossOfPrecision :: Prism' ArithException ()
lossOfPrecision = only Ex.LossOfPrecision
divideByZero :: Prism' ArithException ()
divideByZero = only Ex.DivideByZero
denormal :: Prism' ArithException ()
denormal = only Ex.Denormal
ratioZeroDenominator :: Prism' ArithException ()
ratioZeroDenominator = only Ex.RatioZeroDenominator
indexOutOfBounds :: Prism' ArrayException String
indexOutOfBounds = dimap sta join . right' . rmap Ex.IndexOutOfBounds
where sta (Ex.IndexOutOfBounds r) = Right r
sta t = Left t
undefinedElement :: Prism' ArrayException String
undefinedElement = dimap sta join . right' . rmap Ex.UndefinedElement
where sta (Ex.UndefinedElement r) = Right r
sta t = Left t
illegal :: Profunctor p => t -> Optic' p t ()
illegal t = const () `dimap` const t
assertionFailed :: Prism' Ex.AssertionFailed String
assertionFailed = iso (\(Ex.AssertionFailed a) -> a) Ex.AssertionFailed
nonTermination :: Prism' Ex.NonTermination ()
nonTermination = illegal Ex.NonTermination
nestedAtomically :: Prism' Ex.NestedAtomically ()
nestedAtomically = illegal Ex.NestedAtomically
blockedIndefinitelyOnMVar :: Prism' Ex.BlockedIndefinitelyOnMVar ()
blockedIndefinitelyOnMVar = illegal Ex.BlockedIndefinitelyOnMVar
blockedIndefinitelyOnSTM :: Prism' Ex.BlockedIndefinitelyOnSTM ()
blockedIndefinitelyOnSTM = illegal Ex.BlockedIndefinitelyOnSTM
deadlock :: Prism' Ex.Deadlock ()
deadlock = illegal Ex.Deadlock
noMethodError :: Prism' Ex.NoMethodError String
noMethodError = iso (\(Ex.NoMethodError a) -> a) Ex.NoMethodError
patternMatchFail :: Prism' Ex.PatternMatchFail String
patternMatchFail = iso (\(Ex.PatternMatchFail a) -> a) Ex.PatternMatchFail
recConError :: Prism' Ex.RecConError String
recConError = iso (\(Ex.RecConError a) -> a) Ex.RecConError
recSelError :: Prism' Ex.RecSelError String
recSelError = iso (\(Ex.RecSelError a) -> a) Ex.RecSelError
recUpdError :: Prism' Ex.RecUpdError String
recUpdError = iso (\(Ex.RecUpdError a) -> a) Ex.RecUpdError
errorCall :: Prism' Ex.ErrorCall String
errorCall = iso (\(Ex.ErrorCall a) -> a) Ex.ErrorCall
allocationLimitExceeded :: Prism' Ex.AllocationLimitExceeded ()
allocationLimitExceeded = illegal Ex.AllocationLimitExceeded