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 /ghc/GhciMonad.hs | |
| parent | d0d0c36a99c588f47d530eae0e505e5a9d317339 (diff) | |
| download | haskell-278bc1df5f52d3cb2cda49379268a400296e21f7.tar.gz | |
Updates for haskeline-0.7's new MonadException API.
Diffstat (limited to 'ghc/GhciMonad.hs')
| -rw-r--r-- | ghc/GhciMonad.hs | 20 |
1 files changed, 12 insertions, 8 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 |