Commit 278bc1df authored by judah's avatar judah Committed by Ian Lynagh
Browse files

Updates for haskeline-0.7's new MonadException API.

parent d0d0c36a
...@@ -217,18 +217,22 @@ instance ExceptionMonad GHCi where ...@@ -217,18 +217,22 @@ instance ExceptionMonad GHCi where
instance MonadIO GHCi where instance MonadIO GHCi where
liftIO = MonadUtils.liftIO 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 instance Haskeline.MonadException GHCi where
catch = gcatch controlIO f = GHCi $ \s -> Haskeline.controlIO $ \(Haskeline.RunIO run) -> let
block = gblock run' = Haskeline.RunIO (fmap (GHCi . const) . run . flip unGHCi s)
unblock = gunblock in fmap (flip unGHCi s) $ f run'
-- XXX when Haskeline's MonadException changes, we can drop our
-- deprecated block/unblock methods
instance ExceptionMonad (InputT GHCi) where instance ExceptionMonad (InputT GHCi) where
gcatch = Haskeline.catch gcatch = Haskeline.catch
gmask f = Haskeline.block (f Haskeline.unblock) -- slightly wrong gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
gblock = Haskeline.block
gunblock = Haskeline.unblock gblock = Haskeline.liftIOOp_ gblock
gunblock = Haskeline.liftIOOp_ gunblock
isOptionSet :: GHCiOption -> GHCi Bool isOptionSet :: GHCiOption -> GHCi Bool
isOptionSet opt isOptionSet opt
......
...@@ -69,7 +69,7 @@ import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub, ...@@ -69,7 +69,7 @@ import Data.List ( find, group, intercalate, intersperse, isPrefixOf, nub,
partition, sort, sortBy ) partition, sort, sortBy )
import Data.Maybe import Data.Maybe
import Exception hiding (catch, block, unblock) import Exception hiding (catch)
import Foreign.C import Foreign.C
import Foreign.Safe import Foreign.Safe
...@@ -2889,8 +2889,8 @@ showException se = ...@@ -2889,8 +2889,8 @@ showException se =
-- in an exception loop (eg. let a = error a in a) the ^C exception -- 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. -- may never be delivered. Thanks to Marcin for pointing out the bug.
ghciHandle :: MonadException m => (SomeException -> m a) -> m a -> m a ghciHandle :: ExceptionMonad m => (SomeException -> m a) -> m a -> m a
ghciHandle h m = Haskeline.catch m $ \e -> unblock (h e) ghciHandle h m = gcatch m $ \e -> gunblock (h e)
ghciTry :: GHCi a -> GHCi (Either SomeException a) ghciTry :: GHCi a -> GHCi (Either SomeException a)
ghciTry (GHCi m) = GHCi $ \s -> gtry (m s) ghciTry (GHCi m) = GHCi $ \s -> gtry (m s)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment