[commit: haskeline] master: Remove the wrap/handleInterrupt functions. (cd93b67)
Ian Lynagh
igloo at earth.li
Tue Feb 21 16:57:07 CET 2012
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 <judah.jacobson at gmail.com>
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 ()
More information about the Cvs-libraries
mailing list