Bump Haskeline and add exceptions as boot library

Haskeline now depends upon exceptions. See #16752.

2 files changed, 49 insertions, 16 deletions

diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index 824a822796..63356d6418 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -54,7 +54,7 @@ import GHC.Hs (ImportDecl, GhcPs, GhciLStmt, LHsDecl)
 import GHC.Hs.Utils
 import Util
 
-import Exception
+import Exception hiding (uninterruptibleMask, mask, catch)
 import Numeric
 import Data.Array
 import Data.IORef
@@ -65,7 +65,7 @@ import Control.Monad
 import Prelude hiding ((<>))
 
 import System.Console.Haskeline (CompletionFunc, InputT)
-import qualified System.Console.Haskeline as Haskeline
+import Control.Monad.Catch
 import Control.Monad.Trans.Class
 import Control.Monad.IO.Class
 import Data.Map.Strict (Map)
@@ -185,8 +185,8 @@ data CommandResult
      -- ^ Unterminated multiline command
    deriving Show
 
-cmdSuccess :: Haskeline.MonadException m => CommandResult -> m (Maybe Bool)
-cmdSuccess CommandComplete{ cmdResult = Left e } = liftIO $ throwIO e
+cmdSuccess :: MonadThrow m => CommandResult -> m (Maybe Bool)
+cmdSuccess CommandComplete{ cmdResult = Left e } = throwM e
 cmdSuccess CommandComplete{ cmdResult = Right r } = return r
 cmdSuccess CommandIncomplete = return $ Just True
 
@@ -320,19 +320,51 @@ instance ExceptionMonad GHCi where
                              in
                                 unGHCi (f g_restore) s
 
-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
-  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 MonadThrow Ghc where
+  throwM = liftIO . throwM
+
+instance MonadCatch Ghc where
+  catch = gcatch
+
+instance MonadMask Ghc where
+  mask f = Ghc $ \s ->
+    mask $ \io_restore ->
+      let g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
+      in unGhc (f g_restore) s
+  uninterruptibleMask f = Ghc $ \s ->
+    uninterruptibleMask $ \io_restore ->
+      let g_restore (Ghc m) = Ghc $ \s -> io_restore (m s)
+      in unGhc (f g_restore) s
+  generalBracket acquire release use = Ghc $ \s ->
+    generalBracket
+      (unGhc acquire s)
+      (\resource exitCase -> unGhc (release resource exitCase) s)
+      (\resource -> unGhc (use resource) s)
+
+instance MonadThrow GHCi where
+  throwM = liftIO . throwM
+
+instance MonadCatch GHCi where
+  catch = gcatch
+
+instance MonadMask GHCi where
+  mask f = GHCi $ \s ->
+    mask $ \io_restore ->
+      let g_restore (GHCi m) = GHCi $ \s -> io_restore (m s)
+      in unGHCi (f g_restore) s
+  uninterruptibleMask f = GHCi $ \s ->
+    uninterruptibleMask $ \io_restore ->
+      let g_restore (GHCi m) = GHCi $ \s -> io_restore (m s)
+      in unGHCi (f g_restore) s
+  generalBracket acquire release use = GHCi $ \s ->
+    generalBracket
+      (unGHCi acquire s)
+      (\resource exitCase -> unGHCi (release resource exitCase) s)
+      (\resource -> unGHCi (use resource) s)
 
 instance ExceptionMonad (InputT GHCi) where
-  gcatch = Haskeline.catch
-  gmask f = Haskeline.liftIOOp gmask (f . Haskeline.liftIOOp_)
+  gcatch = catch
+  gmask = mask
 
 isOptionSet :: GhciMonad m => GHCiOption -> m Bool
 isOptionSet opt
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 721df4ea62..bc10724677 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -61,7 +61,8 @@ Executable ghc
             deepseq        == 1.4.*,
             ghc-prim       >= 0.5.0 && < 0.7,
             ghci           == @ProjectVersionMunged@,
-            haskeline      == 0.7.*,
+            haskeline      == 0.8.*,
+            exceptions     == 0.10.*,
             time           >= 1.8 && < 1.10
         CPP-Options: -DHAVE_INTERNAL_INTERPRETER
         GHC-Options: -fno-warn-name-shadowing