-----------------------------------------------------------------------------
-- |
-- 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 [] ManageHook
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 = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X (Endo WindowSet) -> ManageHook
forall a. X a -> Query a
liftX (X (Endo WindowSet) -> ManageHook)
-> X (Endo WindowSet) -> ManageHook
forall a b. (a -> b) -> a -> b
$ do
  DynamicHooks
dh <- X DynamicHooks
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  (Endo WindowSet -> WindowSet
f)  <- ManageHook -> Window -> X (Endo WindowSet)
forall a. Query a -> Window -> X a
runQuery (DynamicHooks -> ManageHook
permanent DynamicHooks
dh) Window
w
  [(Bool, (Query Bool, ManageHook))]
ts <- ((Query Bool, ManageHook) -> X (Bool, (Query Bool, ManageHook)))
-> [(Query Bool, ManageHook)]
-> X [(Bool, (Query Bool, ManageHook))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Query Bool
q,ManageHook
a) -> Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
q Window
w X Bool
-> (Bool -> X (Bool, (Query Bool, ManageHook)))
-> X (Bool, (Query Bool, ManageHook))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> (Bool, (Query Bool, ManageHook))
-> X (Bool, (Query Bool, ManageHook))
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) = ((Bool, (Query Bool, ManageHook)) -> Bool)
-> [(Bool, (Query Bool, ManageHook))]
-> ([(Bool, (Query Bool, ManageHook))],
    [(Bool, (Query Bool, ManageHook))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Bool, (Query Bool, ManageHook)) -> Bool
forall a b. (a, b) -> a
fst [(Bool, (Query Bool, ManageHook))]
ts
  [Endo WindowSet]
gs <- ((Bool, (Query Bool, ManageHook)) -> X (Endo WindowSet))
-> [(Bool, (Query Bool, ManageHook))] -> X [Endo WindowSet]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManageHook -> Window -> X (Endo WindowSet))
-> Window -> ManageHook -> X (Endo WindowSet)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ManageHook -> Window -> X (Endo WindowSet)
forall a. Query a -> Window -> X a
runQuery Window
w (ManageHook -> X (Endo WindowSet))
-> ((Bool, (Query Bool, ManageHook)) -> ManageHook)
-> (Bool, (Query Bool, ManageHook))
-> X (Endo WindowSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query Bool, ManageHook) -> ManageHook
forall a b. (a, b) -> b
snd ((Query Bool, ManageHook) -> ManageHook)
-> ((Bool, (Query Bool, ManageHook)) -> (Query Bool, ManageHook))
-> (Bool, (Query Bool, ManageHook))
-> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, (Query Bool, ManageHook)) -> (Query Bool, ManageHook)
forall a b. (a, b) -> b
snd) [(Bool, (Query Bool, ManageHook))]
ts'
  let (Endo WindowSet -> WindowSet
g) = Endo WindowSet -> Maybe (Endo WindowSet) -> Endo WindowSet
forall a. a -> Maybe a -> a
fromMaybe ((WindowSet -> WindowSet) -> Endo WindowSet
forall a. (a -> a) -> Endo a
Endo WindowSet -> WindowSet
forall a. a -> a
id) (Maybe (Endo WindowSet) -> Endo WindowSet)
-> Maybe (Endo WindowSet) -> Endo WindowSet
forall a b. (a -> b) -> a -> b
$ [Endo WindowSet] -> Maybe (Endo WindowSet)
forall a. [a] -> Maybe a
listToMaybe [Endo WindowSet]
gs
  DynamicHooks -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (DynamicHooks -> X ()) -> DynamicHooks -> X ()
forall a b. (a -> b) -> a -> b
$ DynamicHooks
dh { transients :: [(Query Bool, ManageHook)]
transients = ((Bool, (Query Bool, ManageHook)) -> (Query Bool, ManageHook))
-> [(Bool, (Query Bool, ManageHook))] -> [(Query Bool, ManageHook)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (Query Bool, ManageHook)) -> (Query Bool, ManageHook)
forall a b. (a, b) -> b
snd [(Bool, (Query Bool, ManageHook))]
nts }
  Endo WindowSet -> X (Endo WindowSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Endo WindowSet -> X (Endo WindowSet))
-> Endo WindowSet -> X (Endo WindowSet)
forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> Endo WindowSet
forall a. (a -> a) -> Endo a
Endo ((WindowSet -> WindowSet) -> Endo WindowSet)
-> (WindowSet -> WindowSet) -> Endo WindowSet
forall a b. (a -> b) -> a -> b
$ WindowSet -> WindowSet
f (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
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 (ManageHook -> ManageHook -> ManageHook
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 = (DynamicHooks -> DynamicHooks) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((DynamicHooks -> DynamicHooks) -> X ())
-> (DynamicHooks -> DynamicHooks) -> X ()
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 = (DynamicHooks -> DynamicHooks) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((DynamicHooks -> DynamicHooks) -> X ())
-> (DynamicHooks -> DynamicHooks) -> X ()
forall a b. (a -> b) -> a -> b
$ \DynamicHooks
dh -> DynamicHooks
dh { transients :: [(Query Bool, ManageHook)]
transients = (Query Bool
q,ManageHook
a)(Query Bool, ManageHook)
-> [(Query Bool, ManageHook)] -> [(Query Bool, ManageHook)]
forall a. a -> [a] -> [a]
:DynamicHooks -> [(Query Bool, ManageHook)]
transients DynamicHooks
dh }