    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Util.DebugWindow
    -- 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           Codec.Binary.UTF8.String        (decodeString)
    import           Control.Exception.Extensible                          as E
    import           Control.Monad                   (when)
    import           Data.List                       (unfoldr
                                                     ,intercalate
                                                     )
    import           Foreign
    import           Foreign.C.String
    import           Numeric                         (showHex)
    import           System.Exit

    -- | Output a window by ID in hex, decimal, its ICCCM resource name and class,
    --   and its title 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 0 =  return "-no window-"
    debugWindow w =  do
      let wx = pad 8 '0' $ showHex w ""
      w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)
      case w' of
        Nothing                                   ->
          return $ "(deleted window " ++ wx ++ ")"
        Just (WindowAttributes x y wid ht bw m o) -> do
          c' <- withDisplay $ \d ->
                io (getWindowProperty8 d wM_CLASS w)
          let c = case c' of
                    Nothing -> ""
                    Just c''  -> intercalate "/" $
                                 flip unfoldr (map (toEnum . fromEnum) c'') $
                                 \s -> if null s
                                         then Nothing
                                         else let (w'',s'') = break (== '\NUL') s
                                                  s'      = if null s''
                                                              then s''
                                                              else tail s''
                                              in Just (w'',s')
          t <- catchX' (wrap `fmap` getEWMHTitle  "VISIBLE" w) $
               catchX' (wrap `fmap` getEWMHTitle  ""        w) $
               catchX' (wrap `fmap` getICCCMTitle           w) $
               return ""
          h' <- getMachine w
          let h = if null h' then "" else '@':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.
          p' <- withDisplay $ \d -> safeGetCommand d w
          let p = if null p' then "" else wrap $ intercalate " " p'
          nWP <- getAtom "_NET_WM_PID"
          pid' <- withDisplay $ \d -> io $ getWindowProperty32 d nWP w
          let pid = case pid' of
                      Just [pid''] -> '(':show pid'' ++ ")"
                      _            -> ""
          let cmd = p ++ pid ++ h
          let (lb,rb) = case () of
                          () | m == waIsViewable -> ("","")
                             | otherwise         -> ("[","]")
              o'      = if o then "!" else ""
          return $ concat [lb
                          ,o'
                          ,wx
                          ,t
                          ," "
                          ,show wid
                          ,'x':show ht
                          ,if bw == 0 then "" else '+':show bw
                          ,"@"
                          ,show x
                          ,',':show y
                          ,if null c then "" else ' ':c
                          ,if null cmd then "" else ' ':cmd
                          ,rb
                          ]

    getEWMHTitle       :: String -> Window -> X String
    getEWMHTitle sub w =  do
      a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME"
      (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w
      return $ map (toEnum . fromEnum) t

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

    getDecodedStringProp     :: Window -> Atom -> X String
    getDecodedStringProp w a =  do
      t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w a
      [s] <- catchX' (tryUTF8     t) $
             catchX' (tryCompound t) $
             io ((:[]) `fmap` peekCString t')
      return s

    tryUTF8                          :: TextProperty -> X [String]
    tryUTF8 (TextProperty s enc _ _) =  do
      uTF8_STRING <- getAtom "UTF8_STRING"
      when (enc == uTF8_STRING) $ error "String is not UTF8_STRING"
      (map decodeString . splitNul) `fmap` io (peekCString s)

    tryCompound                            :: TextProperty -> X [String]
    tryCompound t@(TextProperty _ enc _ _) =  do
      cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT"
      when (enc == cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT"
      withDisplay $ \d -> io $ wcTextPropertyToTextList d t

    splitNul    :: String -> [String]
    splitNul "" =  []
    splitNul s  =  let (s',ss') = break (== '\NUL') s in s' : splitNul ss'

    pad       :: Int -> Char -> String -> String
    pad w c s =  replicate (w - length s) c ++ s

    -- modified 'catchX' without the print to 'stderr'
    catchX' :: X a -> X a -> X a
    catchX' job errcase = do
      st <- get
      c <- ask
      (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
        Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
        _ -> runX c st errcase
      put s'
      return a

    wrap   :: String -> String
    wrap s =  ' ' : '"' : wrap' s ++ "\""
      where
        wrap' (s':ss) | s' == '"'  = '\\' : s' : wrap' ss
                      | s' == '\\' = '\\' : s' : wrap' ss
                      | otherwise  =        s' : wrap' ss
        wrap' ""                   =             ""

    -- Graphics.X11.Extras.getWindowAttributes is bugggggggy
    safeGetWindowAttributes     :: Display -> Window -> IO (Maybe WindowAttributes)
    safeGetWindowAttributes d w =  alloca $ \p -> do
      s <- xGetWindowAttributes d w p
      case s of
        0 -> return Nothing
        _ -> Just `fmap` peek p

    -- and so is getCommand
    safeGetCommand     :: Display -> Window -> X [String]
    safeGetCommand d w =  do
      wC <- getAtom "WM_COMMAND"
      p <- io $ getWindowProperty8 d wC w
      case p of
        Nothing  -> return []
        Just cs' -> do
          let cs                    = map (toEnum . fromEnum) cs'
              go  (a,(s,"\NUL"))    = (s:a,("",""))
              go  (a,(s,'\NUL':ss)) = go (s:a,go' ss)
              go  r                 = r -- ???
              go'                   = break (== '\NUL')
           in return $ reverse $ fst $ go ([],go' cs)

    getMachine   :: Window -> X String
    getMachine w =  catchX' (getAtom "WM_CLIENT_MACHINE" >>= getDecodedStringProp w) (return "")