module XMonad.Hooks.ToggleHook (
toggleHook
, toggleHook'
, hookNext
, toggleHookNext
, hookAllNew
, toggleHookAllNew
, willHook
, willHookNext
, willHookAllNew
, willHookNextPP
, willHookAllNewPP
, runLogHook ) where
import Prelude hiding (all)
import XMonad
import XMonad.Prelude (guard, join)
import qualified XMonad.Util.ExtensibleState as XS
import Control.Arrow (first, second)
import Data.Map
_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
_set :: forall a.
String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
_set String
n (a -> a) -> (Bool, Bool) -> (Bool, Bool)
f a
b = String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
modify' String
n ((a -> a) -> (Bool, Bool) -> (Bool, Bool)
f forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const a
b)
_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
_toggle String
n (Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)
f = String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
modify' String
n ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)
f Bool -> Bool
not)
_get :: String -> ((Bool, Bool) -> a) -> X a
_get :: forall a. String -> ((Bool, Bool) -> a) -> X a
_get String
n (Bool, Bool) -> a
f = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets forall a b. (a -> b) -> a -> b
$ (Bool, Bool) -> a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault (Bool
False, Bool
False) String
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. HookState -> Map String (Bool, Bool)
hooks)
_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
_pp :: String
-> ((Bool, Bool) -> Bool)
-> String
-> (String -> String)
-> X (Maybe String)
_pp String
n (Bool, Bool) -> Bool
f String
s String -> String
st = (\Bool
b -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just (String -> String
st String
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> ((Bool, Bool) -> a) -> X a
_get String
n (Bool, Bool) -> Bool
f
newtype HookState = HookState { HookState -> Map String (Bool, Bool)
hooks :: Map String (Bool, Bool) } deriving (ReadPrec [HookState]
ReadPrec HookState
Int -> ReadS HookState
ReadS [HookState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HookState]
$creadListPrec :: ReadPrec [HookState]
readPrec :: ReadPrec HookState
$creadPrec :: ReadPrec HookState
readList :: ReadS [HookState]
$creadList :: ReadS [HookState]
readsPrec :: Int -> ReadS HookState
$creadsPrec :: Int -> ReadS HookState
Read, Int -> HookState -> String -> String
[HookState] -> String -> String
HookState -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HookState] -> String -> String
$cshowList :: [HookState] -> String -> String
show :: HookState -> String
$cshow :: HookState -> String
showsPrec :: Int -> HookState -> String -> String
$cshowsPrec :: Int -> HookState -> String -> String
Show)
instance ExtensionClass HookState where
initialValue :: HookState
initialValue = Map String (Bool, Bool) -> HookState
HookState forall k a. Map k a
empty
extensionType :: HookState -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
modify' String
n (Bool, Bool) -> (Bool, Bool)
f = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Map String (Bool, Bool) -> HookState
HookState forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String (Bool, Bool) -> Map String (Bool, Bool)
setter forall b c a. (b -> c) -> (a -> b) -> a -> c
. HookState -> Map String (Bool, Bool)
hooks)
where
setter :: Map String (Bool, Bool) -> Map String (Bool, Bool)
setter Map String (Bool, Bool)
m = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert String
n ((Bool, Bool) -> (Bool, Bool)
f (forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault (Bool
False, Bool
False) String
n Map String (Bool, Bool)
m)) Map String (Bool, Bool)
m
toggleHook :: String -> ManageHook -> ManageHook
toggleHook :: String -> ManageHook -> ManageHook
toggleHook String
n ManageHook
h = String -> ManageHook -> ManageHook -> ManageHook
toggleHook' String
n ManageHook
h forall m. Monoid m => m
idHook
toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
toggleHook' String
n ManageHook
th ManageHook
fh = do Map String (Bool, Bool)
m <- forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets HookState -> Map String (Bool, Bool)
hooks
(Bool
next, Bool
all) <- forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => a -> k -> Map k a -> a
findWithDefault (Bool
False, Bool
False) String
n Map String (Bool, Bool)
m
forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ Map String (Bool, Bool) -> HookState
HookState forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
insert String
n (Bool
False, Bool
all) Map String (Bool, Bool)
m
if Bool
next Bool -> Bool -> Bool
|| Bool
all then ManageHook
th else ManageHook
fh
hookNext :: String -> Bool -> X ()
hookNext :: String -> Bool -> X ()
hookNext String
n = forall a.
String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
_set String
n forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
toggleHookNext :: String -> X ()
toggleHookNext :: String -> X ()
toggleHookNext String
n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
_toggle String
n forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
hookAllNew :: String -> Bool -> X ()
hookAllNew :: String -> Bool -> X ()
hookAllNew String
n = forall a.
String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
_set String
n forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
toggleHookAllNew :: String -> X ()
toggleHookAllNew :: String -> X ()
toggleHookAllNew String
n = String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
_toggle String
n forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second
willHook :: String -> X Bool
willHook :: String -> X Bool
willHook String
n = String -> X Bool
willHookNext String
n forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> String -> X Bool
willHookAllNew String
n
willHookNext :: String -> X Bool
willHookNext :: String -> X Bool
willHookNext String
n = forall a. String -> ((Bool, Bool) -> a) -> X a
_get String
n forall a b. (a, b) -> a
fst
willHookAllNew :: String -> X Bool
willHookAllNew :: String -> X Bool
willHookAllNew String
n = forall a. String -> ((Bool, Bool) -> a) -> X a
_get String
n forall a b. (a, b) -> b
snd
willHookNextPP :: String -> (String -> String) -> X (Maybe String)
willHookNextPP :: String -> (String -> String) -> X (Maybe String)
willHookNextPP String
n = String
-> ((Bool, Bool) -> Bool)
-> String
-> (String -> String)
-> X (Maybe String)
_pp String
n forall a b. (a, b) -> a
fst String
"Next"
willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
willHookAllNewPP String
n = String
-> ((Bool, Bool) -> Bool)
-> String
-> (String -> String)
-> X (Maybe String)
_pp String
n forall a b. (a, b) -> b
snd String
"All"
runLogHook :: X ()
runLogHook :: X ()
runLogHook = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> X ()
logHook forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config