Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/278bc1df5f52d3cb2cda49379268a400296e21f7 >--------------------------------------------------------------- commit 278bc1df5f52d3cb2cda49379268a400296e21f7 Author: Judah Jacobson <[email protected]> Date: Mon May 21 19:42:18 2012 -0700 Updates for haskeline-0.7's new MonadException API. >--------------------------------------------------------------- ghc/GhciMonad.hs | 20 ++++++++++++-------- ghc/InteractiveUI.hs | 6 +++--- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index fff5ca1..3dc69ee 100644 --- a/ghc/GhciMonad.hs +++ b/ghc/GhciMonad.hs @@ -217,18 +217,22 @@ instance ExceptionMonad GHCi where instance MonadIO GHCi where liftIO = MonadUtils.liftIO +instance Haskeline.MonadException Ghc where + controlIO f = Ghc $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let + run' = Haskeline.RunIO (fmap (Ghc . const) . run . flip unGhc s) + in fmap (flip unGhc s) $ f run' + instance Haskeline.MonadException GHCi where - catch = gcatch - block = gblock - unblock = gunblock - -- XXX when Haskeline's MonadException changes, we can drop our - -- deprecated block/unblock methods + controlIO f = GHCi $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let + run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s) + in fmap (flip unGHCi s) $ f run' instance ExceptionMonad (InputT GHCi) where gcatch = Haskeline.catch - gmask f = Haskeline.block (f Haskeline.unblock) -- slightly wrong - gblock = Haskeline.block - gunblock = Haskeline.unblock + gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_) + + gblock = Haskeline.liftIOOp_ gblock + gunblock = Haskeline.liftIOOp_ gunblock isOptionSet :: GHCiOption -> GHCi Bool isOptionSet opt diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs index 0688f2b..f29fa06 100644 --- a/ghc/InteractiveUI.hs +++ b/ghc/InteractiveUI.hs @@ -69,7 +69,7 @@ import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub, partition, sort, sortBy ) import Data.Maybe -import Exception hiding (catch, block, unblock) +import Exception hiding (catch) import Foreign.C import Foreign.Safe @@ -2889,8 +2889,8 @@ showException se = -- in an exception loop (eg. let a = error a in a) the ^C exception -- may never be delivered. Thanks to Marcin for pointing out the bug. -ghciHandle :: MonadException m => (SomeException -> m a) -> m a -> m a -ghciHandle h m = Haskeline.catch m $ \e -> unblock (h e) +ghciHandle :: ExceptionMonad m => (SomeException -> m a) -> m a -> m a +ghciHandle h m = gcatch m $ \e -> gunblock (h e) ghciTry :: GHCi a -> GHCi (Either SomeException a) ghciTry (GHCi m) = GHCi $ \s -> gtry (m s) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
