extensible-exceptions (empty) → 0.1.0.1
raw patch · 4 files changed
+491/−0 lines, 4 filesdep +basesetup-changed
Dependencies added: base
Files
- Control/Exception/Extensible.hs +382/−0
- LICENSE +83/−0
- Setup.hs +6/−0
- extensible-exceptions.cabal +20/−0
+ Control/Exception/Extensible.hs view
@@ -0,0 +1,382 @@++#if __GLASGOW_HASKELL__ >= 609+module Control.Exception.Extensible (module Control.Exception) where++import Control.Exception++#else+module Control.Exception.Extensible (+ Exception(..),+ SomeException(..),+ throwIO,+ throw,+ throwTo,+ catch,+ try,+ E.block,+ E.unblock,+ E.evaluate,+ bracket,+ onException,+ finally,+ E.ArithException(..),+ E.ArrayException(..),+ AssertionFailed(..),+ E.AsyncException(..),+ BlockedOnDeadMVar(..),+ BlockedIndefinitely(..),+ NestedAtomically(..),+ Deadlock(..),+ ErrorCall(..),+ ExitCode(..),+ E.IOException,+ NoMethodError(..),+ NonTermination(..),+ PatternMatchFail(..),+ RecConError(..),+ RecSelError(..),+ RecUpdError(..)+ ) where++import Prelude hiding (catch)+import Control.Concurrent hiding (throwTo)+import qualified Control.Exception as E+import Data.Dynamic+import Data.Typeable+import System.Exit++class (Typeable e, Show e) => Exception e where+ toException :: e -> SomeException+ fromException :: SomeException -> Maybe e++ toException = SomeException+ fromException (SomeException e) = cast e++data SomeException = forall e . Exception e => SomeException e+ deriving Typeable++instance Show SomeException where+ showsPrec p (SomeException e) = showsPrec p e++instance Exception SomeException where+ toException se = se+ fromException = Just++mkOldException :: Exception e => e -> E.Exception+mkOldException e = let e' = toException e+ in case fromException e' of+ Just e'' -> -- If the exception is actually a legacy exception+ -- then throw it directly so the legacy functions+ -- catch it as they expect+ e''+ Nothing -> -- Otherwise, throw it as a dynamic+ E.DynException (toDyn e')++throw :: Exception e => e -> a+throw e = E.throw (mkOldException e)++throwIO :: Exception e => e -> IO a+throwIO e = E.throwIO (mkOldException e)++throwTo :: Exception e => ThreadId -> e -> IO ()+throwTo tid e = E.throwTo tid (mkOldException e)++-- XXX Dyn+catch :: Exception e => IO a -> (e -> IO a) -> IO a+catch io poly_handler = io `E.catch` handler'+ where + -- First look for "new style" exceptions, which are thrown+ -- as E.DynException (SomeException e)++ -- needs scoped TVs: handler' :: E.Exception -> IO a + handler' e = case e of+ E.DynException dyn ->+ case fromDynamic dyn of+ Just se@(SomeException _) ->+ case fromException se of+ Just e' -> poly_handler e'+ Nothing -> E.throw e+ Nothing -> try_old e+ _ -> try_old e++ -- If it's a legacy exception (E.Exception or one of the+ -- types that make up E.Exception), check for a handler than+ -- can handle them:++ -- needs scoped TVs: try_old :: E.Exception -> IO a+ try_old e = case fromException (toException e) of+ Just e' -> poly_handler e'+ Nothing -> E.throw e+++bracket+ :: IO a -- ^ computation to run first (\"acquire resource\")+ -> (a -> IO b) -- ^ computation to run last (\"release resource\")+ -> (a -> IO c) -- ^ computation to run in-between+ -> IO c -- returns the value from the in-between computation+bracket before after thing =+ E.block (do+ a <- before+ r <- E.unblock (thing a) `onException` after a+ after a+ return r+ )++onException :: IO a -> IO b -> IO a+onException io what = io `catch` \e -> do what+ throw (e :: SomeException)++finally :: IO a -- ^ computation to run first+ -> IO b -- ^ computation to run afterward (even if an exception+ -- was raised)+ -> IO a -- returns the value from the first computation+a `finally` sequel =+ E.block (do+ r <- E.unblock a `onException` sequel+ sequel+ return r+ )++try :: Exception e => IO a -> IO (Either e a)+try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))++----------------------------------------------------------------------+-- Exception instance for the legacy Exception type++instance Exception E.Exception++----------------------------------------------------------------------+-- The new Exception types. These need to map to/from E.Exception so+-- that uses of legacy catch/throw functions work.++----++instance Exception E.ArithException where+ toException ae = toException (E.ArithException ae)+ fromException (SomeException e) = case cast e of+ Just (E.ArithException ae) ->+ Just ae+ _ -> Nothing+----++instance Exception E.ArrayException where+ toException ae = toException (E.ArrayException ae)+ fromException (SomeException e) = case cast e of+ Just (E.ArrayException ae) ->+ Just ae+ _ -> Nothing++----++data AssertionFailed = AssertionFailed String+ deriving Typeable++instance Exception AssertionFailed where+ toException (AssertionFailed str) = toException (E.AssertionFailed str)+ fromException (SomeException e) = case cast e of+ Just (E.AssertionFailed str) ->+ Just (AssertionFailed str)+ _ -> Nothing++instance Show AssertionFailed where+ showsPrec _ (AssertionFailed err) = showString err++-----++instance Exception E.AsyncException where+ toException ae = toException (E.AsyncException ae)+ fromException (SomeException e) = case cast e of+ Just (E.AsyncException ae) ->+ Just ae+ _ -> Nothing++----++data BlockedOnDeadMVar = BlockedOnDeadMVar+ deriving Typeable++instance Exception BlockedOnDeadMVar where+ toException BlockedOnDeadMVar = toException (E.BlockedOnDeadMVar)+ fromException (SomeException e) = case cast e of+ Just E.BlockedOnDeadMVar ->+ Just BlockedOnDeadMVar+ _ -> Nothing+instance Show BlockedOnDeadMVar where+ showsPrec n BlockedOnDeadMVar = showsPrec n E.BlockedOnDeadMVar++----++data BlockedIndefinitely = BlockedIndefinitely+ deriving Typeable++instance Exception BlockedIndefinitely where+ toException BlockedIndefinitely = toException E.BlockedIndefinitely+ fromException (SomeException e) = case cast e of+ Just E.BlockedIndefinitely ->+ Just BlockedIndefinitely+ _ -> Nothing++instance Show BlockedIndefinitely where+ showsPrec n BlockedIndefinitely = showsPrec n E.BlockedIndefinitely++----++data NestedAtomically = NestedAtomically+ deriving Typeable++instance Exception NestedAtomically where+ toException NestedAtomically = toException E.NestedAtomically+ fromException (SomeException e) = case cast e of+ Just E.NestedAtomically ->+ Just NestedAtomically+ _ -> Nothing++instance Show NestedAtomically where+ showsPrec n NestedAtomically = showsPrec n E.NestedAtomically++----++data Deadlock = Deadlock+ deriving Typeable++instance Exception Deadlock where+ toException Deadlock = toException E.Deadlock+ fromException (SomeException e) = case cast e of+ Just E.Deadlock ->+ Just Deadlock+ _ -> Nothing++instance Show Deadlock where+ showsPrec n Deadlock = showsPrec n E.Deadlock++-----++data ErrorCall = ErrorCall String+ deriving Typeable++instance Exception ErrorCall where+ toException (ErrorCall str) = toException (E.ErrorCall str)+ fromException (SomeException e) = case cast e of+ Just (E.ErrorCall str) ->+ Just (ErrorCall str)+ _ -> Nothing++instance Show ErrorCall where+ showsPrec _ (ErrorCall err) = showString err++-----++instance Typeable ExitCode where+ typeOf _ = mkTyConApp (mkTyCon "ExitCode") []++instance Exception ExitCode where+ toException ee = toException (E.ExitException ee)+ fromException (SomeException e) = case cast e of+ Just (E.ExitException ee) ->+ Just ee+ _ -> Nothing+-----++instance Exception E.IOException where+ toException ioe = toException (E.IOException ioe)+ fromException (SomeException e) = case cast e of+ Just (E.IOException ioe) ->+ Just ioe+ _ -> Nothing++----++data NoMethodError = NoMethodError String+ deriving Typeable++instance Exception NoMethodError where+ toException (NoMethodError str) = toException (E.NoMethodError str)+ fromException (SomeException e) = case cast e of+ Just (E.NoMethodError str) ->+ Just (NoMethodError str)+ _ -> Nothing++instance Show NoMethodError where+ showsPrec _ (NoMethodError str) = showString str++----++data NonTermination = NonTermination+ deriving Typeable++instance Exception NonTermination where+ toException NonTermination = toException E.NonTermination+ fromException (SomeException e) = case cast e of+ Just E.NonTermination ->+ Just NonTermination+ _ -> Nothing++instance Show NonTermination where+ showsPrec n NonTermination = showsPrec n E.NonTermination++----++data PatternMatchFail = PatternMatchFail String+ deriving Typeable++instance Exception PatternMatchFail where+ toException (PatternMatchFail str) = toException (E.PatternMatchFail str)+ fromException (SomeException e) = case cast e of+ Just (E.PatternMatchFail str) ->+ Just (PatternMatchFail str)+ _ -> Nothing++instance Show PatternMatchFail where+ showsPrec _ (PatternMatchFail str) = showString str+ ++----++data RecConError = RecConError String+ deriving Typeable++instance Exception RecConError where+ toException (RecConError str) = toException (E.RecConError str)+ fromException (SomeException e) = case cast e of+ Just (E.RecConError str) ->+ Just (RecConError str)+ _ -> Nothing++instance Show RecConError where+ showsPrec _ (RecConError str) = showString str+ +++----++data RecSelError = RecSelError String+ deriving Typeable++instance Exception RecSelError where+ toException (RecSelError str) = toException (E.RecSelError str)+ fromException (SomeException e) = case cast e of+ Just (E.RecSelError str) ->+ Just (RecSelError str)+ _ -> Nothing++instance Show RecSelError where+ showsPrec _ (RecSelError str) = showString str++----++data RecUpdError = RecUpdError String+ deriving Typeable++instance Exception RecUpdError where+ toException (RecUpdError str) = toException (E.RecUpdError str)+ fromException (SomeException e) = case cast e of+ Just (E.RecUpdError str) ->+ Just (RecUpdError str)+ _ -> Nothing++instance Show RecUpdError where+ showsPrec _ (RecUpdError str) = showString str+++#endif+
+ LICENSE view
@@ -0,0 +1,83 @@+This library (libraries/extensible-exceptions) is derived from code from several+sources: ++ * Code from the GHC project which is largely (c) The University of+ Glasgow, and distributable under a BSD-style license (see below),++ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+ and freely redistributable (but see the full license for+ restrictions).++ * Code from the Haskell Foreign Function Interface specification,+ which is (c) Manuel M. T. Chakravarty and freely redistributable+ (but see the full license for restrictions).++The full text of these licenses is reproduced below. All of the+licenses are BSD-style or compatible.++-----------------------------------------------------------------------------++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow. +All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.+ +- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.+ +- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission. ++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.++-----------------------------------------------------------------------------++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++ Copyright (c) 2002 Simon Peyton Jones++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Language.++-----------------------------------------------------------------------------++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++ Copyright (c) 2002 Manuel M. T. Chakravarty++ The authors intend this Report to belong to the entire Haskell+ community, and so we grant permission to copy and distribute it for+ any purpose, provided that it is reproduced in its entirety,+ including this Notice. Modified versions of this Report may also be+ copied and distributed for any purpose, provided that the modified+ version is clearly presented as such, and that it does not claim to+ be a definition of the Haskell 98 Foreign Function Interface.++-----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ extensible-exceptions.cabal view
@@ -0,0 +1,20 @@+name: extensible-exceptions+version: 0.1.0.1+license: BSD3+license-file: LICENSE+maintainer: libraries@haskell.org+synopsis: Extensible exceptions+description:+ Extensible exceptions for old implementations (e.g. GHC < 6.10).+ This package is being lazily implemented, i.e. not all the new+ exception types or all the exception functions are necessarily+ implemented yet.+cabal-version: >=1.2+build-type: Simple++Library {+ build-depends: base+ exposed-modules:+ Control.Exception.Extensible+ extensions: CPP, ExistentialQuantification, DeriveDataTypeable+}