-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.DynamicHooks
-- Description :  One-shot and permanent ManageHooks that can be updated at runtime.
-- Copyright   :  (c) Braden Shepherdson 2008
-- License     :  BSD-style (as xmonad)
--
-- Maintainer  :  Braden.Shepherdson@gmail.com
-- Stability   :  unstable
-- Portability :  unportable
--
-- One-shot and permanent ManageHooks that can be updated at runtime.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.DynamicHooks (
  -- * Usage
  -- $usage
  dynamicMasterHook
  ,addDynamicHook
  ,updateDynamicHook
  ,oneShotHook
  ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- Provides two new kinds of 'ManageHooks' that can be defined at runtime.
--
-- * One-shot 'ManageHooks' that are deleted after they execute.
--
-- * Permanent 'ManageHooks' (unless you want to destroy them)
--
-- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!
-- If you want them to last, you should create them as normal in your @xmonad.hs@.
--
-- To use this module, add 'dynamicMasterHook' to your 'manageHook':
--
-- > xmonad { manageHook = myManageHook <> dynamicMasterHook }
--
-- You can then use the supplied functions in your keybindings:
--
-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat)
--

data DynamicHooks = DynamicHooks
    { DynamicHooks -> [(Query Bool, ManageHook)]
transients :: [(Query Bool, ManageHook)]
    , DynamicHooks -> ManageHook
permanent  :: ManageHook }

instance ExtensionClass DynamicHooks where
    initialValue :: DynamicHooks
initialValue = [(Query Bool, ManageHook)] -> ManageHook -> DynamicHooks
DynamicHooks [] forall m. Monoid m => m
idHook

-- this hook is always executed, and the contents of the stored hooks checked.
-- note that transient hooks are run second, therefore taking precedence
-- over permanent ones on matters such as which workspace to shift to.
-- doFloat and doIgnore are idempotent.
-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
dynamicMasterHook :: ManageHook
dynamicMasterHook :: ManageHook
dynamicMasterHook = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ do
  DynamicHooks
dh <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  (Endo WindowSet -> WindowSet
f)  <- forall a. Query a -> Window -> X a
runQuery (DynamicHooks -> ManageHook
permanent DynamicHooks
dh) Window
w
  [(Bool, (Query Bool, ManageHook))]
ts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Query Bool
q,ManageHook
a) -> forall a. Query a -> Window -> X a
runQuery Query Bool
q Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
x,(Query Bool
q, ManageHook
a))) (DynamicHooks -> [(Query Bool, ManageHook)]
transients DynamicHooks
dh)
  let ([(Bool, (Query Bool, ManageHook))]
ts',[(Bool, (Query Bool, ManageHook))]
nts) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall a b. (a, b) -> a
fst [(Bool, (Query Bool, ManageHook))]
ts
  [Endo WindowSet]
gs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Query a -> Window -> X a
runQuery Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Bool, (Query Bool, ManageHook))]
ts'
  let (Endo WindowSet -> WindowSet
g) = forall a. a -> Maybe a -> a
fromMaybe (forall a. (a -> a) -> Endo a
Endo forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [Endo WindowSet]
gs
  forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$ DynamicHooks
dh { transients :: [(Query Bool, ManageHook)]
transients = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Bool, (Query Bool, ManageHook))]
nts }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> Endo a
Endo forall a b. (a -> b) -> a -> b
$ WindowSet -> WindowSet
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
g

-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
addDynamicHook :: ManageHook -> X ()
addDynamicHook :: ManageHook -> X ()
addDynamicHook ManageHook
m = (ManageHook -> ManageHook) -> X ()
updateDynamicHook (forall a. Semigroup a => a -> a -> a
<> ManageHook
m)

-- | Modifies the permanent 'ManageHook' with an arbitrary function.
updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
updateDynamicHook ManageHook -> ManageHook
f = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \DynamicHooks
dh -> DynamicHooks
dh { permanent :: ManageHook
permanent = ManageHook -> ManageHook
f (DynamicHooks -> ManageHook
permanent DynamicHooks
dh) }

-- | Creates a one-shot 'ManageHook'. Note that you have to specify the two
-- parts of the 'ManageHook' separately. Where you would usually write:
--
-- > className =? "example" --> doFloat
--
-- you must call 'oneShotHook' as
--
-- > oneShotHook dynHooksRef (className =? "example) doFloat
--
oneShotHook :: Query Bool -> ManageHook -> X ()
oneShotHook :: Query Bool -> ManageHook -> X ()
oneShotHook Query Bool
q ManageHook
a = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall a b. (a -> b) -> a -> b
$ \DynamicHooks
dh -> DynamicHooks
dh { transients :: [(Query Bool, ManageHook)]
transients = (Query Bool
q,ManageHook
a)forall a. a -> [a] -> [a]
:DynamicHooks -> [(Query Bool, ManageHook)]
transients DynamicHooks
dh }