module PartialHandler where
import Prelude
import Control.Monad
import Control.Applicative
import Control.Exception
import Control.Concurrent
import Data.Maybe
import Data.Monoid
import System.IO.Error
newtype PartialHandler a =
PartialHandler (SomeException -> Maybe (IO a))
instance Functor PartialHandler where
fmap fn (PartialHandler partialHandlerFn) =
PartialHandler (fmap (fmap fn) . partialHandlerFn)
instance Applicative PartialHandler where
pure x =
PartialHandler (const (pure (pure x)))
(<*>) (PartialHandler partialHandlerFn1) (PartialHandler partialHandlerFn2) =
PartialHandler (liftA2 (liftA2 (liftA2 ($))) partialHandlerFn1 partialHandlerFn2)
instance Alternative PartialHandler where
empty =
PartialHandler (const Nothing)
(<|>) (PartialHandler partialHandlerFn1) (PartialHandler partialHandlerFn2) =
PartialHandler (liftA2 (<|>) partialHandlerFn1 partialHandlerFn2)
instance Monoid (PartialHandler a) where
mempty =
empty
mappend =
(<|>)
type TotalHandler a =
SomeException -> IO a
totalize :: PartialHandler a -> TotalHandler a
totalize (PartialHandler h) =
\e -> fromMaybe (error $ "Unhandled exception: " <> show e) (h e)
totalizeRethrowing :: PartialHandler a -> TotalHandler a
totalizeRethrowing (PartialHandler h) =
\e -> fromMaybe (throwIO e) (h e)
totalizeRethrowingTo :: ThreadId -> PartialHandler a -> TotalHandler a
totalizeRethrowingTo t (PartialHandler h) =
\e -> fromMaybe (throwTo t e >> throwIO e) (h e)
totalizeRethrowingTo_ :: ThreadId -> PartialHandler () -> TotalHandler ()
totalizeRethrowingTo_ t (PartialHandler h) =
\e -> fromMaybe (throwTo t e) (h e)
typed :: Exception e => (e -> Maybe (IO a)) -> PartialHandler a
typed h =
PartialHandler $ fromException >=> h
onThreadKilled :: IO a -> PartialHandler a
onThreadKilled handler =
typed $ \case
ThreadKilled -> Just handler
_ -> Nothing
onIOErrorByType :: (IOErrorType -> Maybe (IO a)) -> PartialHandler a
onIOErrorByType handler =
typed $ handler . ioeGetErrorType
onAlreadyExists :: IO a -> PartialHandler a
onAlreadyExists handler =
typed $ \e -> if isAlreadyExistsError e then Just handler else Nothing
onDoesNotExist :: IO a -> PartialHandler a
onDoesNotExist handler =
typed $ \e -> if isDoesNotExistError e then Just handler else Nothing
onAlreadyInUse :: IO a -> PartialHandler a
onAlreadyInUse handler =
typed $ \e -> if isAlreadyInUseError e then Just handler else Nothing
onFull :: IO a -> PartialHandler a
onFull handler =
typed $ \e -> if isFullError e then Just handler else Nothing
onEOF :: IO a -> PartialHandler a
onEOF handler =
typed $ \e -> if isEOFError e then Just handler else Nothing
onIllegalOperation :: IO a -> PartialHandler a
onIllegalOperation handler =
typed $ \e -> if isIllegalOperation e then Just handler else Nothing
onPermission :: IO a -> PartialHandler a
onPermission handler =
typed $ \e -> if isPermissionError e then Just handler else Nothing
onUser :: IO a -> PartialHandler a
onUser handler =
typed $ \e -> if isUserError e then Just handler else Nothing