-----------------------------------------------------------------------------
-- |
-- 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 =  forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window -> X String
debugStackWs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =  forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [[a]] -> [a]
intercalate String
"\n") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace String (Layout Window) Window -> X String
debugStackWs forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =  forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
  let cur :: String
cur = if String
wt forall a. Eq a => a -> a -> Bool
== 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  = forall i l a. Workspace i l a -> i
W.tag Workspace String (Layout Window) Window
w
  [String]
s <- WindowSet -> [Window] -> X [String]
emit WindowSet
ws forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall a b. (a -> b) -> a -> b
$ Workspace String (Layout Window) Window
w
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" forall a b. (a -> b) -> a -> b
$ (String
"Workspace " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
wt forall a. [a] -> [a] -> [a]
++ String
cur)forall a. a -> [a] -> [a]
:[String]
s
  where
    emit       :: WindowSet -> [Window] -> X [String]
    emit :: WindowSet -> [Window] -> X [String]
emit WindowSet
_  [] =  forall (m :: * -> *) a. Monad m => a -> m a
return [String
"    -empty workspace-"]
    emit WindowSet
ww [Window]
ws = do
      (WindowSet
_,[String]
ss) <- 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
      forall (m :: * -> *) a. Monad m => a -> m a
return [String]
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 forall a. a -> Maybe a
Just Window
w' forall a. Eq a => a -> a -> Bool
== 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' forall k a. Ord k => k -> Map k a -> Bool
`member` forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws then Char
'^' else Char
' '
      String
s <- Window -> X String
debugWindow Window
w'
      forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet
ws,(Char
focusforall a. a -> [a] -> [a]
:Char
floatforall a. a -> [a] -> [a]
:String
s)forall a. a -> [a] -> [a]
:[String]
a)