[commit: packages/haskeline] ghc-head: Add 'catches' to MonadException. Patch from Håkan Thörngren. (eb0ff26)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haskeline

On branch  : ghc-head
Link       : http://git.haskell.org/?p=packages/haskeline.git;a=commit;h=eb0ff26a8bb7e270c67588ccdf884635c1c53077

>---------------------------------------------------------------

commit eb0ff26a8bb7e270c67588ccdf884635c1c53077
Author: Judah Jacobson <judah.jacobson at gmail.com>
Date:   Thu Aug 15 02:17:26 2013 +0000

    Add 'catches' to MonadException.  Patch from Håkan Thörngren.


>---------------------------------------------------------------

eb0ff26a8bb7e270c67588ccdf884635c1c53077
 System/Console/Haskeline/Backend/Posix.hsc |    2 +-
 System/Console/Haskeline/MonadException.hs |   14 ++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/System/Console/Haskeline/Backend/Posix.hsc b/System/Console/Haskeline/Backend/Posix.hsc
index 5da38e7..a028629 100644
--- a/System/Console/Haskeline/Backend/Posix.hsc
+++ b/System/Console/Haskeline/Backend/Posix.hsc
@@ -28,7 +28,7 @@ import Data.List
 import System.IO
 import System.Environment
 
-import System.Console.Haskeline.Monads
+import System.Console.Haskeline.Monads hiding (Handler)
 import System.Console.Haskeline.Key
 import System.Console.Haskeline.Term as Term
 import System.Console.Haskeline.Prefs
diff --git a/System/Console/Haskeline/MonadException.hs b/System/Console/Haskeline/MonadException.hs
index 0e83eec..31f1e1a 100644
--- a/System/Console/Haskeline/MonadException.hs
+++ b/System/Console/Haskeline/MonadException.hs
@@ -8,6 +8,8 @@ module System.Console.Haskeline.MonadException(
     -- * Generalizations of Control.Exception
     catch,
     handle,
+    catches,
+    Handler(..),
     finally,
     throwIO,
     throwTo,
@@ -102,6 +104,18 @@ catch act handler = controlIO $ \(RunIO run) -> E.catch
 handle :: (MonadException m, Exception e) => (e -> m a) -> m a -> m a
 handle = flip catch
  
+catches :: (MonadException m) => m a -> [Handler m a] -> m a
+catches act handlers = controlIO $ \(RunIO run) ->
+                           let catchesHandler handlers e = foldr tryHandler (E.throw e) handlers
+                                   where tryHandler (Handler handler) res =
+                                             case E.fromException e of
+                                               Just e' -> run $ handler e'
+                                               Nothing -> res
+                           in E.catch (run act) (catchesHandler handlers)
+
+data Handler m a = forall e . Exception e => Handler (e -> m a)
+
+
 bracket :: MonadException m => m a -> (a -> m b) -> (a -> m c) -> m c
 bracket before after thing 
     = controlIO $ \(RunIO run) -> E.bracket