unexceptionalio-0.3.0/0000755000000000000000000000000012643516457013123 5ustar0000000000000000unexceptionalio-0.3.0/UnexceptionalIO.hs0000644000000000000000000000730012643516457016525 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 module UnexceptionalIO ( UIO, Unexceptional(..), fromIO, runUIO, runEitherIO, -- * Unsafe entry points #ifdef __GLASGOW_HASKELL__ fromIO', #endif unsafeFromIO, -- * Utilities syncIO ) where import Control.Applicative (Applicative(..)) import Control.Monad (liftM, ap, (<=<)) import Control.Monad.Fix (MonadFix(..)) #ifdef __GLASGOW_HASKELL__ import Data.Dynamic (Dynamic) import System.Exit (ExitCode) import qualified Control.Exception as Ex type SomeException = Ex.SomeException throwIO :: (Ex.Exception e) => e -> IO a throwIO = Ex.throwIO #else -- Haskell98 import 'IO' instead import System.IO.Error (IOError, ioError, try) type SomeException = IOError throwIO :: SomeException -> IO a throwIO = ioError #endif -- | IO without any non-error, synchronous exceptions 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 >>= runUIO . f) fail s = error $ "UnexceptionalIO cannot fail (" ++ s ++ ")" instance MonadFix UIO where mfix f = UIO (mfix $ runUIO . f) -- | Polymorphic base without any non-error, synchronous exceptions class Unexceptional m where liftUIO :: UIO a -> m a instance Unexceptional UIO where liftUIO = id instance Unexceptional IO where liftUIO = runUIO -- | Catch any non-error, synchronous exceptions in an 'IO' action fromIO :: IO a -> UIO (Either SomeException a) fromIO = unsafeFromIO . syncIO -- | Re-embed 'UIO' into 'IO' runUIO :: UIO a -> IO a runUIO (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 SomeException a) -> IO a #endif runEitherIO = either throwIO return <=< runUIO #ifdef __GLASGOW_HASKELL__ -- | You promise that 'e' covers all non-error, synchronous exceptions -- thrown by this 'IO' action -- -- This function is partial if you lie fromIO' :: (Ex.Exception e) => IO a -> UIO (Either e a) fromIO' = (return . either (Left . maybePartial . Ex.fromException) Right) <=< fromIO where maybePartial (Just x) = x maybePartial Nothing = error "UnexceptionalIO.fromIO' exception of unspecified type" #endif -- | You promise there are no exceptions thrown by this 'IO' action unsafeFromIO :: IO a -> UIO a unsafeFromIO = UIO -- | Catch all exceptions, except for asynchronous exceptions found in @base@ syncIO :: IO a -> IO (Either SomeException a) #ifdef __GLASGOW_HASKELL__ syncIO a = Ex.catches (fmap Right a) [ Ex.Handler (\e -> Ex.throwIO (e :: Ex.ArithException)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.ArrayException)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.AssertionFailed)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.AsyncException)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.BlockedIndefinitelyOnMVar)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.BlockedIndefinitelyOnSTM)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.Deadlock)), Ex.Handler (\e -> Ex.throwIO (e :: Dynamic)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.ErrorCall)), Ex.Handler (\e -> Ex.throwIO (e :: ExitCode)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.NestedAtomically)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.NoMethodError)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.NonTermination)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.PatternMatchFail)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecConError)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecSelError)), Ex.Handler (\e -> Ex.throwIO (e :: Ex.RecUpdError)), Ex.Handler (return . Left) ] #else syncIO = try #endif unexceptionalio-0.3.0/COPYING0000644000000000000000000000136112643516457014157 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. unexceptionalio-0.3.0/Setup.hs0000644000000000000000000000005612643516457014560 0ustar0000000000000000import Distribution.Simple main = defaultMain unexceptionalio-0.3.0/unexceptionalio.cabal0000644000000000000000000000214612643516457017320 0ustar0000000000000000name: unexceptionalio version: 0.3.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 library exposed-modules: UnexceptionalIO build-depends: base == 4.* source-repository head type: git location: git://github.com/singpolyma/unexceptionalio.git