{-# LANGUAGE DeriveDataTypeable, CPP #-}
module Xmobar.System.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
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x
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
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 ()
withDeferSignals :: IO a -> IO a
withDeferSignals thing = do
threadId <- myThreadId
caughtSignal <- newEmptyMVar
let signals =
filter (not . flip inSignalSet reservedSignals)
[ sigQUIT
, sigTERM
]
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
installHandler s Default Nothing
raiseSignal s