Depend on the exceptions package. (haskell#97)

Removes `System.Console.Haskeline.MonadException`; now
we use class constraints from `Control.Monad.Catch`.

System/Console/Haskeline.hs

@@ -73,8 +73,7 @@ module System.Console.Haskeline(
                     Interrupt(..),
                     handleInterrupt,
                     -- * Additional submodules
-                    module System.Console.Haskeline.Completion,
-                    module System.Console.Haskeline.MonadException)
+                    module System.Console.Haskeline.Completion)
                      where
 
 import System.Console.Haskeline.LineState
@@ -84,15 +83,15 @@ import System.Console.Haskeline.Emacs
 import System.Console.Haskeline.Prefs
 import System.Console.Haskeline.History
 import System.Console.Haskeline.Monads
-import System.Console.Haskeline.MonadException
 import System.Console.Haskeline.InputT
 import System.Console.Haskeline.Completion
 import System.Console.Haskeline.Term
 import System.Console.Haskeline.Key
 import System.Console.Haskeline.RunCommand
 
-import System.IO
+import Control.Monad.Catch (MonadMask, handle)
 import Data.Char (isSpace, isPrint)
+import System.IO
 
 
 -- | A useful default.  In particular:
@@ -141,7 +140,8 @@ an @EOF@ was encountered before any characters were read.
 If @'autoAddHistory' == 'True'@ and the line input is nonblank (i.e., is not all
 spaces), it will be automatically added to the history.
 -}
-getInputLine :: MonadException m => String -- ^ The input prompt
+getInputLine :: (MonadIO m, MonadMask m)
+            => String -- ^ The input prompt
                             -> InputT m (Maybe String)
 getInputLine = promptedInput (getInputCmdLine emptyIM) $ runMaybeT . getLocaleLine
 
@@ -160,7 +160,7 @@ Some examples of calling of this function are:
 > getInputLineWithInitial "prompt> " ("left", "") -- The cursor starts at the end of the line.
 > getInputLineWithInitial "prompt> " ("left ", "right") -- The cursor starts before the second word.
  -}
-getInputLineWithInitial :: MonadException m
+getInputLineWithInitial :: (MonadIO m, MonadMask m)
                             => String           -- ^ The input prompt
                             -> (String, String) -- ^ The initial value left and right of the cursor
                             -> InputT m (Maybe String)
@@ -169,7 +169,7 @@ getInputLineWithInitial prompt (left,right) = promptedInput (getInputCmdLine ini
   where
     initialIM = insertString left $ moveToStart $ insertString right $ emptyIM
 
-getInputCmdLine :: MonadException m => InsertMode -> TermOps -> String -> InputT m (Maybe String)
+getInputCmdLine :: (MonadIO m, MonadMask m) => InsertMode -> TermOps -> String -> InputT m (Maybe String)
 getInputCmdLine initialIM tops prefix = do
     emode <- InputT $ asks editMode
     result <- runInputCmdT tops $ case emode of
@@ -202,7 +202,7 @@ for a newline.
 When using file-style interaction, a newline will be read if it is immediately
 available after the input character.
 -}
-getInputChar :: MonadException m => String -- ^ The input prompt
+getInputChar :: (MonadIO m, MonadMask m) => String -- ^ The input prompt
                     -> InputT m (Maybe Char)
 getInputChar = promptedInput getInputCmdChar $ \fops -> do
                         c <- getPrintableChar fops
@@ -216,7 +216,7 @@ getPrintableChar fops = do
         Just False -> getPrintableChar fops
         _ -> return c
 
-getInputCmdChar :: MonadException m => TermOps -> String -> InputT m (Maybe Char)
+getInputCmdChar :: (MonadIO m, MonadMask m) => TermOps -> String -> InputT m (Maybe Char)
 getInputCmdChar tops prefix = runInputCmdT tops
         $ runCommandLoop tops prefix acceptOneChar emptyIM
 
@@ -241,7 +241,7 @@ earlier than 2.5, 'getPassword' will incorrectly echo back input on MinTTY
 consoles (such as Cygwin or MSYS).
 -}
 
-getPassword :: MonadException m => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@
+getPassword :: (MonadIO m, MonadMask m) => Maybe Char -- ^ A masking character; e.g., @Just \'*\'@
                             -> String -> InputT m (Maybe String)
 getPassword x = promptedInput
                     (\tops prefix -> runInputCmdT tops
@@ -311,21 +311,21 @@ may immediately terminate the program after the second time that the user presse
 Ctrl-C.
 
 -}
-withInterrupt :: MonadException m => InputT m a -> InputT m a
+withInterrupt :: (MonadIO m, MonadMask m) => InputT m a -> InputT m a
 withInterrupt act = do
     rterm <- InputT ask
-    liftIOOp_ (wrapInterrupt rterm) act
+    wrapInterrupt rterm act
 
 -- | Catch and handle an exception of type 'Interrupt'.
 --
 -- > handleInterrupt f = handle $ \Interrupt -> f
-handleInterrupt :: MonadException m => m a -> m a -> m a
+handleInterrupt :: MonadMask m => m a -> m a -> m a
 handleInterrupt f = handle $ \Interrupt -> f
 
 {- | Return a printing function, which in terminal-style interactions is
 thread-safe and may be run concurrently with user input without affecting the
 prompt. -}
-getExternalPrint :: MonadException m => InputT m (String -> IO ())
+getExternalPrint :: MonadIO m => InputT m (String -> IO ())
 getExternalPrint = do
     rterm <- InputT ask
     return $ case termOps rterm of

System/Console/Haskeline/Backend/DumbTerm.hs

@@ -9,6 +9,7 @@ import System.Console.Haskeline.Monads as Monads
 import System.IO
 import Control.Applicative(Applicative)
 import Control.Monad(liftM)
+import Control.Monad.Catch
 
 -- TODO: 
 ---- Put "<" and ">" at end of term if scrolls off.
@@ -21,7 +22,8 @@ initWindow :: Window
 initWindow = Window {pos=0}
 
 newtype DumbTerm m a = DumbTerm {unDumbTerm :: StateT Window (PosixT m) a}
-                deriving (Functor, Applicative, Monad, MonadIO, MonadException,
+                deriving (Functor, Applicative, Monad, MonadIO,
+                          MonadThrow, MonadCatch, MonadMask,
                           MonadState Window, MonadReader Handles)
 
 type DumbTermM a = forall m . (MonadIO m, MonadReader Layout m) => DumbTerm m a
@@ -35,7 +37,7 @@ evalDumb = EvalTerm (evalStateT' initWindow . unDumbTerm) (DumbTerm . lift)
 runDumbTerm :: Handles -> MaybeT IO RunTerm
 runDumbTerm h = liftIO $ posixRunTerm h (posixLayouts h) [] id evalDumb
 
-instance (MonadException m, MonadReader Layout m) => Term (DumbTerm m) where
+instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (DumbTerm m) where
     reposition _ s = refitLine s
     drawLineDiff = drawLineDiff'
 

System/Console/Haskeline/Backend/Posix.hsc

@@ -17,7 +17,9 @@ import Foreign
 import Foreign.C.Types
 import qualified Data.Map as Map
 import System.Posix.Terminal hiding (Interrupt)
+import Control.Exception (throwTo)
 import Control.Monad
+import Control.Monad.Catch (MonadMask, handle, finally)
 import Control.Concurrent.STM
 import Control.Concurrent hiding (throwTo)
 import Data.Maybe (catMaybes)
@@ -27,7 +29,7 @@ import Data.List
 import System.IO
 import System.Environment
 
-import System.Console.Haskeline.Monads hiding (Handler)
+import System.Console.Haskeline.Monads
 import System.Console.Haskeline.Key
 import System.Console.Haskeline.Term as Term
 import System.Console.Haskeline.Prefs
@@ -201,26 +203,26 @@ lookupChars (TreeMap tm) (c:cs) = case Map.lookup c tm of
 
 -----------------------------
 
-withPosixGetEvent :: (MonadException m, MonadReader Prefs m)
+withPosixGetEvent :: (MonadIO m, MonadMask m, MonadReader Prefs m)
         => TChan Event -> Handles -> [(String,Key)]
                 -> (m Event -> m a) -> m a
 withPosixGetEvent eventChan h termKeys f = wrapTerminalOps h $ do
     baseMap <- getKeySequences (ehIn h) termKeys
     withWindowHandler eventChan
         $ f $ liftIO $ getEvent (ehIn h) baseMap eventChan
 
-withWindowHandler :: MonadException m => TChan Event -> m a -> m a
+withWindowHandler :: (MonadIO m, MonadMask m) => TChan Event -> m a -> m a
 withWindowHandler eventChan = withHandler windowChange $
     Catch $ atomically $ writeTChan eventChan WindowResize
 
-withSigIntHandler :: MonadException m => m a -> m a
+withSigIntHandler :: (MonadIO m, MonadMask m) => m a -> m a
 withSigIntHandler f = do
     tid <- liftIO myThreadId
     withHandler keyboardSignal
             (Catch (throwTo tid Interrupt))
             f
 
-withHandler :: MonadException m => Signal -> Handler -> m a -> m a
+withHandler :: (MonadIO m, MonadMask m) => Signal -> Handler -> m a -> m a
 withHandler signal handler f = do
     old_handler <- liftIO $ installHandler signal handler Nothing
     f `finally` liftIO (installHandler signal old_handler Nothing)
@@ -279,8 +281,8 @@ posixRunTerm ::
     Handles
     -> [IO (Maybe Layout)]
     -> [(String,Key)]
-    -> (forall m b . MonadException m => m b -> m b)
-    -> (forall m . (MonadException m, CommandMonad m) => EvalTerm (PosixT m))
+    -> (forall m b . (MonadIO m, MonadMask m) => m b -> m b)
+    -> (forall m . (MonadMask m, CommandMonad m) => EvalTerm (PosixT m))
     -> IO RunTerm
 posixRunTerm hs layoutGetters keys wrapGetEvent evalBackend = do
     ch <- newTChanIO
@@ -336,16 +338,16 @@ posixFileRunTerm hs = do
 -- NOTE: If we set stdout to NoBuffering, there can be a flicker effect when many
 -- characters are printed at once.  We'll keep it buffered here, and let the Draw
 -- monad manually flush outputs that don't print a newline.
-wrapTerminalOps :: MonadException m => Handles -> m a -> m a
+wrapTerminalOps :: (MonadIO m, MonadMask m) => Handles -> m a -> m a
 wrapTerminalOps hs =
     bracketSet (hGetBuffering h_in) (hSetBuffering h_in) NoBuffering
     -- TODO: block buffering?  Certain \r and \n's are causing flicker...
     -- - moving to the right
     -- - breaking line after offset widechar?
     . bracketSet (hGetBuffering h_out) (hSetBuffering h_out) LineBuffering
     . bracketSet (hGetEcho h_in) (hSetEcho h_in) False
-    . liftIOOp_ (withCodingMode $ hIn hs)
-    . liftIOOp_ (withCodingMode $ hOut hs)
+    . withCodingMode (hIn hs)
+    . withCodingMode (hOut hs)
   where
     h_in = ehIn hs
     h_out = ehOut hs

System/Console/Haskeline/Backend/Posix/Encoder.hs

@@ -13,6 +13,7 @@ module System.Console.Haskeline.Backend.Posix.Encoder (
         openInCodingMode,
         ) where
 
+import Control.Monad.Catch (MonadMask, bracket)
 import System.IO
 import System.Console.Haskeline.Monads
 
@@ -41,13 +42,13 @@ externalHandle = ExternalHandle OtherMode
 
 -- | Use to ensure that an external handle is in the correct mode
 -- for the duration of the given action.
-withCodingMode :: ExternalHandle -> IO a -> IO a
+withCodingMode :: (MonadIO m, MonadMask m) => ExternalHandle -> m a -> m a
 withCodingMode ExternalHandle {externalMode=CodingMode} act = act
 withCodingMode (ExternalHandle OtherMode h) act = do
     bracket (liftIO $ hGetEncoding h)
             (liftIO . hSetBinOrEncoding h)
             $ const $ do
-                hSetEncoding h haskelineEncoding
+                liftIO $ hSetEncoding h haskelineEncoding
                 act
 
 hSetBinOrEncoding :: Handle -> Maybe TextEncoding -> IO ()

System/Console/Haskeline/Backend/Terminfo.hs

@@ -1,4 +1,4 @@
-#if __GLASGOW_HASKELL__ <= 802
+#if __GLASGOW_HASKELL__ < 802
 {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 #endif
 module System.Console.Haskeline.Backend.Terminfo(
@@ -9,6 +9,7 @@ module System.Console.Haskeline.Backend.Terminfo(
 
 import System.Console.Terminfo
 import Control.Monad
+import Control.Monad.Catch
 import Data.List(foldl')
 import System.IO
 import qualified Control.Exception as Exception
@@ -105,7 +106,8 @@ newtype Draw m a = Draw {unDraw :: (ReaderT Actions
                                     (StateT TermRows
                                     (StateT TermPos
                                     (PosixT m))))) a}
-    deriving (Functor, Applicative, Monad, MonadIO, MonadException,
+    deriving (Functor, Applicative, Monad, MonadIO,
+              MonadMask, MonadThrow, MonadCatch,
               MonadReader Actions, MonadReader Terminal, MonadState TermPos,
               MonadState TermRows, MonadReader Handles)
 
@@ -136,7 +138,7 @@ runTerminfoDraw h = do
                 (evalDraw term actions)
 
 -- If the keypad on/off capabilities are defined, wrap the computation with them.
-wrapKeypad :: MonadException m => Handle -> Terminal -> m a -> m a
+wrapKeypad :: (MonadIO m, MonadMask m) => Handle -> Terminal -> m a -> m a
 wrapKeypad h term f = (maybeOutput keypadOn >> f)
                             `finally` maybeOutput keypadOff
   where
@@ -349,7 +351,7 @@ repositionT _ s = do
     put initTermRows
     drawLineDiffT ([],[]) s
 
-instance (MonadException m, MonadReader Layout m) => Term (Draw m) where
+instance (MonadIO m, MonadMask m, MonadReader Layout m) => Term (Draw m) where
     drawLineDiff xs ys = runActionT $ drawLineDiffT xs ys
     reposition layout lc = runActionT $ repositionT layout lc
 

System/Console/Haskeline/Backend/Win32.hsc

@@ -15,10 +15,18 @@ import Control.Concurrent.STM
 import Control.Concurrent hiding (throwTo)
 import Data.Char(isPrint)
 import Data.Maybe(mapMaybe)
+import Control.Exception (IOException, throwTo)
 import Control.Monad
+import Control.Monad.Catch
+    ( MonadThrow
+    , MonadCatch
+    , MonadMask
+    , bracket
+    , handle
+    )
 
 import System.Console.Haskeline.Key
-import System.Console.Haskeline.Monads hiding (Handler)
+import System.Console.Haskeline.Monads
 import System.Console.Haskeline.LineState
 import System.Console.Haskeline.Term
 import System.Console.Haskeline.Backend.WCWidth
@@ -239,7 +247,7 @@ foreign import WINDOWS_CCONV "windows.h GetConsoleMode" c_GetConsoleMode
 foreign import WINDOWS_CCONV "windows.h SetConsoleMode" c_SetConsoleMode
     :: HANDLE -> DWORD -> IO Bool
 
-withWindowMode :: MonadException m => Handles -> m a -> m a
+withWindowMode :: (MonadIO m, MonadMask m) => Handles -> m a -> m a
 withWindowMode hs f = do
     let h = hIn hs
     bracket (getConsoleMode h) (setConsoleMode h)
@@ -259,7 +267,8 @@ closeHandles :: Handles -> IO ()
 closeHandles hs = closeHandle (hIn hs) >> closeHandle (hOut hs)
 
 newtype Draw m a = Draw {runDraw :: ReaderT Handles m a}
-    deriving (Functor, Applicative, Monad, MonadIO, MonadException, MonadReader Handles)
+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Handles,
+              MonadThrow, MonadCatch, MonadMask)
 
 type DrawM a = forall m . (MonadIO m, MonadReader Layout m) => Draw m a
 
@@ -345,7 +354,7 @@ movePosLeft str = do
 crlf :: String
 crlf = "\r\n"
 
-instance (MonadException m, MonadReader Layout m) => Term (Draw m) where
+instance (MonadMask m, MonadIO m, MonadReader Layout m) => Term (Draw m) where
     drawLineDiff (xs1,ys1) (xs2,ys2) = let
         fixEsc = filter ((/= '\ESC') . baseChar)
         in drawLineDiffWin (fixEsc xs1, fixEsc ys1) (fixEsc xs2, fixEsc ys2)
@@ -391,7 +400,7 @@ win32Term = do
           closeHandles hs
       }
 
-win32WithEvent :: MonadException m => Handles -> TChan Event
+win32WithEvent :: MonadIO m => Handles -> TChan Event
                                         -> (m Event -> m a) -> m a
 win32WithEvent h eventChan f = f $ liftIO $ getEvent (hIn h) eventChan
 
@@ -437,7 +446,7 @@ foreign import WINDOWS_CCONV "windows.h SetConsoleCtrlHandler" c_SetConsoleCtrlH
     :: FunPtr Handler -> BOOL -> IO BOOL
 
 -- sets the tv to True when ctrl-c is pressed.
-withCtrlCHandler :: MonadException m => m a -> m a
+withCtrlCHandler :: (MonadMask m, MonadIO m) => m a -> m a
 withCtrlCHandler f = bracket (liftIO $ do
                                     tid <- myThreadId
                                     fp <- wrapHandler (handler tid)

System/Console/Haskeline/Backend/Win32/Echo.hs

@@ -4,9 +4,9 @@ module System.Console.Haskeline.Backend.Win32.Echo (hWithoutInputEcho) where
 
 import Control.Exception (throw)
 import Control.Monad (void)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Catch (MonadMask, bracket)
+import Control.Monad.IO.Class (MonadIO(..))
 
-import System.Console.Haskeline.MonadException (MonadException, bracket)
 import System.Exit (ExitCode(..))
 import System.IO (Handle, hGetContents, hGetEcho, hSetEcho)
 import System.Process (StdStream(..), createProcess, shell,
@@ -67,7 +67,7 @@ hSetInputEchoSTTY input = void . hSttyRaw input
 --            ('liftIO' . 'hSetInputEchoState' input)
 --            (const action)
 -- @
-hBracketInputEcho :: MonadException m => Handle -> m a -> m a
+hBracketInputEcho :: (MonadIO m, MonadMask m) => Handle -> m a -> m a
 hBracketInputEcho input action =
   bracket (liftIO $ hGetInputEchoState input)
           (liftIO . hSetInputEchoState input)
@@ -76,7 +76,7 @@ hBracketInputEcho input action =
 -- | Perform a computation with the handle's input echoing disabled. Before
 -- running the computation, the handle's input 'EchoState' is saved, and the
 -- saved 'EchoState' is restored after the computation finishes.
-hWithoutInputEcho :: MonadException m => Handle -> m a -> m a
+hWithoutInputEcho :: (MonadIO m, MonadMask m) => Handle -> m a -> m a
 hWithoutInputEcho input action = do
   echo_off <- liftIO $ hEchoOff input
   hBracketInputEcho input

System/Console/Haskeline/Command/History.hs

@@ -9,6 +9,7 @@ import Data.List
 import Data.Maybe(fromMaybe)
 import System.Console.Haskeline.History
 import Data.IORef
+import Control.Monad.Catch
 
 data HistLog = HistLog {pastHistory, futureHistory :: [[Grapheme]]}
                     deriving Show
@@ -27,7 +28,7 @@ histLog :: History -> HistLog
 histLog hist = HistLog {pastHistory = map stringToGraphemes $ historyLines hist,
                         futureHistory = []}
 
-runHistoryFromFile :: MonadException m => Maybe FilePath -> Maybe Int
+runHistoryFromFile :: (MonadIO m, MonadMask m) => Maybe FilePath -> Maybe Int
                             -> ReaderT (IORef History) m a -> m a
 runHistoryFromFile Nothing _ f = do
     historyRef <- liftIO $ newIORef emptyHistory