unexceptionalio-0.4.0/0000755000000000000000000000000013274204641013112 5ustar0000000000000000unexceptionalio-0.4.0/UnexceptionalIO.hs0000644000000000000000000002214313274204641016516 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | When you've caught all the exceptions that can be handled safely, -- this is what you're left with. -- -- > runEitherIO . fromIO ≡ id -- -- It is intended that you use qualified imports with this library. -- -- > import UnexceptionalIO (UIO) -- > import qualified UnexceptionalIO as UIO module UnexceptionalIO ( UIO, Unexceptional(..), fromIO, run, runEitherIO, -- * Unsafe entry points #ifdef __GLASGOW_HASKELL__ fromIO', #endif unsafeFromIO, -- * Pseudo exceptions SomeNonPseudoException, #ifdef __GLASGOW_HASKELL__ PseudoException(..), ProgrammerError(..), ExternalError(..), -- * Pseudo exception helpers bracket, #if MIN_VERSION_base(4,6,0) forkFinally, fork #endif #endif ) where import Control.Applicative (Applicative(..), (<|>)) import Control.Monad (liftM, ap, (<=<)) import Control.Monad.Fix (MonadFix(..)) #ifdef __GLASGOW_HASKELL__ import System.Exit (ExitCode) import Control.Exception (try) import qualified Control.Exception as Ex import qualified Control.Concurrent as Concurrent #if MIN_VERSION_base(4,11,0) import qualified Control.Exception.Base as Ex #endif -- | Not everything handled by the exception system is a run-time error -- you can handle. This is the class of pseudo-exceptions you usually -- can do nothing about, just log or exit. -- -- Additionally, except for 'ExitCode' any of these psuedo-exceptions -- you could never guarentee to have caught, since they can come -- from anywhere at any time, we could never guarentee that 'UIO' does -- not contain them. data PseudoException = ProgrammerError ProgrammerError | -- ^ Mistakes programmers make ExternalError ExternalError | -- ^ Errors thrown by the runtime Exit ExitCode -- ^ Process exit requests deriving (Show) instance Ex.Exception PseudoException where toException (ProgrammerError e) = Ex.toException e toException (ExternalError e) = Ex.toException e toException (Exit e) = Ex.toException e fromException e = ProgrammerError <$> Ex.fromException e <|> ExternalError <$> Ex.fromException e <|> Exit <$> Ex.fromException e -- | Pseudo-exceptions caused by a programming error -- -- Partial functions, 'error', 'undefined', etc data ProgrammerError = #if MIN_VERSION_base(4,9,0) TypeError Ex.TypeError | #endif ArithException Ex.ArithException | ArrayException Ex.ArrayException | AssertionFailed Ex.AssertionFailed | ErrorCall Ex.ErrorCall | NestedAtomically Ex.NestedAtomically | NoMethodError Ex.NoMethodError | PatternMatchFail Ex.PatternMatchFail | RecConError Ex.RecConError | RecSelError Ex.RecSelError | RecUpdError Ex.RecSelError deriving (Show) instance Ex.Exception ProgrammerError where #if MIN_VERSION_base(4,9,0) toException (TypeError e) = Ex.toException e #endif toException (ArithException e) = Ex.toException e toException (ArrayException e) = Ex.toException e toException (AssertionFailed e) = Ex.toException e toException (ErrorCall e) = Ex.toException e toException (NestedAtomically e) = Ex.toException e toException (NoMethodError e) = Ex.toException e toException (PatternMatchFail e) = Ex.toException e toException (RecConError e) = Ex.toException e toException (RecSelError e) = Ex.toException e toException (RecUpdError e) = Ex.toException e fromException e = #if MIN_VERSION_base(4,9,0) TypeError <$> Ex.fromException e <|> #endif ArithException <$> Ex.fromException e <|> ArrayException <$> Ex.fromException e <|> AssertionFailed <$> Ex.fromException e <|> ErrorCall <$> Ex.fromException e <|> NestedAtomically <$> Ex.fromException e <|> NoMethodError <$> Ex.fromException e <|> PatternMatchFail <$> Ex.fromException e <|> RecConError <$> Ex.fromException e <|> RecSelError <$> Ex.fromException e <|> RecUpdError <$> Ex.fromException e -- | Pseudo-exceptions thrown by the runtime environment data ExternalError = #if MIN_VERSION_base(4,10,0) CompactionFailed Ex.CompactionFailed | #endif #if MIN_VERSION_base(4,11,0) FixIOException Ex.FixIOException | #endif #if MIN_VERSION_base(4,7,0) AsyncException Ex.SomeAsyncException | #else AsyncException Ex.AsyncException | #endif BlockedIndefinitelyOnSTM Ex.BlockedIndefinitelyOnSTM | BlockedIndefinitelyOnMVar Ex.BlockedIndefinitelyOnMVar | Deadlock Ex.Deadlock | NonTermination Ex.NonTermination deriving (Show) instance Ex.Exception ExternalError where #if MIN_VERSION_base(4,10,0) toException (CompactionFailed e) = Ex.toException e #endif #if MIN_VERSION_base(4,11,0) toException (FixIOException e) = Ex.toException e #endif toException (AsyncException e) = Ex.toException e toException (BlockedIndefinitelyOnMVar e) = Ex.toException e toException (BlockedIndefinitelyOnSTM e) = Ex.toException e toException (Deadlock e) = Ex.toException e toException (NonTermination e) = Ex.toException e fromException e = #if MIN_VERSION_base(4,10,0) CompactionFailed <$> Ex.fromException e <|> #endif #if MIN_VERSION_base(4,11,0) FixIOException <$> Ex.fromException e <|> #endif AsyncException <$> Ex.fromException e <|> BlockedIndefinitelyOnSTM <$> Ex.fromException e <|> BlockedIndefinitelyOnMVar <$> Ex.fromException e <|> Deadlock <$> Ex.fromException e <|> NonTermination <$> Ex.fromException e -- | Every 'Ex.SomeException' but 'PseudoException' newtype SomeNonPseudoException = SomeNonPseudoException Ex.SomeException deriving (Show) instance Ex.Exception SomeNonPseudoException where toException (SomeNonPseudoException e) = e fromException e = case Ex.fromException e of Just pseudo -> const Nothing (pseudo :: PseudoException) Nothing -> Just (SomeNonPseudoException e) throwIO :: (Ex.Exception e) => e -> IO a throwIO = Ex.throwIO #else -- Haskell98 import 'IO' instead import System.IO.Error (IOError, ioError, try) type SomeNonPseudoException = IOError throwIO :: SomeNonPseudoException -> IO a throwIO = ioError #endif -- | IO without any 'PseudoException' newtype UIO a = UIO (IO a) instance Functor UIO where fmap = liftM instance Applicative UIO where pure = return (<*>) = ap instance Monad UIO where return = UIO . return (UIO x) >>= f = UIO (x >>= run . f) fail s = error $ "UnexceptionalIO cannot fail (" ++ s ++ ")" instance MonadFix UIO where mfix f = UIO (mfix $ run . f) -- | Polymorphic base without any 'PseudoException' class (Monad m) => Unexceptional m where lift :: UIO a -> m a instance Unexceptional UIO where lift = id instance Unexceptional IO where lift = run -- | Catch any exception but 'PseudoException' in an 'IO' action fromIO :: (Unexceptional m) => IO a -> m (Either SomeNonPseudoException a) fromIO = unsafeFromIO . try -- | Re-embed 'UIO' into 'IO' run :: UIO a -> IO a run (UIO io) = io -- | Re-embed 'UIO' and possible exception back into 'IO' #ifdef __GLASGOW_HASKELL__ runEitherIO :: (Ex.Exception e) => UIO (Either e a) -> IO a #else runEitherIO :: UIO (Either SomeNonPseudoException a) -> IO a #endif runEitherIO = either throwIO return <=< run #ifdef __GLASGOW_HASKELL__ -- | You promise that 'e' covers all exceptions but 'PseudoException' -- thrown by this 'IO' action -- -- This function is partial if you lie fromIO' :: (Ex.Exception e, Unexceptional m) => IO a -> m (Either e a) fromIO' = (return . either (Left . maybePartial . Ex.fromException . Ex.toException) Right) <=< fromIO where maybePartial (Just x) = x maybePartial Nothing = error "UnexceptionalIO.fromIO' exception of unspecified type" #endif -- | You promise there are no exceptions but 'PseudoException' thrown by this 'IO' action unsafeFromIO :: (Unexceptional m) => IO a -> m a unsafeFromIO = lift . UIO #ifdef __GLASGOW_HASKELL__ -- | When you're doing resource handling, 'PseudoException' matters. -- You still need to use the 'Ex.bracket' pattern to handle cleanup. bracket :: (Unexceptional m) => UIO a -> (a -> UIO ()) -> (a -> UIO c) -> m c bracket acquire release body = unsafeFromIO $ Ex.bracket (run acquire) (run . release) (run . body) #if MIN_VERSION_base(4,6,0) -- | Mirrors 'Concurrent.forkFinally', but since the body is 'UIO', -- the thread must terminate successfully or because of 'PseudoException' forkFinally :: (Unexceptional m) => UIO a -> (Either PseudoException a -> UIO ()) -> m Concurrent.ThreadId forkFinally body handler = unsafeFromIO $ Concurrent.forkFinally (run body) $ \result -> case result of Left e -> case Ex.fromException e of Just pseudo -> run $ handler $ Left pseudo Nothing -> error $ "Bug in UnexceptionalIO: forkFinally caught a non-PseudoException: " ++ show e Right x -> run $ handler $ Right x -- | Mirrors 'Concurrent.forkIO', but re-throws any 'PseudoException' -- to the parent thread fork :: (Unexceptional m) => UIO () -> m Concurrent.ThreadId fork body = do parent <- unsafeFromIO Concurrent.myThreadId forkFinally body $ either (unsafeFromIO . Concurrent.throwTo parent) (const $ return ()) #endif #endif unexceptionalio-0.4.0/Setup.hs0000644000000000000000000000005613274204641014547 0ustar0000000000000000import Distribution.Simple main = defaultMain unexceptionalio-0.4.0/unexceptionalio.cabal0000644000000000000000000000232713274204641017310 0ustar0000000000000000name: unexceptionalio version: 0.4.0 cabal-version: >=1.8 license: OtherLicense license-file: COPYING copyright: © 2013-2014 Stephen Paul Weber category: Control author: Stephen Paul Weber maintainer: Stephen Paul Weber stability: experimental build-type: Simple homepage: https://github.com/singpolyma/unexceptionalio bug-reports: http://github.com/singpolyma/unexceptionalio/issues synopsis: IO without any non-error, synchronous exceptions description: When you've caught all the exceptions that can be handled safely, this is what you're left with. . It is intended that you use qualified imports with this library. . > import UnexceptionalIO (UIO) > import qualified UnexceptionalIO as UIO . You may also with to investigate unexceptionalio-trans if you like monad transformers. library exposed-modules: UnexceptionalIO build-depends: base == 4.* source-repository head type: git location: git://github.com/singpolyma/unexceptionalio.git unexceptionalio-0.4.0/COPYING0000644000000000000000000000136113274204641014146 0ustar0000000000000000Copyright © 2013, Stephen Paul Weber Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies. THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.