-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.DebugWindow
-- Description :  Dump window information for diagnostic\/debugging purposes.
-- Copyright   :  (c) Brandon S Allbery KF8NH, 2014
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  allbery.b@gmail.com
-- Stability   :  unstable
-- Portability :  not portable
--
-- Module to dump window information for diagnostic/debugging purposes. See
-- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.
--
-----------------------------------------------------------------------------

module XMonad.Util.DebugWindow (debugWindow) where

import           Prelude

import           XMonad
import           XMonad.Prelude

import           Codec.Binary.UTF8.String        (decodeString)
import           Control.Exception                                     as E
import           Foreign.C.String
import           Numeric                         (showHex)
import           System.Exit

-- | Output a window by ID in hex, decimal, its ICCCM resource name and class,
--   its title if available, and EWMH type and state if available.  Also
--   indicate override_redirect with an exclamation mark, and wrap in brackets
--   if it is unmapped or withdrawn.
debugWindow   :: Window -> X String
debugWindow :: Atom -> X String
debugWindow Atom
0 =  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"-no window-"
debugWindow Atom
w =  do
  Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  let wx :: String
wx = Int -> Char -> String -> String
pad Int
8 Char
'0' (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Atom -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex Atom
w String
""
  Maybe WindowAttributes
w' <- Atom -> X (Maybe WindowAttributes)
safeGetWindowAttributes Atom
w
  case Maybe WindowAttributes
w' of
    Maybe WindowAttributes
Nothing                                   ->
      String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ String
"(deleted window " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
wx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    Just WindowAttributes
      { wa_x :: WindowAttributes -> CInt
wa_x                 = CInt
x
      , wa_y :: WindowAttributes -> CInt
wa_y                 = CInt
y
      , wa_width :: WindowAttributes -> CInt
wa_width             = CInt
wid
      , wa_height :: WindowAttributes -> CInt
wa_height            = CInt
ht
      , wa_border_width :: WindowAttributes -> CInt
wa_border_width      = CInt
bw
      , wa_map_state :: WindowAttributes -> CInt
wa_map_state         = CInt
m
      , wa_override_redirect :: WindowAttributes -> Bool
wa_override_redirect = Bool
o
      } -> do
      Maybe [CChar]
c' <- IO (Maybe [CChar]) -> X (Maybe [CChar])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Atom -> Atom -> IO (Maybe [CChar])
getWindowProperty8 Display
d Atom
wM_CLASS Atom
w)
      let c :: String
c = case Maybe [CChar]
c' of
                Maybe [CChar]
Nothing -> String
""
                Just [CChar]
c''  -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"/" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                             ((String -> Maybe (String, String)) -> String -> [String])
-> String -> (String -> Maybe (String, String)) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Maybe (String, String)) -> String -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ((CChar -> Char) -> [CChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CChar -> Int) -> CChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int
forall a. Enum a => a -> Int
fromEnum) [CChar]
c'') ((String -> Maybe (String, String)) -> [String])
-> (String -> Maybe (String, String)) -> [String]
forall a b. (a -> b) -> a -> b
$
                             \String
s -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s
                                     then Maybe (String, String)
forall a. Maybe a
Nothing
                                     else let (String
w'',String
s'') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL') String
s
                                              s' :: String
s'      = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s''
                                                          then String
s''
                                                          else String -> String
forall a. [a] -> [a]
tail String
s''
                                          in (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
w'',String
s')
      String
t <- X String -> X String -> X String
forall a. X a -> X a -> X a
catchX' (String -> String
wrap (String -> String) -> X String -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Atom -> X String
getEWMHTitle  String
"VISIBLE" Atom
w) (X String -> X String) -> X String -> X String
forall a b. (a -> b) -> a -> b
$
           X String -> X String -> X String
forall a. X a -> X a -> X a
catchX' (String -> String
wrap (String -> String) -> X String -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Atom -> X String
getEWMHTitle  String
""        Atom
w) (X String -> X String) -> X String -> X String
forall a b. (a -> b) -> a -> b
$
           X String -> X String -> X String
forall a. X a -> X a -> X a
catchX' (String -> String
wrap (String -> String) -> X String -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Atom -> X String
getICCCMTitle           Atom
w) (X String -> X String) -> X String -> X String
forall a b. (a -> b) -> a -> b
$
           String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
      String
h' <- Atom -> X String
getMachine Atom
w
      let h :: String
h = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
h' then String
"" else Char
'@'Char -> String -> String
forall a. a -> [a] -> [a]
:String
h'
      -- if it has WM_COMMAND use it, else use the appName
      -- NB. modern stuff often does not set WM_COMMAND since it's only ICCCM required and not some
      -- horrible gnome/freedesktop session manager thing like Wayland intended. How helpful of them.
      [String]
p' <- Display -> Atom -> X [String]
safeGetCommand Display
d Atom
w
      let p :: String
p = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
p' then String
"" else String -> String
wrap (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
p'
      Atom
nWP <- String -> X Atom
getAtom String
"_NET_WM_PID"
      Maybe [CLong]
pid' <- IO (Maybe [CLong]) -> X (Maybe [CLong])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CLong]) -> X (Maybe [CLong]))
-> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CLong])
getWindowProperty32 Display
d Atom
nWP Atom
w
      let pid :: String
pid = case Maybe [CLong]
pid' of
                  Just [CLong
pid''] -> Char
'('Char -> String -> String
forall a. a -> [a] -> [a]
:CLong -> String
forall a. Show a => a -> String
show CLong
pid'' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                  Maybe [CLong]
_            -> String
""
      let cmd :: String
cmd = String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h
      let (String
lb,String
rb) = case () of
                      () | CInt
m CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
waIsViewable -> (String
"",String
"")
                         | Bool
otherwise         -> (String
"[",String
"]")
          o' :: String
o'      = if Bool
o then String
"!" else String
""
      Atom
wT <- String -> X Atom
getAtom String
"_NET_WM_WINDOW_TYPE"
      Maybe [CLong]
wt' <- IO (Maybe [CLong]) -> X (Maybe [CLong])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CLong]) -> X (Maybe [CLong]))
-> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CLong])
getWindowProperty32 Display
d Atom
wT Atom
w
      String
ewmh <- case Maybe [CLong]
wt' of
                Just [CLong]
wt'' -> Display -> Atom -> [Atom] -> X String
windowType Display
d Atom
w ((CLong -> Atom) -> [CLong] -> [Atom]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CLong -> Atom
forall a b. (Integral a, Num b) => a -> b
fi [CLong]
wt'')
                Maybe [CLong]
_         -> String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
      String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
lb
                      ,String
o'
                      ,String
wx
                      ,String
t
                      ,String
" "
                      ,CInt -> String
forall a. Show a => a -> String
show CInt
wid
                      ,Char
'x'Char -> String -> String
forall a. a -> [a] -> [a]
:CInt -> String
forall a. Show a => a -> String
show CInt
ht
                      ,if CInt
bw CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0 then String
"" else Char
'+'Char -> String -> String
forall a. a -> [a] -> [a]
:CInt -> String
forall a. Show a => a -> String
show CInt
bw
                      ,String
"@"
                      ,CInt -> String
forall a. Show a => a -> String
show CInt
x
                      ,Char
','Char -> String -> String
forall a. a -> [a] -> [a]
:CInt -> String
forall a. Show a => a -> String
show CInt
y
                      ,if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c then String
"" else Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
c
                      ,if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd then String
"" else Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
cmd
                      ,String
ewmh
                      ,String
rb
                      ]

getEWMHTitle       :: String -> Window -> X String
getEWMHTitle :: String -> Atom -> X String
getEWMHTitle String
sub Atom
w =  do
  Atom
a <- String -> X Atom
getAtom (String -> X Atom) -> String -> X Atom
forall a b. (a -> b) -> a -> b
$ String
"_NET_WM_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sub then String
"" else Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sub) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_NAME"
  (Just [CLong]
t) <- (Display -> X (Maybe [CLong])) -> X (Maybe [CLong])
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe [CLong])) -> X (Maybe [CLong]))
-> (Display -> X (Maybe [CLong])) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CLong]) -> X (Maybe [CLong]))
-> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CLong])
getWindowProperty32 Display
d Atom
a Atom
w
  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ (CLong -> Char) -> [CLong] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CLong -> Int) -> CLong -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> Int
forall a. Enum a => a -> Int
fromEnum) [CLong]
t

getICCCMTitle   :: Window -> X String
getICCCMTitle :: Atom -> X String
getICCCMTitle Atom
w =  Atom -> Atom -> X String
getDecodedStringProp Atom
w Atom
wM_NAME

getDecodedStringProp     :: Window -> Atom -> X String
getDecodedStringProp :: Atom -> Atom -> X String
getDecodedStringProp Atom
w Atom
a =  do
  t :: TextProperty
t@(TextProperty CString
t' Atom
_ CInt
8 Atom
_) <- (Display -> X TextProperty) -> X TextProperty
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X TextProperty) -> X TextProperty)
-> (Display -> X TextProperty) -> X TextProperty
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO TextProperty -> X TextProperty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO TextProperty -> X TextProperty)
-> IO TextProperty -> X TextProperty
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO TextProperty
getTextProperty Display
d Atom
w Atom
a
  [String
s] <- X [String] -> X [String] -> X [String]
forall a. X a -> X a -> X a
catchX' (TextProperty -> X [String]
tryUTF8     TextProperty
t) (X [String] -> X [String]) -> X [String] -> X [String]
forall a b. (a -> b) -> a -> b
$
         X [String] -> X [String] -> X [String]
forall a. X a -> X a -> X a
catchX' (TextProperty -> X [String]
tryCompound TextProperty
t) (X [String] -> X [String]) -> X [String] -> X [String]
forall a b. (a -> b) -> a -> b
$
         IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io ((String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
t')
  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

tryUTF8                          :: TextProperty -> X [String]
tryUTF8 :: TextProperty -> X [String]
tryUTF8 (TextProperty CString
s Atom
enc CInt
_ Atom
_) =  do
  Atom
uTF8_STRING <- String -> X Atom
getAtom String
"UTF8_STRING"
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Atom
enc Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
/= Atom
uTF8_STRING) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ String -> X ()
forall a. HasCallStack => String -> a
error String
"String is not UTF8_STRING"
  (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
decodeString ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitNul (String -> [String]) -> X String -> X [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> X String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (CString -> IO String
peekCString CString
s)

tryCompound                            :: TextProperty -> X [String]
tryCompound :: TextProperty -> X [String]
tryCompound t :: TextProperty
t@(TextProperty CString
_ Atom
enc CInt
_ Atom
_) =  do
  Atom
cOMPOUND_TEXT <- String -> X Atom
getAtom String
"COMPOUND_TEXT"
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Atom
enc Atom -> Atom -> Bool
forall a. Eq a => a -> a -> Bool
/= Atom
cOMPOUND_TEXT) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ String -> X ()
forall a. HasCallStack => String -> a
error String
"String is not COMPOUND_TEXT"
  (Display -> X [String]) -> X [String]
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X [String]) -> X [String])
-> (Display -> X [String]) -> X [String]
forall a b. (a -> b) -> a -> b
$ \Display
d -> IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [String] -> X [String]) -> IO [String] -> X [String]
forall a b. (a -> b) -> a -> b
$ Display -> TextProperty -> IO [String]
wcTextPropertyToTextList Display
d TextProperty
t

splitNul    :: String -> [String]
splitNul :: String -> [String]
splitNul String
"" =  []
splitNul String
s  =  let (String
s',String
ss') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL') String
s in String
s' String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> [String]
splitNul String
ss'

pad       :: Int -> Char -> String -> String
pad :: Int -> Char -> String -> String
pad Int
w Char
c String
s =  Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- modified 'catchX' without the print to 'stderr'
catchX' :: X a -> X a -> X a
catchX' :: forall a. X a -> X a -> X a
catchX' X a
job X a
errcase = do
  XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
  XConf
c <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  (a
a, XState
s') <- IO (a, XState) -> X (a, XState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (a, XState) -> X (a, XState))
-> IO (a, XState) -> X (a, XState)
forall a b. (a -> b) -> a -> b
$ XConf -> XState -> X a -> IO (a, XState)
forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
job IO (a, XState)
-> (SomeException -> IO (a, XState)) -> IO (a, XState)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
    Just ExitCode
x -> SomeException -> IO (a, XState)
forall a e. Exception e => e -> a
throw SomeException
e IO (a, XState) -> ExitCode -> IO (a, XState)
forall a b. a -> b -> a
`const` (ExitCode
x ExitCode -> ExitCode -> ExitCode
forall a. a -> a -> a
`asTypeOf` ExitCode
ExitSuccess)
    Maybe ExitCode
_      -> XConf -> XState -> X a -> IO (a, XState)
forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
errcase
  XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s'
  a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

wrap   :: String -> String
wrap :: String -> String
wrap String
s =  Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
wrap' String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    wrap' :: String -> String
wrap' (Char
s':String
ss) | Char
s' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'  = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
s' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
wrap' String
ss
                  | Char
s' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
s' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
wrap' String
ss
                  | Bool
otherwise  =        Char
s' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
wrap' String
ss
    wrap' String
""                   =             String
""

-- and so is getCommand
safeGetCommand     :: Display -> Window -> X [String]
safeGetCommand :: Display -> Atom -> X [String]
safeGetCommand Display
d Atom
w =  do
  Atom
wC <- String -> X Atom
getAtom String
"WM_COMMAND"
  Maybe [CChar]
p <- IO (Maybe [CChar]) -> X (Maybe [CChar])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CChar]) -> X (Maybe [CChar]))
-> IO (Maybe [CChar]) -> X (Maybe [CChar])
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CChar])
getWindowProperty8 Display
d Atom
wC Atom
w
  case Maybe [CChar]
p of
    Maybe [CChar]
Nothing  -> [String] -> X [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just [CChar]
cs' -> do
      let cs :: String
cs                    = (CChar -> Char) -> [CChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (CChar -> Int) -> CChar -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> Int
forall a. Enum a => a -> Int
fromEnum) [CChar]
cs'
          go :: ([String], (String, String)) -> ([String], (String, String))
go  ([String]
a,(String
s,String
"\NUL"))    = (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
a,(String
"",String
""))
          go  ([String]
a,(String
s,Char
'\NUL':String
ss)) = ([String], (String, String)) -> ([String], (String, String))
go (String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
a,String -> (String, String)
go' String
ss)
          go  ([String], (String, String))
r                 = ([String], (String, String))
r -- ???
          go' :: String -> (String, String)
go'                   = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL')
       in [String] -> X [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> X [String]) -> [String] -> X [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String], (String, String)) -> [String]
forall a b. (a, b) -> a
fst (([String], (String, String)) -> [String])
-> ([String], (String, String)) -> [String]
forall a b. (a -> b) -> a -> b
$ ([String], (String, String)) -> ([String], (String, String))
go ([],String -> (String, String)
go' String
cs)

getMachine   :: Window -> X String
getMachine :: Atom -> X String
getMachine Atom
w =  X String -> X String -> X String
forall a. X a -> X a -> X a
catchX' (String -> X Atom
getAtom String
"WM_CLIENT_MACHINE" X Atom -> (Atom -> X String) -> X String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Atom -> Atom -> X String
getDecodedStringProp Atom
w) (String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"")

-- if it's one EWMH atom then we strip prefix and lowercase, otherwise we
-- return the whole thing. we also get the state here, with similar rules
-- (all EWMH = all prefixes removed and lowercased)
windowType        :: Display -> Window -> [Atom] -> X String
windowType :: Display -> Atom -> [Atom] -> X String
windowType Display
d Atom
w [Atom]
ts =  do
  String
tstr <- [Atom] -> X String
decodeType [Atom]
ts
  Atom
wS <- String -> X Atom
getAtom String
"_NET_WM_STATE"
  Maybe [CLong]
ss' <- IO (Maybe [CLong]) -> X (Maybe [CLong])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe [CLong]) -> X (Maybe [CLong]))
-> IO (Maybe [CLong]) -> X (Maybe [CLong])
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> Atom -> IO (Maybe [CLong])
getWindowProperty32 Display
d Atom
wS Atom
w
  String
sstr <- case Maybe [CLong]
ss' of
            Just [CLong]
ss -> [Atom] -> X String
windowState ((CLong -> Atom) -> [CLong] -> [Atom]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CLong -> Atom
forall a b. (Integral a, Num b) => a -> b
fi [CLong]
ss)
            Maybe [CLong]
_       -> String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
sstr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  where
    decodeType     :: [Atom] -> X String
    decodeType :: [Atom] -> X String
decodeType []  =  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    decodeType [Atom
t] =  String -> Atom -> X String
simplify String
"_NET_WM_WINDOW_TYPE_" Atom
t
    decodeType [Atom]
tys =  [Atom] -> String -> Bool -> X String
unAtoms [Atom]
tys String
" (" Bool
False

    unAtoms             :: [Atom] -> String -> Bool -> X String
    unAtoms :: [Atom] -> String -> Bool -> X String
unAtoms []     String
t Bool
i  =  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ if Bool
i then String
t else String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    unAtoms (Atom
a:[Atom]
as) String
t Bool
i  =  do
                            Maybe String
s' <- IO (Maybe String) -> X (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe String) -> X (Maybe String))
-> IO (Maybe String) -> X (Maybe String)
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO (Maybe String)
getAtomName Display
d Atom
a
                            let s :: String
s = case Maybe String
s' of
                                      Just String
s'' -> String
s''
                                      Maybe String
_        -> Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:Atom -> String
forall a. Show a => a -> String
show Atom
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
                            [Atom] -> String -> Bool -> X String
unAtoms [Atom]
as (String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
i then Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s else String
s)) Bool
True
    
    simplify       :: String -> Atom -> X String
    simplify :: String -> Atom -> X String
simplify String
pfx Atom
a =  do
                        Maybe String
s' <- IO (Maybe String) -> X (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe String) -> X (Maybe String))
-> IO (Maybe String) -> X (Maybe String)
forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO (Maybe String)
getAtomName Display
d Atom
a
                        case Maybe String
s' of
                          Maybe String
Nothing -> String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ Char
'<'Char -> String -> String
forall a. a -> [a] -> [a]
:Atom -> String
forall a. Show a => a -> String
show Atom
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
                          Just String
s  -> if String
pfx String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s then
                                       String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> X String) -> String -> X String
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
pfx) String
s)
                                     else
                                       String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

    -- note that above it says this checks all of them before simplifying.
    -- I'll do that after I'm confident this works as intended.    
    windowState     :: [Atom] -> X String
    windowState :: [Atom] -> X String
windowState []  =  String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    windowState [Atom]
as' =  [Atom] -> String -> X String
go [Atom]
as' String
";"
      where
        go :: [Atom] -> String -> X String
go []     String
t = String -> X String
forall (m :: * -> *) a. Monad m => a -> m a
return String
t
        go (Atom
a:[Atom]
as) String
t = String -> Atom -> X String
simplify String
"_NET_WM_STATE_" Atom
a X String -> (String -> X String) -> X String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
t' -> [Atom] -> String -> X String
go [Atom]
as (String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
t')