    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Hooks.DebugStack
    -- Description :  Dump the state of the StackSet.
    -- 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           XMonad.Prelude
    import qualified XMonad.StackSet                                       as W

    import           XMonad.Util.DebugWindow

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

    import           Data.Map                            (member)

    -- | 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 :: X ()
    debugStack =  X String
    debugStackString X String -> (String -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    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 :: X ()
    debugStackFull =  X String
    debugStackFullString X String -> (String -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> X ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    trace

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

    -- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.)
    debugStackFullLogHook :: X ()
    debugStackFullLogHook :: X ()
    debugStackFullLogHook =  X ()
    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 :: Event -> X All
    debugStackEventHook Event
    _ =  X ()
    debugStack X () -> X All -> X All
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    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 :: Event -> X All
    debugStackFullEventHook Event
    _ =  X ()
    debugStackFull X () -> X All -> X All
    forall a b. X a -> X b -> X b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> All -> X All
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> All
    All Bool
    True)

    -- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'.
    debugStackString :: X String
    debugStackString :: X String
    debugStackString =  (WindowSet -> X String) -> X String
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X String) -> X String)
    -> (WindowSet -> X String) -> X String
    forall a b. (a -> b) -> a -> b
    $ Workspace String (Layout Window) Window -> X String
    debugStackWs (Workspace String (Layout Window) Window -> X String)
    -> (WindowSet -> Workspace String (Layout Window) Window)
    -> WindowSet
    -> X String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen String (Layout Window) Window ScreenId ScreenDetail
    -> Workspace String (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen String (Layout Window) Window ScreenId ScreenDetail
     -> Workspace String (Layout Window) Window)
    -> (WindowSet
        -> Screen String (Layout Window) Window ScreenId ScreenDetail)
    -> WindowSet
    -> Workspace String (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen String (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    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 :: X String
    debugStackFullString =  (WindowSet -> X String) -> X String
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X String) -> X String)
    -> (WindowSet -> X String) -> X String
    forall a b. (a -> b) -> a -> b
    $ ([String] -> String) -> X [String] -> X String
    forall a b. (a -> b) -> X a -> X b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n") (X [String] -> X String)
    -> (WindowSet -> X [String]) -> WindowSet -> X String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Workspace String (Layout Window) Window -> X String)
    -> [Workspace String (Layout Window) Window] -> X [String]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Workspace String (Layout Window) Window -> X String
    debugStackWs ([Workspace String (Layout Window) Window] -> X [String])
    -> (WindowSet -> [Workspace String (Layout Window) Window])
    -> WindowSet
    -> X [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet -> [Workspace String (Layout Window) Window]
    forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
    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 :: Workspace String (Layout Window) Window -> X String
    debugStackWs Workspace String (Layout Window) Window
    w =  (WindowSet -> X String) -> X String
    forall a. (WindowSet -> X a) -> X a
    withWindowSet ((WindowSet -> X String) -> X String)
    -> (WindowSet -> X String) -> X String
    forall a b. (a -> b) -> a -> b
    $ \WindowSet
    ws -> do
      let cur :: String
    cur = if String
    wt String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == WindowSet -> String
    forall i l a s sd. StackSet i l a s sd -> i
    W.currentTag WindowSet
    ws then String
    " (current)" else String
    ""
          wt :: String
    wt  = Workspace String (Layout Window) Window -> String
    forall i l a. Workspace i l a -> i
    W.tag Workspace String (Layout Window) Window
    w
      s <- WindowSet -> [Window] -> X [String]
    emit WindowSet
    ws ([Window] -> X [String]) -> [Window] -> X [String]
    forall a b. (a -> b) -> a -> b
    $ Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (Workspace String (Layout Window) Window
        -> Maybe (Stack Window))
    -> Workspace String (Layout Window) Window
    -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace String (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace String (Layout Window) Window -> [Window])
    -> Workspace String (Layout Window) Window -> [Window]
    forall a b. (a -> b) -> a -> b
    $ Workspace String (Layout Window) Window
    w
      return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s
      where
        emit       :: WindowSet -> [Window] -> X [String]
        emit :: WindowSet -> [Window] -> X [String]
    emit WindowSet
    _  [] =  [String] -> X [String]
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [String
    "    -empty workspace-"]
        emit WindowSet
    ww [Window]
    ws = do
          (_,ss) <- ((WindowSet, [String]) -> Window -> X (WindowSet, [String]))
    -> (WindowSet, [String]) -> [Window] -> X (WindowSet, [String])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (WindowSet, [String]) -> Window -> X (WindowSet, [String])
    emit' (WindowSet
    ww,[]) [Window]
    ws
          return ss

        emit' :: (WindowSet,[String])
              -> Window
              -> X (WindowSet,[String])
        emit' :: (WindowSet, [String]) -> Window -> X (WindowSet, [String])
    emit' (WindowSet
    ws,[String]
    a) Window
    w' = do
          let focus :: Char
    focus = if Window -> Maybe Window
    forall a. a -> Maybe a
    Just Window
    w' Maybe Window -> Maybe Window -> Bool
    forall a. Eq a => a -> a -> Bool
    == WindowSet -> Maybe Window
    forall i l a s sd. StackSet i l a s sd -> Maybe a
    W.peek WindowSet
    ws then Char
    '*' else Char
    ' '
              float :: Char
    float = if Window
    w' Window -> Map Window RationalRect -> Bool
    forall k a. Ord k => k -> Map k a -> Bool
    `member` WindowSet -> Map Window RationalRect
    forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
    W.floating WindowSet
    ws then Char
    '^' else Char
    ' '
          s <- Window -> X String
    debugWindow Window
    w'
          return (ws,(focus:float:s):a)