src/win32/CtrlC.hs

   1 {-# OPTIONS_GHC -fffi #-}
   2 {-# LANGUAGE ForeignFunctionInterface #-}
   3
   4 module CtrlC (withCtrlCHandler) where
   5
   6 import Data.Word ( Word32 )
   7 import Foreign.Ptr ( FunPtr )
   8 import Control.Exception ( bracket )
   9
  10 type Handler = Word32 -> IO Int
  11
  12 foreign import ccall "wrapper" wrap :: Handler -> IO (FunPtr Handler)
  13 foreign import stdcall "SetConsoleCtrlHandler" setConsoleCtrlHandler :: FunPtr Handler -> Int -> IO ()
  14
  15
  16 withCtrlCHandler :: IO () -> IO a -> IO a
  17 withCtrlCHandler handler m = do
  18     fp <- wrap (\_ctrlType -> handler >> return 1)
  19     bracket (setConsoleCtrlHandler fp 1) (const $ setConsoleCtrlHandler fp 0) (const m)
  20
  21
  22