-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Information.X11DesktopInfo
-- Copyright   : (c) José A. Romero L.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan Malison <IvanMalison@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Low-level functions to access data provided by the X11 desktop via window
-- properties. One of them ('getVisibleTags') depends on the PagerHints hook
-- being installed in your @~\/.xmonad\/xmonad.hs@ configuration:
--
-- > import System.Taffybar.Support.PagerHints (pagerHints)
-- >
-- > main = xmonad $ ewmh $ pagerHints $ ...
--
-----------------------------------------------------------------------------

module System.Taffybar.Information.X11DesktopInfo
  ( X11Context(..)
  , X11Property
  , X11Window
  , doLowerWindow
  , eventLoop
  , fetch
  , getAtom
  , getDefaultCtx
  , getDisplay
  , getPrimaryOutputNumber
  , getVisibleTags
  , isWindowUrgent
  , postX11RequestSyncProp
  , readAsInt
  , readAsListOfInt
  , readAsListOfString
  , readAsListOfWindow
  , readAsString
  , sendCommandEvent
  , sendWindowEvent
  , withDefaultCtx
  ) where

import Data.List
import Data.Maybe

import Codec.Binary.UTF8.String as UTF8
import qualified Control.Concurrent.MVar as MV
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Data.Bits (testBit, (.|.))
import Data.List.Split (endBy)
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
  hiding (getWindowProperty8, getWindowProperty32, getWMHints)
import Graphics.X11.Xrandr
import Safe
import System.Taffybar.Information.SafeX11

import Prelude

data X11Context = X11Context
  { X11Context -> Display
contextDisplay :: Display
  , X11Context -> RRCrtc
_contextRoot :: Window
  , X11Context -> MVar [(String, RRCrtc)]
atomCache :: MV.MVar [(String, Atom)]
  }

type X11Property a = ReaderT X11Context IO a
type X11Window = Window
type PropertyFetcher a = Display -> Atom -> Window -> IO (Maybe [a])

-- | Put the current display and root window objects inside a Reader transformer
-- for further computation.
withDefaultCtx :: X11Property a -> IO a
withDefaultCtx :: forall a. X11Property a -> IO a
withDefaultCtx X11Property a
fun = do
  X11Context
ctx <- IO X11Context
getDefaultCtx
  a
res <- X11Property a -> X11Context -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT X11Property a
fun X11Context
ctx
  Display -> IO ()
closeDisplay (X11Context -> Display
contextDisplay X11Context
ctx)
  a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res

-- | An X11Property that returns the @Display@ object stored in the X11Context.
getDisplay :: X11Property Display
getDisplay :: X11Property Display
getDisplay = X11Context -> Display
contextDisplay (X11Context -> Display)
-> ReaderT X11Context IO X11Context -> X11Property Display
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

doRead :: Integral a => b -> ([a] -> b)
       -> PropertyFetcher a
       -> Maybe X11Window
       -> String
       -> X11Property b
doRead :: forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead b
def [a] -> b
transform PropertyFetcher a
windowPropFn Maybe RRCrtc
window String
name =
  (b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe b
def) (Maybe b -> b) -> (Maybe [a] -> Maybe b) -> Maybe [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a] -> b) -> Maybe [a] -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> b
transform) (Maybe [a] -> b)
-> ReaderT X11Context IO (Maybe [a]) -> ReaderT X11Context IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PropertyFetcher a
-> Maybe RRCrtc -> String -> ReaderT X11Context IO (Maybe [a])
forall a.
Integral a =>
PropertyFetcher a
-> Maybe RRCrtc -> String -> X11Property (Maybe [a])
fetch PropertyFetcher a
windowPropFn Maybe RRCrtc
window String
name

-- | Retrieve the property of the given window (or the root window, if Nothing)
-- with the given name as a value of type Int. If that property hasn't been set,
-- then return -1.
readAsInt :: Maybe X11Window -- ^ window to read from. Nothing means the root window.
          -> String -- ^ name of the property to retrieve
          -> X11Property Int
readAsInt :: Maybe RRCrtc -> String -> X11Property Int
readAsInt = Int
-> ([CLong] -> Int)
-> PropertyFetcher CLong
-> Maybe RRCrtc
-> String
-> X11Property Int
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead (-Int
1) (Int -> (CLong -> Int) -> Maybe CLong -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-Int
1) CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe CLong -> Int) -> ([CLong] -> Maybe CLong) -> [CLong] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CLong] -> Maybe CLong
forall a. [a] -> Maybe a
headMay) PropertyFetcher CLong
getWindowProperty32

-- | Retrieve the property of the given window (or the root window, if Nothing)
-- with the given name as a list of Ints. If that property hasn't been set, then
-- return an empty list.
readAsListOfInt :: Maybe X11Window -- ^ window to read from. Nothing means the root window.
                -> String          -- ^ name of the property to retrieve
                -> X11Property [Int]
readAsListOfInt :: Maybe RRCrtc -> String -> X11Property [Int]
readAsListOfInt = [Int]
-> ([CLong] -> [Int])
-> PropertyFetcher CLong
-> Maybe RRCrtc
-> String
-> X11Property [Int]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead [] ((CLong -> Int) -> [CLong] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PropertyFetcher CLong
getWindowProperty32

-- | Retrieve the property of the given window (or the root window, if Nothing)
-- with the given name as a String. If the property hasn't been set, then return
-- an empty string.
readAsString :: Maybe X11Window -- ^ window to read from. Nothing means the root window.
             -> String          -- ^ name of the property to retrieve
             -> X11Property String
readAsString :: Maybe RRCrtc -> String -> X11Property String
readAsString = String
-> ([CChar] -> String)
-> PropertyFetcher CChar
-> Maybe RRCrtc
-> String
-> X11Property String
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead String
"" ([Word8] -> String
UTF8.decode ([Word8] -> String) -> ([CChar] -> [Word8]) -> [CChar] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChar -> Word8) -> [CChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PropertyFetcher CChar
getWindowProperty8

-- | Retrieve the property of the given window (or the root window, if Nothing)
-- with the given name as a list of Strings. If the property hasn't been set,
-- then return an empty list.
readAsListOfString :: Maybe X11Window -- ^ window to read from. Nothing means the root window.
                   -> String          -- ^ name of the property to retrieve
                   -> X11Property [String]
readAsListOfString :: Maybe RRCrtc -> String -> X11Property [String]
readAsListOfString = [String]
-> ([CChar] -> [String])
-> PropertyFetcher CChar
-> Maybe RRCrtc
-> String
-> X11Property [String]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead [] [CChar] -> [String]
parse PropertyFetcher CChar
getWindowProperty8
  where parse :: [CChar] -> [String]
parse = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
endBy String
"\0" (String -> [String]) -> ([CChar] -> String) -> [CChar] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
UTF8.decode ([Word8] -> String) -> ([CChar] -> [Word8]) -> [CChar] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CChar -> Word8) -> [CChar] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map CChar -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Retrieve the property of the given window (or the root window, if Nothing)
-- with the given name as a list of X11 Window IDs. If the property hasn't been
-- set, then return an empty list.
readAsListOfWindow :: Maybe X11Window -- ^ window to read from. Nothing means the root window.
                   -> String          -- ^ name of the property to retrieve
                   -> X11Property [X11Window]
readAsListOfWindow :: Maybe RRCrtc -> String -> X11Property [RRCrtc]
readAsListOfWindow = [RRCrtc]
-> ([CLong] -> [RRCrtc])
-> PropertyFetcher CLong
-> Maybe RRCrtc
-> String
-> X11Property [RRCrtc]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe RRCrtc
-> String
-> X11Property b
doRead [] ((CLong -> RRCrtc) -> [CLong] -> [RRCrtc]
forall a b. (a -> b) -> [a] -> [b]
map CLong -> RRCrtc
forall a b. (Integral a, Num b) => a -> b
fromIntegral) PropertyFetcher CLong
getWindowProperty32

-- | Determine whether the \"urgent\" flag is set in the WM_HINTS of the given
-- window.
isWindowUrgent :: X11Window -> X11Property Bool
isWindowUrgent :: RRCrtc -> X11Property Bool
isWindowUrgent RRCrtc
window = do
  WMHints
hints <- RRCrtc -> X11Property WMHints
fetchWindowHints RRCrtc
window
  Bool -> X11Property Bool
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X11Property Bool) -> Bool -> X11Property Bool
forall a b. (a -> b) -> a -> b
$ CLong -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (WMHints -> CLong
wmh_flags WMHints
hints) Int
urgencyHintBit

-- | Retrieve the value of the special _XMONAD_VISIBLE_WORKSPACES hint set by
-- the PagerHints hook provided by Taffybar (see module documentation for
-- instructions on how to do this), or an empty list of strings if the
-- PagerHints hook is not available.
getVisibleTags :: X11Property [String]
getVisibleTags :: X11Property [String]
getVisibleTags = Maybe RRCrtc -> String -> X11Property [String]
readAsListOfString Maybe RRCrtc
forall a. Maybe a
Nothing String
"_XMONAD_VISIBLE_WORKSPACES"

-- | Return the Atom with the given name.
getAtom :: String -> X11Property Atom
getAtom :: String -> X11Property RRCrtc
getAtom String
s = do
  (X11Context Display
d RRCrtc
_ MVar [(String, RRCrtc)]
cacheVar) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Maybe RRCrtc
a <- IO (Maybe RRCrtc) -> ReaderT X11Context IO (Maybe RRCrtc)
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe RRCrtc) -> ReaderT X11Context IO (Maybe RRCrtc))
-> IO (Maybe RRCrtc) -> ReaderT X11Context IO (Maybe RRCrtc)
forall a b. (a -> b) -> a -> b
$ String -> [(String, RRCrtc)] -> Maybe RRCrtc
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
s ([(String, RRCrtc)] -> Maybe RRCrtc)
-> IO [(String, RRCrtc)] -> IO (Maybe RRCrtc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar [(String, RRCrtc)] -> IO [(String, RRCrtc)]
forall a. MVar a -> IO a
MV.readMVar MVar [(String, RRCrtc)]
cacheVar
  let updateCacheAction :: X11Property RRCrtc
updateCacheAction = IO RRCrtc -> X11Property RRCrtc
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO RRCrtc -> X11Property RRCrtc)
-> IO RRCrtc -> X11Property RRCrtc
forall a b. (a -> b) -> a -> b
$ MVar [(String, RRCrtc)]
-> ([(String, RRCrtc)] -> IO ([(String, RRCrtc)], RRCrtc))
-> IO RRCrtc
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MV.modifyMVar MVar [(String, RRCrtc)]
cacheVar [(String, RRCrtc)] -> IO ([(String, RRCrtc)], RRCrtc)
updateCache
      updateCache :: [(String, RRCrtc)] -> IO ([(String, RRCrtc)], RRCrtc)
updateCache [(String, RRCrtc)]
currentCache =
        do
          RRCrtc
atom <- Display -> String -> Bool -> IO RRCrtc
internAtom Display
d String
s Bool
False
          ([(String, RRCrtc)], RRCrtc) -> IO ([(String, RRCrtc)], RRCrtc)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String
s, RRCrtc
atom)(String, RRCrtc) -> [(String, RRCrtc)] -> [(String, RRCrtc)]
forall a. a -> [a] -> [a]
:[(String, RRCrtc)]
currentCache, RRCrtc
atom)
  X11Property RRCrtc
-> (RRCrtc -> X11Property RRCrtc)
-> Maybe RRCrtc
-> X11Property RRCrtc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe X11Property RRCrtc
updateCacheAction RRCrtc -> X11Property RRCrtc
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RRCrtc
a

-- | Spawn a new thread and listen inside it to all incoming events, invoking
-- the given function to every event of type @MapNotifyEvent@ that arrives, and
-- subscribing to all events of this type emitted by newly created windows.
eventLoop :: (Event -> IO ()) -> X11Property ()
eventLoop :: (Event -> IO ()) -> X11Property ()
eventLoop Event -> IO ()
dispatch = do
  (X11Context Display
d RRCrtc
w MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO () -> X11Property ()
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X11Property ()) -> IO () -> X11Property ()
forall a b. (a -> b) -> a -> b
$ do
    Display -> RRCrtc -> RRCrtc -> IO ()
selectInput Display
d RRCrtc
w (RRCrtc -> IO ()) -> RRCrtc -> IO ()
forall a b. (a -> b) -> a -> b
$ RRCrtc
propertyChangeMask RRCrtc -> RRCrtc -> RRCrtc
forall a. Bits a => a -> a -> a
.|. RRCrtc
substructureNotifyMask
    (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Event
event <- Display -> XEventPtr -> IO ()
nextEvent Display
d XEventPtr
e IO () -> IO Event -> IO Event
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XEventPtr -> IO Event
getEvent XEventPtr
e
      case Event
event of
        MapNotifyEvent { ev_window :: Event -> RRCrtc
ev_window = RRCrtc
window } ->
          Display -> RRCrtc -> RRCrtc -> IO ()
selectInput Display
d RRCrtc
window RRCrtc
propertyChangeMask
        Event
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Event -> IO ()
dispatch Event
event

-- | Emit a \"command\" event with one argument for the X server. This is used
-- to send events that can be received by event hooks in the XMonad process and
-- acted upon in that context.
sendCommandEvent :: Atom -> Atom -> X11Property ()
sendCommandEvent :: RRCrtc -> RRCrtc -> X11Property ()
sendCommandEvent RRCrtc
cmd RRCrtc
arg = do
  (X11Context Display
dpy RRCrtc
root MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Display -> RRCrtc -> RRCrtc -> RRCrtc -> RRCrtc -> X11Property ()
sendCustomEvent Display
dpy RRCrtc
cmd RRCrtc
arg RRCrtc
root RRCrtc
root

-- | Similar to 'sendCommandEvent', but with an argument of type Window.
sendWindowEvent :: Atom -> X11Window -> X11Property ()
sendWindowEvent :: RRCrtc -> RRCrtc -> X11Property ()
sendWindowEvent RRCrtc
cmd RRCrtc
win = do
  (X11Context Display
dpy RRCrtc
root MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Display -> RRCrtc -> RRCrtc -> RRCrtc -> RRCrtc -> X11Property ()
sendCustomEvent Display
dpy RRCrtc
cmd RRCrtc
cmd RRCrtc
root RRCrtc
win

-- | Build a new @X11Context@ containing the current X11 display and its root
-- window.
getDefaultCtx :: IO X11Context
getDefaultCtx :: IO X11Context
getDefaultCtx = do
  Display
d <- String -> IO Display
openDisplay String
""
  RRCrtc
w <- Display -> ScreenNumber -> IO RRCrtc
rootWindow Display
d (ScreenNumber -> IO RRCrtc) -> ScreenNumber -> IO RRCrtc
forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
d
  MVar [(String, RRCrtc)]
cache <- [(String, RRCrtc)] -> IO (MVar [(String, RRCrtc)])
forall a. a -> IO (MVar a)
MV.newMVar []
  X11Context -> IO X11Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (X11Context -> IO X11Context) -> X11Context -> IO X11Context
forall a b. (a -> b) -> a -> b
$ Display -> RRCrtc -> MVar [(String, RRCrtc)] -> X11Context
X11Context Display
d RRCrtc
w MVar [(String, RRCrtc)]
cache

-- | Apply the given function to the given window in order to obtain the X11
-- property with the given name, or Nothing if no such property can be read.
fetch :: (Integral a)
      => PropertyFetcher a -- ^ Function to use to retrieve the property.
      -> Maybe X11Window   -- ^ Window to read from. Nothing means the root Window.
      -> String            -- ^ Name of the property to retrieve.
      -> X11Property (Maybe [a])
fetch :: forall a.
Integral a =>
PropertyFetcher a
-> Maybe RRCrtc -> String -> X11Property (Maybe [a])
fetch PropertyFetcher a
fetcher Maybe RRCrtc
window String
name = do
  (X11Context Display
dpy RRCrtc
root MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  RRCrtc
atom <- String -> X11Property RRCrtc
getAtom String
name
  IO (Maybe [a]) -> X11Property (Maybe [a])
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [a]) -> X11Property (Maybe [a]))
-> IO (Maybe [a]) -> X11Property (Maybe [a])
forall a b. (a -> b) -> a -> b
$ PropertyFetcher a
fetcher Display
dpy RRCrtc
atom (RRCrtc -> Maybe RRCrtc -> RRCrtc
forall a. a -> Maybe a -> a
fromMaybe RRCrtc
root Maybe RRCrtc
window)

-- | Retrieve the @WM_HINTS@ mask assigned by the X server to the given window.
fetchWindowHints :: X11Window -> X11Property WMHints
fetchWindowHints :: RRCrtc -> X11Property WMHints
fetchWindowHints RRCrtc
window = do
  (X11Context Display
d RRCrtc
_ MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  IO WMHints -> X11Property WMHints
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WMHints -> X11Property WMHints)
-> IO WMHints -> X11Property WMHints
forall a b. (a -> b) -> a -> b
$ Display -> RRCrtc -> IO WMHints
getWMHints Display
d RRCrtc
window

-- | Emit an event of type @ClientMessage@ that can be listened to and consumed
-- by XMonad event hooks.
sendCustomEvent :: Display
                -> Atom
                -> Atom
                -> X11Window
                -> X11Window
                -> X11Property ()
sendCustomEvent :: Display -> RRCrtc -> RRCrtc -> RRCrtc -> RRCrtc -> X11Property ()
sendCustomEvent Display
dpy RRCrtc
cmd RRCrtc
arg RRCrtc
root RRCrtc
win =
  IO () -> X11Property ()
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X11Property ()) -> IO () -> X11Property ()
forall a b. (a -> b) -> a -> b
$ (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
    XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
    XEventPtr -> RRCrtc -> RRCrtc -> CInt -> RRCrtc -> RRCrtc -> IO ()
setClientMessageEvent XEventPtr
e RRCrtc
win RRCrtc
cmd CInt
32 RRCrtc
arg RRCrtc
currentTime
    Display -> RRCrtc -> Bool -> RRCrtc -> XEventPtr -> IO ()
sendEvent Display
dpy RRCrtc
root Bool
False RRCrtc
structureNotifyMask XEventPtr
e
    Display -> Bool -> IO ()
sync Display
dpy Bool
False

-- | Post the provided X11Property to taffybar's dedicated X11 thread, and wait
-- for the result. The provided default value will be returned in the case of an
-- error.
postX11RequestSyncProp :: X11Property a -> a -> X11Property a
postX11RequestSyncProp :: forall a. X11Property a -> a -> X11Property a
postX11RequestSyncProp X11Property a
prop a
def = do
  X11Context
c <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let action :: IO a
action = X11Property a -> X11Context -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT X11Property a
prop X11Context
c
  IO a -> X11Property a
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> X11Property a) -> IO a -> X11Property a
forall a b. (a -> b) -> a -> b
$ a -> IO a -> IO a
forall a. a -> IO a -> IO a
postX11RequestSyncDef a
def IO a
action

-- | X11Property which reflects whether or not the provided RROutput is active.
isActiveOutput :: XRRScreenResources -> RROutput -> X11Property Bool
isActiveOutput :: XRRScreenResources -> RRCrtc -> X11Property Bool
isActiveOutput XRRScreenResources
sres RRCrtc
output = do
  (X11Context Display
display RRCrtc
_ MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Maybe XRROutputInfo
maybeOutputInfo <- IO (Maybe XRROutputInfo)
-> ReaderT X11Context IO (Maybe XRROutputInfo)
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe XRROutputInfo)
 -> ReaderT X11Context IO (Maybe XRROutputInfo))
-> IO (Maybe XRROutputInfo)
-> ReaderT X11Context IO (Maybe XRROutputInfo)
forall a b. (a -> b) -> a -> b
$ Display -> XRRScreenResources -> RRCrtc -> IO (Maybe XRROutputInfo)
xrrGetOutputInfo Display
display XRRScreenResources
sres RRCrtc
output
  Bool -> X11Property Bool
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> X11Property Bool) -> Bool -> X11Property Bool
forall a b. (a -> b) -> a -> b
$ RRCrtc
-> (XRROutputInfo -> RRCrtc) -> Maybe XRROutputInfo -> RRCrtc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RRCrtc
0 XRROutputInfo -> RRCrtc
xrr_oi_crtc Maybe XRROutputInfo
maybeOutputInfo RRCrtc -> RRCrtc -> Bool
forall a. Eq a => a -> a -> Bool
/= RRCrtc
0

-- | Return all the active RR outputs.
getActiveOutputs :: X11Property [RROutput]
getActiveOutputs :: X11Property [RRCrtc]
getActiveOutputs = do
  (X11Context Display
display RRCrtc
rootw MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  Maybe XRRScreenResources
maybeSres <- IO (Maybe XRRScreenResources)
-> ReaderT X11Context IO (Maybe XRRScreenResources)
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe XRRScreenResources)
 -> ReaderT X11Context IO (Maybe XRRScreenResources))
-> IO (Maybe XRRScreenResources)
-> ReaderT X11Context IO (Maybe XRRScreenResources)
forall a b. (a -> b) -> a -> b
$ Display -> RRCrtc -> IO (Maybe XRRScreenResources)
xrrGetScreenResources Display
display RRCrtc
rootw
  X11Property [RRCrtc]
-> (XRRScreenResources -> X11Property [RRCrtc])
-> Maybe XRRScreenResources
-> X11Property [RRCrtc]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([RRCrtc] -> X11Property [RRCrtc]
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\XRRScreenResources
sres -> (RRCrtc -> X11Property Bool) -> [RRCrtc] -> X11Property [RRCrtc]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (XRRScreenResources -> RRCrtc -> X11Property Bool
isActiveOutput XRRScreenResources
sres) ([RRCrtc] -> X11Property [RRCrtc])
-> [RRCrtc] -> X11Property [RRCrtc]
forall a b. (a -> b) -> a -> b
$ XRRScreenResources -> [RRCrtc]
xrr_sr_outputs XRRScreenResources
sres)
        Maybe XRRScreenResources
maybeSres

-- | Get the index of the primary monitor as set and ordered by Xrandr.
getPrimaryOutputNumber :: X11Property (Maybe Int)
getPrimaryOutputNumber :: X11Property (Maybe Int)
getPrimaryOutputNumber = do
  (X11Context Display
display RRCrtc
rootw MVar [(String, RRCrtc)]
_) <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  RRCrtc
primary <- IO RRCrtc -> X11Property RRCrtc
forall a. IO a -> ReaderT X11Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RRCrtc -> X11Property RRCrtc)
-> IO RRCrtc -> X11Property RRCrtc
forall a b. (a -> b) -> a -> b
$ Display -> RRCrtc -> IO RRCrtc
xrrGetOutputPrimary Display
display RRCrtc
rootw
  [RRCrtc]
outputs <- X11Property [RRCrtc]
getActiveOutputs
  Maybe Int -> X11Property (Maybe Int)
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> X11Property (Maybe Int))
-> Maybe Int -> X11Property (Maybe Int)
forall a b. (a -> b) -> a -> b
$ RRCrtc
primary RRCrtc -> [RRCrtc] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [RRCrtc]
outputs

-- | Move the X11Windows to the bottom of the X11 window stack.
doLowerWindow :: X11Window -> X11Property ()
doLowerWindow :: RRCrtc -> X11Property ()
doLowerWindow RRCrtc
window =
  (X11Context -> Display) -> X11Property Display
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks X11Context -> Display
contextDisplay X11Property Display
-> (Display -> X11Property ()) -> X11Property ()
forall a b.
ReaderT X11Context IO a
-> (a -> ReaderT X11Context IO b) -> ReaderT X11Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> X11Property ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> X11Property ())
-> (Display -> IO ()) -> Display -> X11Property ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Display -> RRCrtc -> IO ()) -> RRCrtc -> Display -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Display -> RRCrtc -> IO ()
lowerWindow RRCrtc
window