diff options
| author | Judah Jacobson <judah.jacobson@gmail.com> | 2012-05-21 19:42:18 -0700 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2012-05-26 18:50:39 +0100 |
| commit | 278bc1df5f52d3cb2cda49379268a400296e21f7 (patch) | |
| tree | c92b6356959283dafbcb22dacf67139a37bf49ed | |
| parent | d0d0c36a99c588f47d530eae0e505e5a9d317339 (diff) | |
| download | haskell-278bc1df5f52d3cb2cda49379268a400296e21f7.tar.gz | |
Updates for haskeline-0.7's new MonadException API.
| -rw-r--r-- | ghc/GhciMonad.hs | 20 | ||||
| -rw-r--r-- | ghc/InteractiveUI.hs | 6 |
2 files changed, 15 insertions, 11 deletions
diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs index fff5ca15aa..3dc69eeab2 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 0688f2b6b7..f29fa06f2b 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) |