summaryrefslogtreecommitdiffhomepage
path: root/src/Signal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Signal.hs')
-rw-r--r--src/Signal.hs132
1 files changed, 0 insertions, 132 deletions
diff --git a/src/Signal.hs b/src/Signal.hs
deleted file mode 100644
index 74e40e9..0000000
--- a/src/Signal.hs
+++ /dev/null
@@ -1,132 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, CPP #-}
-
------------------------------------------------------------------------------
--- |
--- Module : Signal
--- Copyright : (c) Andrea Rosatto
--- : (c) Jose A. Ortega Ruiz
--- : (c) Jochen Keil
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- Signal handling, including DBUS when available
---
------------------------------------------------------------------------------
-
-module Signal where
-
-import Data.Foldable (for_)
-import Data.Typeable (Typeable)
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception
-import System.Posix.Signals
-import Graphics.X11.Types (Button)
-import Graphics.X11.Xlib.Types (Position)
-import System.IO
-
-#ifdef DBUS
-import DBus (IsVariant(..))
-import Control.Monad ((>=>))
-#endif
-
-import Plugins.Utils (safeHead)
-
-data WakeUp = WakeUp deriving (Show,Typeable)
-instance Exception WakeUp
-
-data SignalType = Wakeup
- | Reposition
- | ChangeScreen
- | Hide Int
- | Reveal Int
- | Toggle Int
- | TogglePersistent
- | Action Button Position
- deriving (Read, Show)
-
-#ifdef DBUS
-instance IsVariant SignalType where
- toVariant = toVariant . show
- fromVariant = fromVariant >=> parseSignalType
-#endif
-
-parseSignalType :: String -> Maybe SignalType
-parseSignalType = fmap fst . safeHead . reads
-
--- | Signal handling
-setupSignalHandler :: IO (TMVar SignalType)
-setupSignalHandler = do
- tid <- newEmptyTMVarIO
- installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
- installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
- return tid
-
-updatePosHandler :: TMVar SignalType -> IO ()
-updatePosHandler sig = do
- atomically $ putTMVar sig Reposition
- return ()
-
-changeScreenHandler :: TMVar SignalType -> IO ()
-changeScreenHandler sig = do
- atomically $ putTMVar sig ChangeScreen
- return ()
-
-
--- | Ensures that the given IO action runs its cleanup actions ('bracket' etc.),
--- even if a signal is caught.
---
--- An exception will be thrown on the thread that called this function when a
--- signal is caught.
-withDeferSignals :: IO a -> IO a
-withDeferSignals thing = do
- threadId <- myThreadId
- caughtSignal <- newEmptyMVar
-
- let signals =
- filter (not . flip inSignalSet reservedSignals)
- [ sigQUIT
- , sigTERM
- --, sigINT -- Handler already installed by GHC
- --, sigPIPE -- Handler already installed by GHC
- --, sigUSR1 -- Handled by setupSignalHandler
- --, sigUSR2 -- Handled by setupSignalHandler
-
- -- One of the following appears to cause instability, see #360
- --, sigHUP
- --, sigILL
- --, sigABRT
- --, sigFPE
- --, sigSEGV
- --, sigALRM
- --, sigBUS
- --, sigPOLL
- --, sigPROF
- --, sigSYS
- --, sigTRAP
- --, sigVTALRM
- --, sigXCPU
- --, sigXFSZ
- ]
-
- for_ signals $ \s ->
-
- installHandler s
- (Catch $ do
- tryPutMVar caughtSignal s
- hPutStrLn stderr ("xmobar: Caught signal "++show s++"; exiting...")
- throwTo threadId ThreadKilled)
- Nothing
-
- thing `finally` do
- s0 <- tryReadMVar caughtSignal
- case s0 of
- Nothing -> pure ()
- Just s -> do
- -- Run the default handler for the signal
- -- hPutStrLn stderr ("xmobar: Running default handler for signal "++show s)
- installHandler s Default Nothing
- raiseSignal s