    {-# LANGUAGE MultiWayIf #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.Timer
    -- Description :  A module for setting up timers.
    -- Copyright   :  (c) Andrea Rossato and David Roundy 2007
    -- License     :  BSD-style (see xmonad/LICENSE)
    --
    -- Maintainer  :  andrea.rossato@unibz.it
    -- Stability   :  unstable
    -- Portability :  unportable
    --
    -- A module for setting up timers
    -----------------------------------------------------------------------------

    module XMonad.Util.Timer
        ( -- * Usage
          -- $usage
          startTimer
        , handleTimer
        , TimerId
        ) where

    import Control.Concurrent
    import Data.Unique
    import XMonad
    import XMonad.Prelude (listToMaybe)

    -- $usage
    -- This module can be used to setup a timer to handle deferred events.
    -- See "XMonad.Layout.ShowWName" for an usage example.

    type TimerId = Int

    -- | Start a timer, which will send a ClientMessageEvent after some
    -- time (in seconds).
    startTimer :: Rational -> X TimerId
    startTimer :: Rational -> X Int
    startTimer Rational
    s = IO Int -> X Int
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO Int -> X Int) -> IO Int -> X Int
    forall a b. (a -> b) -> a -> b
    $ do
      u   <- Unique -> Int
    hashUnique (Unique -> Int) -> IO Unique -> IO Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Unique
    newUnique
      xfork $ do
        d   <- openDisplay ""
        rw  <- rootWindow d $ defaultScreen d
        threadDelay (fromEnum $ s * 1000000)
        a <- internAtom d "XMONAD_TIMER" False
        allocaXEvent $ \XEventPtr
    e -> do
             XEventPtr -> ScreenNumber -> IO ()
    setEventType XEventPtr
    e ScreenNumber
    clientMessage
             XEventPtr -> Atom -> Atom -> CInt -> Atom -> Atom -> IO ()
    setClientMessageEvent XEventPtr
    e Atom
    rw Atom
    a CInt
    32 (Int -> Atom
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    u) Atom
    0
             Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
    sendEvent Display
    d Atom
    rw Bool
    False Atom
    structureNotifyMask XEventPtr
    e
        sync d False
      return u

    -- | Given a 'TimerId' and an 'Event', run an action when the 'Event'
    -- has been sent by the timer specified by the 'TimerId'
    handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
    handleTimer :: forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
    handleTimer Int
    ti ClientMessageEvent{ev_message_type :: Event -> Atom
    ev_message_type = Atom
    mt, ev_data :: Event -> [CInt]
    ev_data = [CInt]
    dt} X (Maybe a)
    action = do
      d <- (XConf -> Display) -> X Display
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks XConf -> Display
    display
      a <- io $ internAtom d "XMONAD_TIMER" False
      if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action
         | otherwise -> return Nothing
    handleTimer Int
    _ Event
    _ X (Maybe a)
    _ = Maybe a -> X (Maybe a)
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing