    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.DebugStack
    -- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  allbery.b@gmail.com
    -- Stability   :  unstable
    -- Portability :  not portable
    --
    -- Dump the state of the 'StackSet'.  A @logHook@ and @handleEventHook@ are
    -- also provided.
    --
    -----------------------------------------------------------------------------

    module XMonad.Hooks.DebugStack (debugStack
                                   ,debugStackString
                                   ,debugStackLogHook
                                   ,debugStackEventHook
                                   ) where

    import           XMonad.Core
    import qualified XMonad.StackSet         as W

    import           XMonad.Util.DebugWindow

    import           Graphics.X11.Types                  (Window)
    import           Graphics.X11.Xlib.Extras            (Event)

    import           Control.Monad                       (foldM)
    import           Data.Map                            (toList)
    import           Data.Monoid                         (All(..))

    -- | Print the state of the current window stack to @stderr@, which for most
    --   installations goes to @~/.xsession-errors@.  "XMonad.Util.DebugWindow"
    --   is used to display the individual windows.
    debugStack :: X ()
    debugStack =  debugStackString >>= trace

    -- | The above packaged as a 'logHook'.  (Currently this is identical.)
    debugStackLogHook :: X ()
    debugStackLogHook =  debugStack

    -- | The above packaged as a 'handleEventHook'.  You almost certainly do not
    --   want to use this unconditionally, as it will cause massive amounts of
    --   output and possibly slow @xmonad@ down severely.

    debugStackEventHook   :: Event -> X All
    debugStackEventHook _ =  debugStack >> return (All True)

    -- | Dump the state of the current 'StackSet' as a multiline 'String'.
    --   @
    --   stack [    mm
    --         ,(*) ww
    --         ,    ww
    --         ]
    --   float {    ww
    --         ,    ww
    --         }
    --   @
    --
    -- One thing I'm not sure of is where the zipper is when focus is on a
    -- floating window.
    debugStackString :: X String
    debugStackString =  withWindowSet $ \ws -> do
                          s <- emit "stack" ("[","]") (W.peek ws)                    $ W.index    ws
                          f <- emit "float" ("{","}") (W.peek ws) $ map fst $ toList $ W.floating ws
                          return $ s ++ f
      where
        emit :: String -> (String,String) -> Maybe Window -> [Window] -> X String
        emit title (lb,rb) _       [] = return $ title ++ " " ++ lb ++ rb ++ "]\n"
        emit title (lb,rb) focused ws = do
          (_,_,_,_,ss) <- foldM emit' (title,lb,rb,focused,"") ws
          return $ ss                               ++
                   replicate (length title + 1) ' ' ++
                   rb                               ++
                   "\n"

        emit' :: (String,String,String,Maybe Window,String)
              -> Window
              -> X (String,String,String,Maybe Window,String)
        emit' (t,l,r,f,a) w = do
          w' <- emit'' f w
          return (replicate (length t) ' '
                 ,',' : replicate (length l - 1) ' '
                 ,r
                 ,f
                 ,a ++ t ++ " " ++ l ++ w' ++ "\n"
                 )
        emit'' :: Maybe Window -> Window -> X String
        emit'' focus win =
          let fi f = if win == f then "(*) " else "    "
           in (maybe "    " fi focus ++) `fmap` debugWindow win