Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline On branch : master
http://hackage.haskell.org/trac/ghc/changeset/cd93b6794610490f613096819729f2cee29773c5 >--------------------------------------------------------------- commit cd93b6794610490f613096819729f2cee29773c5 Author: Judah Jacobson <[email protected]> Date: Mon Feb 20 00:14:09 2012 +0000 Remove the wrap/handleInterrupt functions. GHC has provided ctrl-c handling since ghc-6.10. So that functionality is now redundant. >--------------------------------------------------------------- System/Console/Haskeline.hs | 32 ---------------------------- System/Console/Haskeline/Backend/Posix.hsc | 10 +------- System/Console/Haskeline/Backend/Win32.hsc | 26 ---------------------- System/Console/Haskeline/Term.hs | 7 ------ examples/Test.hs | 5 ++- 5 files changed, 4 insertions(+), 76 deletions(-) diff --git a/System/Console/Haskeline.hs b/System/Console/Haskeline.hs index c4d6b91..419d91a 100644 --- a/System/Console/Haskeline.hs +++ b/System/Console/Haskeline.hs @@ -61,11 +61,6 @@ module System.Console.Haskeline( defaultPrefs, runInputTWithPrefs, runInputTBehaviorWithPrefs, - -- * Ctrl-C handling - -- $ctrlc - Interrupt(..), - withInterrupt, - handleInterrupt, module System.Console.Haskeline.Completion, module System.Console.Haskeline.MonadException) where @@ -272,30 +267,3 @@ promptedInput doTerm doFile prompt = do let (lastLine,rest) = break (`elem` "\r\n") $ reverse prompt outputStr $ reverse rest doTerm tops $ reverse lastLine - ------------- --- Interrupt - -{- $ctrlc -The following functions provide portable handling of Ctrl-C events. - -These functions are not necessary on GHC version 6.10 or later, which -processes Ctrl-C events as exceptions by default. --} - --- | If Ctrl-C is pressed during the given computation, throw an exception of type --- 'Interrupt'. -withInterrupt :: MonadException m => InputT m a -> InputT m a -withInterrupt f = do - rterm <- ask - wrapInterrupt rterm f - --- | Catch and handle an exception of type 'Interrupt'. -handleInterrupt :: MonadException m => m a - -- ^ Handler to run if Ctrl-C is pressed - -> m a -- ^ Computation to run - -> m a -handleInterrupt f = handleDyn $ \Interrupt -> f - - - diff --git a/System/Console/Haskeline/Backend/Posix.hsc b/System/Console/Haskeline/Backend/Posix.hsc index 65c69d8..27e24cc 100644 --- a/System/Console/Haskeline/Backend/Posix.hsc +++ b/System/Console/Haskeline/Backend/Posix.hsc @@ -17,7 +17,7 @@ module System.Console.Haskeline.Backend.Posix ( import Foreign import Foreign.C.Types import qualified Data.Map as Map -import System.Posix.Terminal hiding (Interrupt) +import System.Posix.Terminal import Control.Monad import Control.Concurrent hiding (throwTo) import Data.Maybe (catMaybes) @@ -219,13 +219,6 @@ withWindowHandler :: MonadException m => Chan Event -> m a -> m a withWindowHandler eventChan = withHandler windowChange $ Catch $ writeChan eventChan WindowResize -withSigIntHandler :: MonadException 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 signal handler f = do old_handler <- liftIO $ installHandler signal handler Nothing @@ -342,7 +335,6 @@ fileRunTerm h_in = do decoder' <- openPartialDecoder codeset return RunTerm {putStrOut = encoder >=> putTerm h_out, closeTerm = setLocale oldLocale >> return (), - wrapInterrupt = withSigIntHandler, encodeForTerm = encoder, decodeForTerm = decoder, termOps = Right FileOps { diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc index d66a805..445177f 100644 --- a/System/Console/Haskeline/Backend/Win32.hsc +++ b/System/Console/Haskeline/Backend/Win32.hsc @@ -381,7 +381,6 @@ fileRunTerm h_in = do putStrOut = putter, encodeForTerm = unicodeToCodePage cp, decodeForTerm = codePageToUnicode cp, - wrapInterrupt = withCtrlCHandler, termOps = Right FileOps { inputHandle = h_in, getLocaleChar = getMultiByteChar cp h_in, @@ -407,31 +406,6 @@ putOut = do -type Handler = DWORD -> IO BOOL - -foreign import ccall "wrapper" wrapHandler :: Handler -> IO (FunPtr Handler) - -foreign import stdcall "windows.h SetConsoleCtrlHandler" c_SetConsoleCtrlHandler - :: FunPtr Handler -> BOOL -> IO BOOL - --- sets the tv to True when ctrl-c is pressed. -withCtrlCHandler :: MonadException m => m a -> m a -withCtrlCHandler f = bracket (liftIO $ do - tid <- myThreadId - fp <- wrapHandler (handler tid) - -- don't fail if we can't set the ctrl-c handler - -- for example, we might not be attached to a console? - _ <- c_SetConsoleCtrlHandler fp True - return fp) - (\fp -> liftIO $ c_SetConsoleCtrlHandler fp False) - (const f) - where - handler tid (#const CTRL_C_EVENT) = do - throwTo tid Interrupt - return True - handler _ _ = return False - - ------------------------ -- Multi-byte conversion diff --git a/System/Console/Haskeline/Term.hs b/System/Console/Haskeline/Term.hs index 796bb12..9921651 100644 --- a/System/Console/Haskeline/Term.hs +++ b/System/Console/Haskeline/Term.hs @@ -7,7 +7,6 @@ import System.Console.Haskeline.Prefs(Prefs) import System.Console.Haskeline.Completion(Completion) import Control.Concurrent -import Data.Typeable import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Word @@ -35,7 +34,6 @@ data RunTerm = RunTerm { encodeForTerm :: String -> IO ByteString, decodeForTerm :: ByteString -> IO String, termOps :: Either TermOps FileOps, - wrapInterrupt :: MonadException m => m a -> m a, closeTerm :: IO () } @@ -116,11 +114,6 @@ keyEventLoop readEvents eventChan = do saveKeys :: Chan Event -> [Key] -> IO () saveKeys ch = writeChan ch . KeyInput -data Interrupt = Interrupt - deriving (Show,Typeable,Eq) - -instance Exception Interrupt where - data Layout = Layout {width, height :: Int} deriving (Show,Eq) diff --git a/examples/Test.hs b/examples/Test.hs index 817efcd..bbe1f02 100644 --- a/examples/Test.hs +++ b/examples/Test.hs @@ -2,6 +2,7 @@ module Main where import System.Console.Haskeline import System.Environment +import Control.Exception (AsyncException(..)) {-- Testing the line-input functions and their interaction with ctrl-c signals. @@ -26,10 +27,10 @@ main = do ["password", [c]] -> getPassword (Just c) ["initial"] -> flip getInputLineWithInitial ("left ", "right") _ -> getInputLine - runInputT mySettings $ withInterrupt $ loop inputFunc 0 + runInputT mySettings $ loop inputFunc 0 where loop inputFunc n = do - minput <- handleInterrupt (return (Just "Caught interrupted")) + minput <- handle (\UserInterrupt -> return (Just "Caught interrupted")) $ inputFunc (show n ++ ":") case minput of Nothing -> return () _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
