content: -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Hooks.DebugStack
  -- Copyright   :  (c) Brandon S Allbery KF8NH, 2014
  -- 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
                                 ,debugStackFull
                                 ,debugStackString
                                 ,debugStackFullString
                                 ,debugStackLogHook
                                 ,debugStackFullLogHook
                                 ,debugStackEventHook
                                 ,debugStackFullEventHook
                                 ) 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                            (member)
  import           Data.Monoid                         (All(..))
  import           Data.List                           (intercalate)
  
  -- | Print the state of the current window stack for the current workspace 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
  
  -- | Print the state of the current window stack for all workspaces to
  --   @stderr@, which for most installations goes to @~/.xsession-errors@.
  --   "XMonad.Util.DebugWindow" is used to display the individual windows.
  debugStackFull :: X ()
  debugStackFull =  debugStackFullString >>= trace
  
  -- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.)
  debugStackLogHook :: X ()
  debugStackLogHook =  debugStack
  
  -- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.)
  debugStackFullLogHook :: X ()
  debugStackFullLogHook =  debugStackFull
  
  -- | 'debugStack' 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)
  
  -- | 'debugStackFull' 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.
  
  debugStackFullEventHook   :: Event -> X All
  debugStackFullEventHook _ =  debugStackFull >> return (All True)
  
  -- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'.
  debugStackString :: X String
  debugStackString =  withWindowSet $ debugStackWs . W.workspace . W.current
  
  -- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'.
  -- @@@ this is in stackset order, which is roughly lru-ish
  debugStackFullString :: X String
  debugStackFullString =  withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces
  
  -- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'.
  --   @
  --   Workspace "foo::
  --     mm
  --   * ww
  --    ^ww
  --   @
  --   * indicates the focused window, ^ indicates a floating window
  debugStackWs   :: W.Workspace String (Layout Window) Window -> X String
  debugStackWs w =  withWindowSet $ \ws -> do
    let cur = if wt == W.currentTag ws then " (current)" else ""
        wt  = W.tag w
    s <- emit ws $ W.integrate' . W.stack $ w
    return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s
    where
      emit       :: WindowSet -> [Window] -> X [String]
      emit _  [] =  return ["    -empty workspace-"]
      emit ww ws = do
        (_,ss) <- foldM emit' (ww,[]) ws
        return ss
  
      emit' :: (WindowSet,[String])
            -> Window
            -> X (WindowSet,[String])
      emit' (ws,a) w' = do
        let focus = if Just w' == W.peek ws then '*' else ' '
            float = if w' `member` W.floating ws then '^' else ' '
        s <- debugWindow w'
        return (ws,(focus:float:s):a)
  