content: {-# LANGUAGE DeriveDataTypeable #-}
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Hooks.ToggleHook
  -- Copyright   :  Ben Boeckel <mathstuf@gmail.com>
  -- License     :  BSD-style (see LICENSE)
  --
  -- Maintainer  :  Ben Boeckel <mathstuf@gmail.com>
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Hook and keybindings for toggling hook behavior.
  -----------------------------------------------------------------------------
  
  module XMonad.Hooks.ToggleHook ( -- * Usage
                                   -- $usage
  
                                   -- * The hook
                                   toggleHook
                                 , toggleHook'
  
                                   -- * Actions
                                 , hookNext
                                 , toggleHookNext
                                 , hookAllNew
                                 , toggleHookAllNew
  
                                   -- * Queries
                                 , willHook
                                 , willHookNext
                                 , willHookAllNew
  
                                   -- * 'DynamicLog' utilities
                                   -- $pp
                                 , willHookNextPP
                                 , willHookAllNewPP
                                 , runLogHook ) where
  
  import Prelude hiding (all)
  
  import XMonad
  import qualified XMonad.Util.ExtensibleState as XS
  
  import Control.Monad (join,guard)
  import Control.Applicative ((<$>))
  import Control.Arrow (first, second)
  
  import Data.Map
  
  {- Helper functions -}
  
  _set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
  _set n f b = modify' n (f $ const b)
  
  _toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
  _toggle n f = modify' n (f not)
  
  _get :: String -> ((Bool, Bool) -> a) -> X a
  _get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks)
  
  _pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
  _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
  
  {- The current state is kept here -}
  
  data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
  
  instance ExtensionClass HookState where
      initialValue = HookState empty
      extensionType = PersistentExtension
  
  modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
  modify' n f = XS.modify (HookState . setter . hooks)
      where
          setter m = insert n (f (findWithDefault (False, False) n m)) m
  
  -- $usage
  -- This module provides actions (that can be set as keybindings)
  -- to be able to cause hooks to be occur on a conditional basis.
  --
  -- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
  --
  -- > import XMonad.Hooks.ToggleHook
  --
  -- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
  -- name of the hook and @hook@ is the hook to execute based on the state.
  --
  -- > myManageHook = toggleHook "float" doFloat <+> manageHook def
  --
  -- Additionally, toggleHook' is provided to toggle between two hooks (rather
  -- than on/off).
  --
  -- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def
  --
  -- The 'hookNext' and 'toggleHookNext' functions can be used in key
  -- bindings to set whether the hook is applied or not.
  --
  -- > , ((modm, xK_e), toggleHookNext "float")
  --
  -- 'hookAllNew' and 'toggleHookAllNew' are similar but float all
  -- spawned windows until disabled again.
  --
  -- > , ((modm, xK_r), toggleHookAllNew "float")
  
  -- | This 'ManageHook' will selectively apply a hook as set
  -- by 'hookNext' and 'hookAllNew'.
  toggleHook :: String -> ManageHook -> ManageHook
  toggleHook n h = toggleHook' n h idHook
  
  toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
  toggleHook' n th fh = do m <- liftX $ XS.gets hooks
                           (next, all) <- return $ findWithDefault (False, False) n m
                           liftX $ XS.put $ HookState $ insert n (False, all) m
                           if next || all then th else fh
  
  -- | @hookNext name True@ arranges for the next spawned window to
  -- have the hook @name@ applied, @hookNext name False@ cancels it.
  hookNext :: String -> Bool -> X ()
  hookNext n = _set n first
  
  toggleHookNext :: String -> X ()
  toggleHookNext n = _toggle n first
  
  -- | @hookAllNew name True@ arranges for new windows to
  -- have the hook @name@ applied, @hookAllNew name False@ cancels it
  hookAllNew :: String -> Bool -> X ()
  hookAllNew n = _set n second
  
  toggleHookAllNew :: String -> X ()
  toggleHookAllNew n = _toggle n second
  
  -- | Query what will happen at the next ManageHook call for the hook @name@.
  willHook :: String -> X Bool
  willHook n = willHookNext n <||> willHookAllNew n
  
  -- | Whether the next window will trigger the hook @name@.
  willHookNext :: String -> X Bool
  willHookNext n = _get n fst
  
  -- | Whether new windows will trigger the hook @name@.
  willHookAllNew :: String -> X Bool
  willHookAllNew n = _get n snd
  
  -- $pp
  -- The following functions are used to display the current
  -- state of 'hookNext' and 'hookAllNew' in your
  -- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.
  -- 'willHookNextPP' and 'willHookAllNewPP' should be added
  -- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your
  -- 'XMonad.Hooks.DynamicLog.PP'.
  --
  -- Use 'runLogHook' to refresh the output of your 'logHook', so
  -- that the effects of a 'hookNext'/... will be visible
  -- immediately:
  --
  -- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook)
  --
  -- The @String -> String@ parameters to 'willHookNextPP' and
  -- 'willHookAllNewPP' will be applied to their output, you
  -- can use them to set the text color, etc., or you can just
  -- pass them 'id'.
  
  willHookNextPP :: String -> (String -> String) -> X (Maybe String)
  willHookNextPP n = _pp n fst "Next"
  
  willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
  willHookAllNewPP n = _pp n snd "All"
  
  runLogHook :: X ()
  runLogHook = join $ asks $ logHook . config
  