-- |
-- Module: WildBind.X11.Internal.NotificationDebouncer
-- Description: debouce X11 notification events
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. End-users should not rely on it.__
--
-- WildBind.X11 module receives some notification events to update the
-- current state of the desktop (usually it is the active
-- window). However, there are some problems in updating the state
-- every time it receives a notification event.
--
-- * Notification events can come too fast. It can make siginificant
--   overhead to the system.
--
-- * The active window obtained at the very moment a notification
--   arrives is often unstable. It can become invalid soon. In
--   addition, Xlib is notorious for being bad at handling that kind
--   of exceptions (it just crashes the entire process and it's
--   practically impossible to catch the exceptions).
--
-- Personally, I have experienced even weirder behaviors when I did
-- some X11 operations at arrivals of notification events.
--
-- * Sometimes I could not obtain the current active window. Instead,
--   I ended up with getting the previous active window.
--
-- * Sometimes GetWindowProperty blocked forever.
--
-- So, as a workaround, we debounce the raw notification events and
-- generate a ClientMessage X11 event. When we get the ClientMessage,
-- we update the state.

-- Toshio's personal note: 2015/05/06, 2010/12/05 - 19

module WildBind.X11.Internal.NotificationDebouncer
    ( Debouncer
    , withDebouncer
    , notify
    , xEventMask
    , isDebouncedEvent
    ) where

import           Control.Exception        (bracket)
import qualified Control.FoldDebounce     as Fdeb
import qualified Graphics.X11.Xlib        as Xlib
import qualified Graphics.X11.Xlib.Extras as XlibE

data Debouncer
  = Debouncer
      { Debouncer -> Trigger () ()
ndTrigger     :: Fdeb.Trigger () ()
      , Debouncer -> Atom
ndMessageType :: Xlib.Atom
      }

-- | Create a Debouncer and run the specified action.
withDebouncer :: Xlib.Display -> (Debouncer -> IO a) -> IO a
withDebouncer :: forall a. Display -> (Debouncer -> IO a) -> IO a
withDebouncer Display
disp Debouncer -> IO a
action = do
  Atom
mtype <- Display -> String -> Bool -> IO Atom
Xlib.internAtom Display
disp String
"_WILDBIND_NOTIFY_CHANGE" Bool
False
  IO (Trigger () ())
-> (Trigger () () -> IO ()) -> (Trigger () () -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Display -> Atom -> IO (Trigger () ())
newTrigger Display
disp Atom
mtype) (Trigger () () -> IO ()
forall i o. Trigger i o -> IO ()
Fdeb.close) ((Trigger () () -> IO a) -> IO a)
-> (Trigger () () -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Trigger () ()
trigger -> Debouncer -> IO a
action (Trigger () () -> Atom -> Debouncer
Debouncer Trigger () ()
trigger Atom
mtype)

-- | Notify the 'Debouncer' that a notification event arrives. After a
-- while, the 'Debouncer' emits a ClientMessage X11 event.
notify :: Debouncer -> IO ()
notify :: Debouncer -> IO ()
notify Debouncer
deb = Trigger () () -> () -> IO ()
forall i o. Trigger i o -> i -> IO ()
Fdeb.send (Debouncer -> Trigger () ()
ndTrigger Debouncer
deb) ()

debounceDelay :: Int
debounceDelay :: Int
debounceDelay = Int
200000

newTrigger :: Xlib.Display -> Xlib.Atom -> IO (Fdeb.Trigger () ())
newTrigger :: Display -> Atom -> IO (Trigger () ())
newTrigger Display
disp Atom
mtype = Args () () -> Opts () () -> IO (Trigger () ())
forall i o. Args i o -> Opts i o -> IO (Trigger i o)
Fdeb.new (IO () -> Args () ()
forall i. IO () -> Args i ()
Fdeb.forVoid (IO () -> Args () ()) -> IO () -> Args () ()
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO ()
sendClientMessage Display
disp Atom
mtype)
                           Opts Any Any
forall a. Default a => a
Fdeb.def { Fdeb.delay = debounceDelay, Fdeb.alwaysResetTimer = True }

-- | The Xlib EventMask for sending the ClientMessage. You have to
-- select this mask by 'selectInput' function to receive the
-- ClientMessage.
xEventMask :: Xlib.EventMask
xEventMask :: Atom
xEventMask = Atom
Xlib.substructureNotifyMask

sendClientMessage :: Xlib.Display -> Xlib.Atom -> IO ()
sendClientMessage :: Display -> Atom -> IO ()
sendClientMessage Display
disp Atom
mtype = (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
Xlib.allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
xev -> do
  let root_win :: Atom
root_win = Display -> Atom
Xlib.defaultRootWindow Display
disp
  XEventPtr -> EventType -> IO ()
XlibE.setEventType XEventPtr
xev EventType
Xlib.clientMessage
  XEventPtr -> Atom -> Atom -> CInt -> Atom -> Atom -> IO ()
XlibE.setClientMessageEvent XEventPtr
xev Atom
root_win Atom
mtype CInt
8 Atom
0 Atom
0
  Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
Xlib.sendEvent Display
disp Atom
root_win Bool
False Atom
xEventMask XEventPtr
xev
  Display -> IO ()
Xlib.flush Display
disp

-- | Check if the given event is the debounced ClientMessage X11
-- event.
isDebouncedEvent :: Debouncer -> Xlib.XEventPtr -> IO Bool
isDebouncedEvent :: Debouncer -> XEventPtr -> IO Bool
isDebouncedEvent Debouncer
deb XEventPtr
xev = do
  Event
ev <- XEventPtr -> IO Event
XlibE.getEvent XEventPtr
xev
  let exp_type :: Atom
exp_type = Debouncer -> Atom
ndMessageType Debouncer
deb
  case Event
ev of
    XlibE.ClientMessageEvent EventType
_ CULong
_ Bool
_ Display
_ Atom
_ Atom
got_type [CInt]
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Atom
got_type Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
== Atom
exp_type)
    Event
_                                             -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False