{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

-----------------------------------------------------------------------------
-- |
-- 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
-- 'XMonad.Hooks.TaffybarPagerHints.pagerHints' hook
-- being installed in your @~\/.xmonad\/xmonad.hs@ configuration:
--
-- > import XMonad.Hooks.TaffybarPagerHints (pagerHints)
-- >
-- > main = xmonad $ ewmh $ pagerHints $ ...
--
-----------------------------------------------------------------------------

module System.Taffybar.Information.X11DesktopInfo
  ( -- * Context
    X11Context
  , DisplayName(..)
  , getX11Context
  , withX11Context

  -- * Properties
  , X11Property
  , X11PropertyT

  -- ** Event loop
  , eventLoop

  -- ** Context getters
  , getDisplay
  , getAtom

  -- ** Basic properties of windows
  , X11Window
  , PropertyFetcher
  , fetch
  , readAsInt
  , readAsListOfInt
  , readAsListOfString
  , readAsListOfWindow
  , readAsString

  -- ** Getters
  , isWindowUrgent
  , getPrimaryOutputNumber
  , getVisibleTags

  -- ** Operations
  , doLowerWindow
  , postX11RequestSyncProp
  , sendCommandEvent
  , sendWindowEvent
  ) where

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.Default (Default(..))
import Data.List (elemIndex)
import Data.List.Split (endBy)
import Data.Maybe (fromMaybe, listToMaybe)
import GHC.Generics (Generic)
import Graphics.X11.Xrandr (XRRScreenResources(..), XRROutputInfo(..), xrrGetOutputInfo, xrrGetScreenResources, xrrGetOutputPrimary)
import System.Taffybar.Information.SafeX11 hiding (displayName)

-- | Represents a connection to an X11 display.
-- Use 'getX11Context' to construct one of these.
data X11Context = X11Context
  { X11Context -> DisplayName
ctxDisplayName :: DisplayName
  , X11Context -> Display
ctxDisplay :: Display
  , X11Context -> EventMask
ctxRoot :: Window
  , X11Context -> MVar [(String, EventMask)]
ctxAtomCache :: MV.MVar [(String, Atom)]
  }

-- | Specifies an X11 display to connect to.
data DisplayName = DefaultDisplay
                   -- ^ Use the @DISPLAY@ environment variable.
                 | DisplayName String
                   -- ^ Of the form @hostname:number.screen_number@
                 deriving (Int -> DisplayName -> ShowS
[DisplayName] -> ShowS
DisplayName -> String
(Int -> DisplayName -> ShowS)
-> (DisplayName -> String)
-> ([DisplayName] -> ShowS)
-> Show DisplayName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DisplayName -> ShowS
showsPrec :: Int -> DisplayName -> ShowS
$cshow :: DisplayName -> String
show :: DisplayName -> String
$cshowList :: [DisplayName] -> ShowS
showList :: [DisplayName] -> ShowS
Show, ReadPrec [DisplayName]
ReadPrec DisplayName
Int -> ReadS DisplayName
ReadS [DisplayName]
(Int -> ReadS DisplayName)
-> ReadS [DisplayName]
-> ReadPrec DisplayName
-> ReadPrec [DisplayName]
-> Read DisplayName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DisplayName
readsPrec :: Int -> ReadS DisplayName
$creadList :: ReadS [DisplayName]
readList :: ReadS [DisplayName]
$creadPrec :: ReadPrec DisplayName
readPrec :: ReadPrec DisplayName
$creadListPrec :: ReadPrec [DisplayName]
readListPrec :: ReadPrec [DisplayName]
Read, DisplayName -> DisplayName -> Bool
(DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool) -> Eq DisplayName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DisplayName -> DisplayName -> Bool
== :: DisplayName -> DisplayName -> Bool
$c/= :: DisplayName -> DisplayName -> Bool
/= :: DisplayName -> DisplayName -> Bool
Eq, Eq DisplayName
Eq DisplayName =>
(DisplayName -> DisplayName -> Ordering)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> Bool)
-> (DisplayName -> DisplayName -> DisplayName)
-> (DisplayName -> DisplayName -> DisplayName)
-> Ord DisplayName
DisplayName -> DisplayName -> Bool
DisplayName -> DisplayName -> Ordering
DisplayName -> DisplayName -> DisplayName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DisplayName -> DisplayName -> Ordering
compare :: DisplayName -> DisplayName -> Ordering
$c< :: DisplayName -> DisplayName -> Bool
< :: DisplayName -> DisplayName -> Bool
$c<= :: DisplayName -> DisplayName -> Bool
<= :: DisplayName -> DisplayName -> Bool
$c> :: DisplayName -> DisplayName -> Bool
> :: DisplayName -> DisplayName -> Bool
$c>= :: DisplayName -> DisplayName -> Bool
>= :: DisplayName -> DisplayName -> Bool
$cmax :: DisplayName -> DisplayName -> DisplayName
max :: DisplayName -> DisplayName -> DisplayName
$cmin :: DisplayName -> DisplayName -> DisplayName
min :: DisplayName -> DisplayName -> DisplayName
Ord, (forall x. DisplayName -> Rep DisplayName x)
-> (forall x. Rep DisplayName x -> DisplayName)
-> Generic DisplayName
forall x. Rep DisplayName x -> DisplayName
forall x. DisplayName -> Rep DisplayName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DisplayName -> Rep DisplayName x
from :: forall x. DisplayName -> Rep DisplayName x
$cto :: forall x. Rep DisplayName x -> DisplayName
to :: forall x. Rep DisplayName x -> DisplayName
Generic)

instance Default DisplayName where
  def :: DisplayName
def = DisplayName
DefaultDisplay

-- | Translate 'DisplayName' for use with 'openDisplay'.
fromDisplayName :: DisplayName -> String
fromDisplayName :: DisplayName -> String
fromDisplayName DisplayName
DefaultDisplay = String
""
fromDisplayName (DisplayName String
displayName) = String
displayName

-- | A 'ReaderT' with 'X11Context'.
type X11PropertyT m a = ReaderT X11Context m a
-- | 'IO' actions with access to an 'X11Context'.
type X11Property a = X11PropertyT IO a
type X11Window = Window
type PropertyFetcher a = Display -> Atom -> X11Window -> IO (Maybe [a])

-- | Makes a connection to the default X11 display using
-- 'getX11Context' and puts the current display and root window
-- objects inside a 'ReaderT' transformer for further computation.
withX11Context :: DisplayName -> X11Property a -> IO a
withX11Context :: forall a. DisplayName -> X11Property a -> IO a
withX11Context DisplayName
dn X11Property a
fun = do
  ctx <- DisplayName -> IO X11Context
getX11Context DisplayName
dn
  res <- runReaderT fun ctx
  closeDisplay (ctxDisplay ctx)
  return res

-- | An X11Property that returns the 'Display' object stored in the
-- 'X11Context'.
getDisplay :: X11Property Display
getDisplay :: X11Property Display
getDisplay = X11Context -> Display
ctxDisplay (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 EventMask
-> String
-> X11Property b
doRead b
b [a] -> b
transform PropertyFetcher a
windowPropFn Maybe EventMask
window String
name =
  b -> ([a] -> b) -> Maybe [a] -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
b [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 EventMask -> String -> ReaderT X11Context IO (Maybe [a])
forall a.
Integral a =>
PropertyFetcher a
-> Maybe EventMask -> String -> X11Property (Maybe [a])
fetch PropertyFetcher a
windowPropFn Maybe EventMask
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 EventMask -> String -> X11Property Int
readAsInt = Int
-> ([CLong] -> Int)
-> PropertyFetcher CLong
-> Maybe EventMask
-> String
-> X11Property Int
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe EventMask
-> 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
listToMaybe) 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 EventMask -> String -> X11Property [Int]
readAsListOfInt = [Int]
-> ([CLong] -> [Int])
-> PropertyFetcher CLong
-> Maybe EventMask
-> String
-> X11Property [Int]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe EventMask
-> 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 EventMask -> String -> X11Property String
readAsString = String
-> ([CChar] -> String)
-> PropertyFetcher CChar
-> Maybe EventMask
-> String
-> X11Property String
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe EventMask
-> 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 EventMask -> String -> X11Property [String]
readAsListOfString = [String]
-> ([CChar] -> [String])
-> PropertyFetcher CChar
-> Maybe EventMask
-> String
-> X11Property [String]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe EventMask
-> 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 EventMask -> String -> X11Property [EventMask]
readAsListOfWindow = [EventMask]
-> ([CLong] -> [EventMask])
-> PropertyFetcher CLong
-> Maybe EventMask
-> String
-> X11Property [EventMask]
forall a b.
Integral a =>
b
-> ([a] -> b)
-> PropertyFetcher a
-> Maybe EventMask
-> String
-> X11Property b
doRead [] ((CLong -> EventMask) -> [CLong] -> [EventMask]
forall a b. (a -> b) -> [a] -> [b]
map CLong -> EventMask
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 :: EventMask -> X11Property Bool
isWindowUrgent EventMask
window = do
  hints <- EventMask -> X11Property WMHints
fetchWindowHints EventMask
window
  return $ testBit (wmh_flags hints) urgencyHintBit

-- | Retrieve the value of the special @_XMONAD_VISIBLE_WORKSPACES@
-- hint set by the 'XMonad.Hooks.TaffybarPagerHints.pagerHints' hook
-- provided by [xmonad-contrib]("XMonad.Hooks.TaffybarPagerHints")
-- (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 EventMask -> String -> X11Property [String]
readAsListOfString Maybe EventMask
forall a. Maybe a
Nothing String
"_XMONAD_VISIBLE_WORKSPACES"

-- | Return the 'Atom' with the given name.
getAtom :: String -> X11Property Atom
getAtom :: String -> X11Property EventMask
getAtom String
s = do
  d <- (X11Context -> Display) -> X11Property Display
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks X11Context -> Display
ctxDisplay
  cacheVar <- asks ctxAtomCache
  a <- lift $ lookup s <$> MV.readMVar cacheVar
  let updateCacheAction = IO EventMask -> X11Property EventMask
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 EventMask -> X11Property EventMask)
-> IO EventMask -> X11Property EventMask
forall a b. (a -> b) -> a -> b
$ MVar [(String, EventMask)]
-> ([(String, EventMask)] -> IO ([(String, EventMask)], EventMask))
-> IO EventMask
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
MV.modifyMVar MVar [(String, EventMask)]
cacheVar [(String, EventMask)] -> IO ([(String, EventMask)], EventMask)
updateCache
      updateCache [(String, EventMask)]
currentCache =
        do
          atom <- Display -> String -> Bool -> IO EventMask
internAtom Display
d String
s Bool
False
          return ((s, atom):currentCache, atom)
  maybe updateCacheAction return 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
  d <- (X11Context -> Display) -> X11Property Display
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks X11Context -> Display
ctxDisplay
  w <- asks ctxRoot
  liftIO $ do
    selectInput d w $ propertyChangeMask .|. substructureNotifyMask
    allocaXEvent $ \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 <- 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 of
        MapNotifyEvent { ev_window :: Event -> EventMask
ev_window = EventMask
window } ->
          Display -> EventMask -> EventMask -> IO ()
selectInput Display
d EventMask
window EventMask
propertyChangeMask
        Event
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      dispatch 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 :: EventMask -> EventMask -> X11Property ()
sendCommandEvent EventMask
cmd EventMask
arg = EventMask -> EventMask -> Maybe EventMask -> X11Property ()
sendCustomEvent EventMask
cmd EventMask
arg Maybe EventMask
forall a. Maybe a
Nothing

-- | Similar to 'sendCommandEvent', but with an argument of type 'X11Window'.
sendWindowEvent :: Atom -> X11Window -> X11Property ()
sendWindowEvent :: EventMask -> EventMask -> X11Property ()
sendWindowEvent EventMask
cmd EventMask
win = EventMask -> EventMask -> Maybe EventMask -> X11Property ()
sendCustomEvent EventMask
cmd EventMask
cmd (EventMask -> Maybe EventMask
forall a. a -> Maybe a
Just EventMask
win)

-- | Builds a new 'X11Context' containing a connection to the default
-- X11 display and its root window.
--
-- If the X11 connection could not be opened, it will throw
-- @'Control.Exception.userError' "openDisplay"@. This can occur if the
-- @X -maxclients@ limit has been exceeded.
getX11Context :: DisplayName -> IO X11Context
getX11Context :: DisplayName -> IO X11Context
getX11Context DisplayName
ctxDisplayName = do
  d <- String -> IO Display
openDisplay (String -> IO Display) -> String -> IO Display
forall a b. (a -> b) -> a -> b
$ DisplayName -> String
fromDisplayName DisplayName
ctxDisplayName
  ctxRoot <- rootWindow d $ defaultScreen d
  ctxAtomCache <- MV.newMVar []
  return $ X11Context{ctxDisplay=d,..}

-- | 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 EventMask -> String -> X11Property (Maybe [a])
fetch PropertyFetcher a
fetcher Maybe EventMask
window String
name = do
  X11Context{..} <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  atom <- getAtom name
  liftIO $ fetcher ctxDisplay atom (fromMaybe ctxRoot window)

-- | Retrieve the @WM_HINTS@ mask assigned by the X server to the given window.
fetchWindowHints :: X11Window -> X11Property WMHints
fetchWindowHints :: EventMask -> X11Property WMHints
fetchWindowHints EventMask
window = do
  d <- X11Property Display
getDisplay
  liftIO $ getWMHints d window

-- | Emit an event of type @ClientMessage@ that can be listened to and consumed
-- by XMonad event hooks.
sendCustomEvent :: Atom -- ^ Command
                -> Atom -- ^ Argument
                -> Maybe X11Window -- ^ 'Just' a window, or 'Nothing' for the root window
                -> X11Property ()
sendCustomEvent :: EventMask -> EventMask -> Maybe EventMask -> X11Property ()
sendCustomEvent EventMask
cmd EventMask
arg Maybe EventMask
win = do
  X11Context{..} <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let win' = EventMask -> Maybe EventMask -> EventMask
forall a. a -> Maybe a -> a
fromMaybe EventMask
ctxRoot Maybe EventMask
win
  liftIO $ allocaXEvent $ \XEventPtr
e -> do
    XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
    XEventPtr
-> EventMask
-> EventMask
-> CInt
-> EventMask
-> EventMask
-> IO ()
setClientMessageEvent XEventPtr
e EventMask
win' EventMask
cmd CInt
32 EventMask
arg EventMask
currentTime
    Display -> EventMask -> Bool -> EventMask -> XEventPtr -> IO ()
sendEvent Display
ctxDisplay EventMask
ctxRoot Bool
False EventMask
structureNotifyMask XEventPtr
e
    Display -> Bool -> IO ()
sync Display
ctxDisplay 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
a = do
  c <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  let action = X11Property a -> X11Context -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT X11Property a
prop X11Context
c
  lift $ postX11RequestSyncDef a action

-- | 'X11Property' which reflects whether or not the provided 'RROutput' is active.
isActiveOutput :: XRRScreenResources -> RROutput -> X11Property Bool
isActiveOutput :: XRRScreenResources -> EventMask -> X11Property Bool
isActiveOutput XRRScreenResources
sres EventMask
output = do
  display <- X11Property Display
getDisplay
  maybeOutputInfo <- liftIO $ xrrGetOutputInfo display sres output
  return $ maybe 0 xrr_oi_crtc maybeOutputInfo /= 0

-- | Return all the active RANDR outputs.
getActiveOutputs :: X11Property [RROutput]
getActiveOutputs :: X11Property [EventMask]
getActiveOutputs = do
  X11Context{..} <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  liftIO (xrrGetScreenResources ctxDisplay ctxRoot) >>= \case
    Just XRRScreenResources
sres -> (EventMask -> X11Property Bool)
-> [EventMask] -> X11Property [EventMask]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (XRRScreenResources -> EventMask -> X11Property Bool
isActiveOutput XRRScreenResources
sres) (XRRScreenResources -> [EventMask]
xrr_sr_outputs XRRScreenResources
sres)
    Maybe XRRScreenResources
Nothing -> [EventMask] -> X11Property [EventMask]
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Get the index of the primary monitor as set and ordered by Xrandr.
getPrimaryOutputNumber :: X11Property (Maybe Int)
getPrimaryOutputNumber :: X11Property (Maybe Int)
getPrimaryOutputNumber = do
  X11Context{..} <- ReaderT X11Context IO X11Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  primary <- liftIO $ xrrGetOutputPrimary ctxDisplay ctxRoot
  outputs <- getActiveOutputs
  return $ primary `elemIndex` outputs

-- | Move the given 'X11Window' to the bottom of the X11 window stack.
doLowerWindow :: X11Window -> X11Property ()
doLowerWindow :: EventMask -> X11Property ()
doLowerWindow EventMask
window =
  (X11Context -> Display) -> X11Property Display
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks X11Context -> Display
ctxDisplay 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 -> EventMask -> IO ()) -> EventMask -> Display -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Display -> EventMask -> IO ()
lowerWindow EventMask
window