{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.FocusSwitch
-- Copyright   :  (c) Dmitry Bogatov
-- License     :  GNU GPL3+
--
-- Maintainer  :  Dmitry Bogatov <KAction@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Log hook, that will be run, when focused 'Window' is changed.
-----------------------------------------------------------------------------
module XMonad.Hooks.FocusSwitch (-- * Usage
                                 -- $usage
                                 focusSwitch) where
import XMonad.StackSet
import XMonad hiding (focus)
import Control.Applicative
import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad

-- $usage
-- Provides easy way to specify actions to perform on window focus switch.
--
-- > defaultConfig { logHook = focusSwitch myFocusSwitchHandler }
-- >
-- > myFocusSwitchHandler :: Maybe Window -> X ()
-- > myFocusSwitchHandler  = --
-- >
-- > Window is in Maybe, since no window may be focused (i.e empty workspace)

newtype FocusedWindow = FocusedWindow { unpackWindow :: Window }
    deriving (Typeable, Eq)

-- Complement to unpackWindow. Newtype instance is too overloaded and
-- would require explicit signatures in every touch with ExtensibleState.
packWindow :: Window -> FocusedWindow
packWindow = FocusedWindow

instance ExtensionClass (Maybe FocusedWindow) where
    initialValue = Nothing

prevFocused :: X (Maybe Window)
prevFocused = XS.gets (fmap unpackWindow)

curFocused :: X (Maybe Window)
curFocused = fmap focus . stack . workspace . current . windowset <$> get

focusSwitch :: (Maybe Window -> X ()) -> X ()
focusSwitch f = do
  prev <- prevFocused
  cur <- curFocused
  when (cur /= prev) $ XS.put (packWindow <$> cur) >> f cur