    -----------------------------------------------------------------------------
    -- |
    -- 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 a. a -> X a
    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 => 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 a. a -> X a
    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 a. [a] -> 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 a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s''
                                                              then String
    s''
                                                              else String -> String
    forall a. HasCallStack => [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 a. a -> X a
    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 a. [a] -> 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 a. [a] -> 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 a b. (a -> b) -> [a] -> [b]
    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 a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
          String -> X String
    forall a. a -> X a
    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 a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. a -> X a
    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 a. a -> X a
    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 a. [a] -> 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 a. 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 a. a -> X a
    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 a. a -> X a
    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 a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Atom -> Atom -> X String
    getDecodedStringProp Atom
    w) (String -> X String
    forall a. a -> X a
    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 a b. (a -> b) -> [a] -> [b]
    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 a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
      String -> X String
    forall a. a -> X a
    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 a. a -> X a
    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 a. a -> X a
    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 a. a -> X a
    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 a. a -> X a
    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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    pfx) String
    s)
                                         else
                                           String -> X String
    forall a. a -> X a
    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 a. a -> X a
    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 a. a -> X a
    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 a b. X a -> (a -> X b) -> X b
    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')