module XMonad.Hooks.ManageDebug (debugManageHook
,debugManageHookOn
,manageDebug
,maybeManageDebug
,manageDebugLogHook
,debugNextManagedWindow
) where
import XMonad
import XMonad.Hooks.DebugStack
import XMonad.Util.DebugWindow
import XMonad.Util.EZConfig
import qualified XMonad.Util.ExtensibleState as XS
data MSDFinal = DoLogHook | SkipLogHook deriving Int -> MSDFinal -> ShowS
[MSDFinal] -> ShowS
MSDFinal -> String
(Int -> MSDFinal -> ShowS)
-> (MSDFinal -> String) -> ([MSDFinal] -> ShowS) -> Show MSDFinal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSDFinal -> ShowS
showsPrec :: Int -> MSDFinal -> ShowS
$cshow :: MSDFinal -> String
show :: MSDFinal -> String
$cshowList :: [MSDFinal] -> ShowS
showList :: [MSDFinal] -> ShowS
Show
data MSDTrigger = MSDActivated | MSDInactive deriving Int -> MSDTrigger -> ShowS
[MSDTrigger] -> ShowS
MSDTrigger -> String
(Int -> MSDTrigger -> ShowS)
-> (MSDTrigger -> String)
-> ([MSDTrigger] -> ShowS)
-> Show MSDTrigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSDTrigger -> ShowS
showsPrec :: Int -> MSDTrigger -> ShowS
$cshow :: MSDTrigger -> String
show :: MSDTrigger -> String
$cshowList :: [MSDTrigger] -> ShowS
showList :: [MSDTrigger] -> ShowS
Show
data ManageStackDebug = MSD MSDFinal MSDTrigger deriving Int -> ManageStackDebug -> ShowS
[ManageStackDebug] -> ShowS
ManageStackDebug -> String
(Int -> ManageStackDebug -> ShowS)
-> (ManageStackDebug -> String)
-> ([ManageStackDebug] -> ShowS)
-> Show ManageStackDebug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManageStackDebug -> ShowS
showsPrec :: Int -> ManageStackDebug -> ShowS
$cshow :: ManageStackDebug -> String
show :: ManageStackDebug -> String
$cshowList :: [ManageStackDebug] -> ShowS
showList :: [ManageStackDebug] -> ShowS
Show
instance ExtensionClass ManageStackDebug where
initialValue :: ManageStackDebug
initialValue = MSDFinal -> MSDTrigger -> ManageStackDebug
MSD MSDFinal
SkipLogHook MSDTrigger
MSDInactive
debugManageHook :: XConfig l -> XConfig l
debugManageHook :: forall (l :: * -> *). XConfig l -> XConfig l
debugManageHook XConfig l
cf = XConfig l
cf {logHook = manageDebugLogHook <> logHook cf
,manageHook = manageDebug <> manageHook cf
}
debugManageHookOn :: String -> XConfig l -> XConfig l
debugManageHookOn :: forall (l :: * -> *). String -> XConfig l -> XConfig l
debugManageHookOn String
key XConfig l
cf = XConfig l
cf {logHook = manageDebugLogHook <> logHook cf
,manageHook = maybeManageDebug <> manageHook cf
}
XConfig l -> [(String, X ())] -> XConfig l
forall (l :: * -> *). XConfig l -> [(String, X ())] -> XConfig l
`additionalKeysP`
[(String
key,X ()
debugNextManagedWindow)]
manageDebug :: ManageHook
manageDebug :: Query (Endo WindowSet)
manageDebug = do
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
liftX $ do
trace "== manageHook; current stack =="
debugStackString >>= trace
ws <- debugWindow w
trace $ "new window:\n " ++ ws
XS.modify $ \(MSD MSDFinal
_ MSDTrigger
go') -> MSDFinal -> MSDTrigger -> ManageStackDebug
MSD MSDFinal
DoLogHook MSDTrigger
go'
idHook
maybeManageDebug :: ManageHook
maybeManageDebug :: Query (Endo WindowSet)
maybeManageDebug = do
go <- X MSDTrigger -> Query MSDTrigger
forall a. X a -> Query a
liftX (X MSDTrigger -> Query MSDTrigger)
-> X MSDTrigger -> Query MSDTrigger
forall a b. (a -> b) -> a -> b
$ do
MSD _ go' <- X ManageStackDebug
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
return go'
case go of
MSDTrigger
MSDActivated -> Query (Endo WindowSet)
manageDebug
MSDTrigger
_ -> Query (Endo WindowSet)
forall m. Monoid m => m
idHook
manageDebugLogHook :: X ()
manageDebugLogHook :: X ()
manageDebugLogHook = do
MSD log' _ <- X ManageStackDebug
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case log' of
MSDFinal
DoLogHook -> do
String -> X ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace String
"== manageHook; final stack =="
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
ManageStackDebug -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (ManageStackDebug -> X ()) -> ManageStackDebug -> X ()
forall a b. (a -> b) -> a -> b
$ MSDFinal -> MSDTrigger -> ManageStackDebug
MSD MSDFinal
SkipLogHook MSDTrigger
MSDInactive
MSDFinal
_ -> X ()
forall m. Monoid m => m
idHook
debugNextManagedWindow :: X ()
debugNextManagedWindow :: X ()
debugNextManagedWindow = (ManageStackDebug -> ManageStackDebug) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((ManageStackDebug -> ManageStackDebug) -> X ())
-> (ManageStackDebug -> ManageStackDebug) -> X ()
forall a b. (a -> b) -> a -> b
$ \(MSD MSDFinal
log' MSDTrigger
_) -> MSDFinal -> MSDTrigger -> ManageStackDebug
MSD MSDFinal
log' MSDTrigger
MSDActivated