{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# OPTIONS_HADDOCK show-extensions     #-}

-- |
-- Module:      XMonad.Hooks.Focus
-- Description: Extends ManageHook EDSL to work on focused windows and current workspace.
-- Copyright:   sgf-dma, 2016
-- Maintainer:  sgf.dma@gmail.com
--
-- Extends "XMonad.ManageHook" EDSL to work on focused windows and current
-- workspace.
--

module XMonad.Hooks.Focus
    (
      -- $main

      -- * FocusQuery.
      --
      -- $focusquery
      Focus (..)
    , FocusLock (..)
    , toggleLock
    , focusLockOn
    , focusLockOff
    , FocusQuery
    , runFocusQuery
    , FocusHook

      -- * Lifting into FocusQuery.
      --
      -- $lift
    , liftQuery
    , new
    , focused
    , focused'
    , focusedOn
    , focusedOn'
    , focusedCur
    , focusedCur'
    , newOn
    , newOnCur
    , unlessFocusLock

      -- * Commonly used actions for modifying focus.
      --
      -- $common
    , keepFocus
    , switchFocus
    , keepWorkspace
    , switchWorkspace

      -- * Running FocusQuery.
      --
      -- $running
    , manageFocus

      -- * Example configurations.
      --
      -- $examples
    , activateSwitchWs
    , activateOnCurrentWs
    , activateOnCurrentKeepFocus
    )
  where

import Control.Arrow ((&&&))
import Control.Monad.Reader

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Hooks.ManageHelpers (currentWs)


-- $main
--
-- This module provides monad on top of Query monad providing additional
-- information about new window:
--
--  - workspace, where new window will appear;
--  - focused window on workspace, where new window will appear;
--  - current workspace;
--
-- And a property in extensible state:
--
--  - is focus lock enabled? Focus lock instructs all library's 'FocusHook'
--  functions to not move focus or switch workspace.
--
-- Lifting operations for standard 'ManageHook' EDSL combinators into
-- 'FocusQuery' monad allowing to run these combinators on focused window and
-- common actions for keeping focus and\/or workspace, switching focus and\/or
-- workspace are also provided.
--
-- == Quick start.
--
-- I may use one of predefined configurations.
--
-- 1. The default window activation behavior (switch to workspace with
--    activated window and switch focus to it) expressed using this module:
--
--      > import XMonad
--      >
--      > import XMonad.Hooks.EwmhDesktops
--      > import XMonad.Hooks.Focus
--      >
--      > main :: IO ()
--      > main = do
--      >         let ah :: ManageHook
--      >             ah = activateSwitchWs
--      >             xcf = setEwmhActivateHook ah
--      >                 . ewmh $ def{ modMask = mod4Mask }
--      >         xmonad xcf
--
-- 2. Or i may move activated window to current workspace and switch focus to
--    it:
--
--      >         let ah :: ManageHook
--      >             ah = activateOnCurrentWs
--
-- 3. Or move activated window to current workspace, but keep focus unchanged:
--
--      >         let ah :: ManageHook
--      >             ah = activateOnCurrentKeepFocus
--
-- 4. I may use regular 'ManageHook' combinators for filtering, which windows
--    may activate. E.g. activate all windows, except firefox:
--
--      >         let ah :: ManageHook
--      >             ah  = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel")
--      >                     --> activateSwitchWs
--
-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless
--    xterm is focused on /current/ workspace:
--
--      >         let ah :: ManageHook
--      >             ah  = manageFocus (not <$> focusedCur (className =? "XTerm")
--      >                     --> liftQuery activateSwitchWs)
--
--      or activate all windows, unless focused window on the workspace,
--      /where activated window is/, is not a xterm:
--
--      >         let ah :: ManageHook
--      >             ah  = manageFocus (not <$> focused (className =? "XTerm")
--      >                     --> liftQuery activateSwitchWs)
--
-- == Defining FocusHook.
--
-- I may define my own 'FocusHook' like:
--
-- >    activateFocusHook :: FocusHook
-- >    activateFocusHook = composeAll
-- >            -- If 'gmrun' is focused on workspace, on which
-- >            -- /activated window/ is, keep focus unchanged. But i
-- >            -- may still switch workspace (thus, i use 'composeAll').
-- >            -- See 'keepFocus' properties in the docs below.
-- >            [ focused (className =? "Gmrun")
-- >                            --> keepFocus
-- >            -- Default behavior for activated windows: switch
-- >            -- workspace and focus.
-- >            , return True   --> switchWorkspace <> switchFocus
-- >            ]
-- >
-- >    newFocusHook :: FocusHook
-- >    newFocusHook      = composeOne
-- >            -- Always switch focus to 'gmrun'.
-- >            [ new (className =? "Gmrun")        -?> switchFocus
-- >            -- And always keep focus on 'gmrun'. Note, that
-- >            -- another 'gmrun' will steal focus from already
-- >            -- running one.
-- >            , focused (className =? "Gmrun")    -?> keepFocus
-- >            -- If firefox dialog prompt (e.g. master password
-- >            -- prompt) is focused on current workspace and new
-- >            -- window appears here too, keep focus unchanged
-- >            -- (note, used predicates: @newOnCur <&&> focused@ is
-- >            -- the same as @newOnCur <&&> focusedCur@, but is
-- >            -- /not/ the same as just 'focusedCur' )
-- >            , newOnCur <&&> focused
-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
-- >                                                -?> keepFocus
-- >            -- Default behavior for new windows: switch focus.
-- >            , return True                       -?> switchFocus
-- >            ]
--
-- And then use it:
--
-- >    import XMonad
-- >    import XMonad.Util.EZConfig
-- >
-- >    import XMonad.Hooks.EwmhDesktops
-- >    import XMonad.Hooks.ManageHelpers
-- >    import XMonad.Hooks.Focus
-- >
-- >
-- >    main :: IO ()
-- >    main = do
-- >            let newFh :: ManageHook
-- >                newFh = manageFocus newFocusHook
-- >                acFh :: ManageHook
-- >                acFh = manageFocus activateFocusHook
-- >                xcf = setEwmhActivateHook acFh
-- >                    . ewmh $ def
-- >                             { manageHook   = newFh <> manageHook def
-- >                             , modMask      = mod4Mask
-- >                             }
-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- >            xmonad xcf
--
-- Note:
--
--  - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
--  workspace won't be switched).
--  - I need "XMonad.Hooks.EwmhDesktops" module for enabling window
--  activation.
--  - 'FocusHook' in 'manageHook' will be called /only/ for new windows.
--  - 'FocusHook' in 'setEwmhActivateHook' will be called /only/ for activated windows.
--
--  Alternatively, i may construct a single 'FocusHook' for both new and
--  activated windows and then just add it to both 'manageHook' and 'setEwmhActivateHook':
--
-- >            let fh :: Bool -> ManageHook
-- >                fh activated = manageFocus $ composeOne
-- >                        [ pure activated -?> activateFocusHook
-- >                        , pure True      -?> newFocusHook
-- >                        ]
-- >                xcf = setEwmhActivateHook (fh True)
-- >                    . ewmh $ def
-- >                             { manageHook   = fh False <> manageHook def
-- >                             , modMask      = mod4Mask
-- >                             }
-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
--
-- And more technical notes:
--
--  - 'FocusHook' will run /many/ times, so it usually should not keep state
--  or save results. Precisely, it may do anything, but it must be idempotent
--  to operate properly.
--  - 'FocusHook' will see new window at workspace, where functions on the
--  /right/ from it in 'ManageHook' monoid place it.  In other words, in
--  @(Endo WindowSet)@ monoid i may see changes only from functions applied
--  /before/ (more to the right in function composition). Thus, it's better to
--  add 'FocusHook' the last.
--  - 'FocusHook' functions won't see window shift to another workspace made
--  by function from 'FocusHook' itself: new window workspace is determined
--  /before/ running 'FocusHook' and even if later one of 'FocusHook'
--  functions moves window to another workspace, predicates ('focused',
--  'newOn', etc) will still think new window is at workspace it was before.
--  This can be worked around by splitting 'FocusHook' into several different
--  values and evaluating each one separately, like:
--
--      > (FH2 -- manageFocus --> MH2) <> (FH1 -- manageFocus --> MH1) <> ..
--
--      E.g.
--
--      > manageFocus FH2 <> manageFocus FH1 <> ..
--
--      now @FH2@ will see window shift made by @FH1@.
--
-- Another interesting example is moving all activated windows to current
-- workspace by default, and applying 'FocusHook' after:
--
-- >    import XMonad
-- >    import XMonad.Util.EZConfig
-- >
-- >    import XMonad.Hooks.EwmhDesktops
-- >    import XMonad.Hooks.ManageHelpers
-- >    import XMonad.Hooks.Focus
-- >
-- >    main :: IO ()
-- >    main = do
-- >            let fh :: Bool -> ManageHook
-- >                fh activated = manageFocus $ composeOne
-- >                        [ pure activated -?> (newOnCur --> keepFocus)
-- >                        , pure True      -?> newFocusHook
-- >                        ]
-- >                xcf = setEwmhActivateHook (fh True <> activateOnCurrentWs)
-- >                    . ewmh $ def
-- >                             { manageHook = fh False <> manageHook def
-- >                             , modMask    = mod4Mask
-- >                             }
-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
-- >            xmonad xcf
-- >
-- >    newFocusHook :: FocusHook
-- >    newFocusHook      = composeOne
-- >            -- Always switch focus to 'gmrun'.
-- >            [ new (className =? "Gmrun")        -?> switchFocus
-- >            -- And always keep focus on 'gmrun'. Note, that
-- >            -- another 'gmrun' will steal focus from already
-- >            -- running one.
-- >            , focused (className =? "Gmrun")    -?> keepFocus
-- >            -- If firefox dialog prompt (e.g. master password
-- >            -- prompt) is focused on current workspace and new
-- >            -- window appears here too, keep focus unchanged
-- >            -- (note, used predicates: @newOnCur <&&> focused@ is
-- >            -- the same as @newOnCur <&&> focusedCur@, but is
-- >            -- /not/ the same as just 'focusedCur' )
-- >            , newOnCur <&&> focused
-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
-- >                                                -?> keepFocus
-- >            -- Default behavior for new windows: switch focus.
-- >            , return True                       -?> switchFocus
-- >            ]
--
-- Note here:
--
--  - i keep focus, when activated window appears on current workspace, in
--  this example.
--  - when @pure activated -?> (newOnCur --> keepFocus)@ runs, activated
--  window will be /already/ on current workspace, thus, if i do not want to
--  move some activated windows, i should filter them out before applying
--  @activateOnCurrentWs@ 'FocusHook'.


-- FocusQuery.
-- $focusquery

-- | Information about current workspace and focus.
data Focus          = Focus
                        { -- | Workspace, where new window appears.
                          Focus -> WorkspaceId
newWorkspace      :: WorkspaceId
                          -- | Focused window on workspace, where new window
                          -- appears.
                        , Focus -> Maybe Window
focusedWindow     :: Maybe Window
                          -- | Current workspace.
                        , Focus -> WorkspaceId
currentWorkspace  :: WorkspaceId
                        }
  deriving (Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Focus] -> ShowS
$cshowList :: [Focus] -> ShowS
show :: Focus -> WorkspaceId
$cshow :: Focus -> WorkspaceId
showsPrec :: Int -> Focus -> ShowS
$cshowsPrec :: Int -> Focus -> ShowS
Show)
instance Default Focus where
    def :: Focus
def             = Focus
                        { focusedWindow :: Maybe Window
focusedWindow     = forall a. Maybe a
Nothing
                        , newWorkspace :: WorkspaceId
newWorkspace      = WorkspaceId
""
                        , currentWorkspace :: WorkspaceId
currentWorkspace  = WorkspaceId
""
                        }

newtype FocusLock   = FocusLock {FocusLock -> Bool
getFocusLock :: Bool}
  deriving (Int -> FocusLock -> ShowS
[FocusLock] -> ShowS
FocusLock -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [FocusLock] -> ShowS
$cshowList :: [FocusLock] -> ShowS
show :: FocusLock -> WorkspaceId
$cshow :: FocusLock -> WorkspaceId
showsPrec :: Int -> FocusLock -> ShowS
$cshowsPrec :: Int -> FocusLock -> ShowS
Show)
instance ExtensionClass FocusLock where
    initialValue :: FocusLock
initialValue    = Bool -> FocusLock
FocusLock Bool
False

-- | Toggle stored focus lock state.
toggleLock :: X ()
toggleLock :: X ()
toggleLock          = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (\(FocusLock Bool
b) -> Bool -> FocusLock
FocusLock (Bool -> Bool
not Bool
b))

-- | Lock focus.
focusLockOn :: X ()
focusLockOn :: X ()
focusLockOn         = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (forall a b. a -> b -> a
const (Bool -> FocusLock
FocusLock Bool
True))

-- | Unlock focus.
focusLockOff :: X ()
focusLockOff :: X ()
focusLockOff        = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (forall a b. a -> b -> a
const (Bool -> FocusLock
FocusLock Bool
False))

-- | Monad on top of 'Query' providing additional information about new
-- window.
newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
  deriving newtype (forall a b. a -> FocusQuery b -> FocusQuery a
forall a b. (a -> b) -> FocusQuery a -> FocusQuery b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FocusQuery b -> FocusQuery a
$c<$ :: forall a b. a -> FocusQuery b -> FocusQuery a
fmap :: forall a b. (a -> b) -> FocusQuery a -> FocusQuery b
$cfmap :: forall a b. (a -> b) -> FocusQuery a -> FocusQuery b
Functor, Functor FocusQuery
forall a. a -> FocusQuery a
forall a b. FocusQuery a -> FocusQuery b -> FocusQuery a
forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
forall a b. FocusQuery (a -> b) -> FocusQuery a -> FocusQuery b
forall a b c.
(a -> b -> c) -> FocusQuery a -> FocusQuery b -> FocusQuery c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery a
$c<* :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery a
*> :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
$c*> :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
liftA2 :: forall a b c.
(a -> b -> c) -> FocusQuery a -> FocusQuery b -> FocusQuery c
$cliftA2 :: forall a b c.
(a -> b -> c) -> FocusQuery a -> FocusQuery b -> FocusQuery c
<*> :: forall a b. FocusQuery (a -> b) -> FocusQuery a -> FocusQuery b
$c<*> :: forall a b. FocusQuery (a -> b) -> FocusQuery a -> FocusQuery b
pure :: forall a. a -> FocusQuery a
$cpure :: forall a. a -> FocusQuery a
Applicative, Applicative FocusQuery
forall a. a -> FocusQuery a
forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
forall a b. FocusQuery a -> (a -> FocusQuery b) -> FocusQuery b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> FocusQuery a
$creturn :: forall a. a -> FocusQuery a
>> :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
$c>> :: forall a b. FocusQuery a -> FocusQuery b -> FocusQuery b
>>= :: forall a b. FocusQuery a -> (a -> FocusQuery b) -> FocusQuery b
$c>>= :: forall a b. FocusQuery a -> (a -> FocusQuery b) -> FocusQuery b
Monad, MonadReader Focus, Monad FocusQuery
forall a. IO a -> FocusQuery a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> FocusQuery a
$cliftIO :: forall a. IO a -> FocusQuery a
MonadIO)
  deriving (NonEmpty (FocusQuery a) -> FocusQuery a
FocusQuery a -> FocusQuery a -> FocusQuery a
forall b. Integral b => b -> FocusQuery a -> FocusQuery a
forall a. Semigroup a => NonEmpty (FocusQuery a) -> FocusQuery a
forall a.
Semigroup a =>
FocusQuery a -> FocusQuery a -> FocusQuery a
forall a b.
(Semigroup a, Integral b) =>
b -> FocusQuery a -> FocusQuery a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> FocusQuery a -> FocusQuery a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> FocusQuery a -> FocusQuery a
sconcat :: NonEmpty (FocusQuery a) -> FocusQuery a
$csconcat :: forall a. Semigroup a => NonEmpty (FocusQuery a) -> FocusQuery a
<> :: FocusQuery a -> FocusQuery a -> FocusQuery a
$c<> :: forall a.
Semigroup a =>
FocusQuery a -> FocusQuery a -> FocusQuery a
Semigroup, FocusQuery a
[FocusQuery a] -> FocusQuery a
FocusQuery a -> FocusQuery a -> FocusQuery a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (FocusQuery a)
forall a. Monoid a => FocusQuery a
forall a. Monoid a => [FocusQuery a] -> FocusQuery a
forall a. Monoid a => FocusQuery a -> FocusQuery a -> FocusQuery a
mconcat :: [FocusQuery a] -> FocusQuery a
$cmconcat :: forall a. Monoid a => [FocusQuery a] -> FocusQuery a
mappend :: FocusQuery a -> FocusQuery a -> FocusQuery a
$cmappend :: forall a. Monoid a => FocusQuery a -> FocusQuery a -> FocusQuery a
mempty :: FocusQuery a
$cmempty :: forall a. Monoid a => FocusQuery a
Monoid) via Ap FocusQuery a

runFocusQuery :: FocusQuery a -> Focus -> Query a
runFocusQuery :: forall a. FocusQuery a -> Focus -> Query a
runFocusQuery (FocusQuery ReaderT Focus Query a
m)    = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Focus Query a
m

type FocusHook = FocusQuery (Endo WindowSet)


-- Lifting into 'FocusQuery'.
-- $lift

-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.
liftQuery :: Query a -> FocusQuery a
liftQuery :: forall a. Query a -> FocusQuery a
liftQuery           = forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Run 'Query' on new window.
new :: Query a -> FocusQuery a
new :: forall a. Query a -> FocusQuery a
new                 = forall a. Query a -> FocusQuery a
liftQuery

-- | Run 'Query' on focused window on workspace, where new window appears. If
-- there is no focused window, return 'False'.
focused :: Query Bool -> FocusQuery Bool
focused :: Query Bool -> FocusQuery Bool
focused Query Bool
m           = Any -> Bool
getAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Monoid a => Query a -> FocusQuery a
focused' (Bool -> Any
Any forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
-- | More general version of 'focused'.
focused' :: Monoid a => Query a -> FocusQuery a
focused' :: forall a. Monoid a => Query a -> FocusQuery a
focused' Query a
m          = do
    Maybe Window
mw <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> Maybe Window
focusedWindow
    forall a. Query a -> FocusQuery a
liftQuery (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Query a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) Maybe Window
mw)

-- | Run 'Query' on window focused at particular workspace. If there is no
-- focused window, return 'False'.
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn WorkspaceId
i Query Bool
m       = Any -> Bool
getAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i (Bool -> Any
Any forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
-- | More general version of 'focusedOn'.
focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' :: forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i Query a
m      = forall a. Query a -> FocusQuery a
liftQuery forall a b. (a -> b) -> a -> b
$ do
    Maybe Window
mw <- forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (WindowSet -> X a) -> X a
withWindowSet (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
i)
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Query a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const) Maybe Window
mw

-- | Run 'Query' on focused window on current workspace. If there is no
-- focused window, return 'False'.  Note,
--
-- > focused <&&> newOnCur != focusedCur
--
-- The first will affect only new or activated window appearing on current
-- workspace, while the last will affect any window: focus even for windows
-- appearing on other workpsaces will depend on focus on /current/ workspace.
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur Query Bool
m        = Any -> Bool
getAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Monoid a => Query a -> FocusQuery a
focusedCur' (Bool -> Any
Any forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
-- | More general version of 'focusedCur'.
focusedCur' :: Monoid a => Query a -> FocusQuery a
focusedCur' :: forall a. Monoid a => Query a -> FocusQuery a
focusedCur' Query a
m       = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
i -> forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i Query a
m

-- | Does new window appear at particular workspace?
newOn :: WorkspaceId -> FocusQuery Bool
newOn :: WorkspaceId -> FocusQuery Bool
newOn WorkspaceId
i             = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((WorkspaceId
i forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> WorkspaceId
newWorkspace)
-- | Does new window appear at current workspace?
newOnCur :: FocusQuery Bool
newOnCur :: FocusQuery Bool
newOnCur            = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> FocusQuery Bool
newOn

-- | Execute 'Query', unless focus is locked.
unlessFocusLock :: Monoid a => Query a -> Query a
unlessFocusLock :: forall a. Monoid a => Query a -> Query a
unlessFocusLock Query a
m   = do
    FocusLock Bool
b <- forall a. X a -> Query a
liftX forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (Bool -> Bool
not Bool
b) Query a
m

-- Commonly used actions for modifying focus.
--
-- $common
-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and
-- 'switchWorkspace' overwrite each other (the letftmost will determine what
-- happened):
--
-- prop> keepFocus       <> switchFocus     = keepFocus
-- prop> switchFocus     <> keepFocus       = switchFocus
-- prop> keepWorkspace   <> switchWorkspace = keepWorkspace
-- prop> switchWorkspace <> keepWorkspace   = switchWorkspace
--
-- and operations from different pairs are commutative:
--
-- prop> keepFocus   <> switchWorkspace = switchWorkspace <> keepFocus
-- prop> switchFocus <> switchWorkspace = switchWorkspace <> switchFocus
--
-- etc.

-- | Keep focus on workspace (may not be current), where new window appears.
-- Workspace will not be switched. This operation is idempotent and
-- effectively returns focus to window focused on that workspace before
-- applying @(Endo WindowSet)@ function.
keepFocus :: FocusHook
keepFocus :: FocusHook
keepFocus           = forall a. Monoid a => Query a -> FocusQuery a
focused' forall a b. (a -> b) -> a -> b
$ 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 s. (s -> s) -> Query (Endo s)
doF forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
                        forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
w forall a b. (a -> b) -> a -> b
$ WindowSet
ws

-- | Switch focus to new window on workspace (may not be current), where new
-- window appears. Workspace will not be switched. This operation is
-- idempotent.
switchFocus :: FocusHook
switchFocus :: FocusHook
switchFocus         = do
    FocusLock Bool
b <- forall a. Query a -> FocusQuery a
liftQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    if Bool
b
      -- When focus lock is enabled, call 'keepFocus' explicitly (still no
      -- 'keepWorkspace') to overwrite default behavior.
      then FocusHook
keepFocus
      else forall a. Query a -> FocusQuery a
new forall a b. (a -> b) -> a -> b
$ 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 s. (s -> s) -> Query (Endo s)
doF forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
            forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
w forall a b. (a -> b) -> a -> b
$ WindowSet
ws

-- | Keep current workspace. Focus will not be changed at either current or
-- new window's  workspace. This operation is idempotent and effectively
-- switches to workspace, which was current before applying @(Endo WindowSet)@
-- function.
keepWorkspace :: FocusHook
keepWorkspace :: FocusHook
keepWorkspace       = do
    WorkspaceId
ws <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace
    forall a. Query a -> FocusQuery a
liftQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. (s -> s) -> Query (Endo s)
doF forall a b. (a -> b) -> a -> b
$ forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
ws

-- | Switch workspace to one, where new window appears. Focus will not be
-- changed at either current or new window's workspace. This operation is
-- idempotent.
switchWorkspace :: FocusHook
switchWorkspace :: FocusHook
switchWorkspace     = do
    FocusLock Bool
b <- forall a. Query a -> FocusQuery a
liftQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
    if Bool
b
      -- When focus lock is enabled, call 'keepWorkspace' explicitly (still no
      -- 'keepFocus') to overwrite default behavior.
      then FocusHook
keepWorkspace
      else do
        WorkspaceId
ws <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
newWorkspace
        forall a. Query a -> FocusQuery a
liftQuery forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. (s -> s) -> Query (Endo s)
doF forall a b. (a -> b) -> a -> b
$ forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view WorkspaceId
ws

-- Running FocusQuery.
-- $running

-- | I don't know at which workspace new window will appear until @(Endo
-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run,
-- but in @(Endo WindowSet)@ function i can't already execute monadic actions,
-- because it's pure. So, i compute result for every workspace here and just
-- use it later in @(Endo WindowSet)@ function.  Note, though, that this will
-- execute monadic actions many times, and therefore assume, that result of
-- 'FocusHook' does not depend on the number of times it was executed.
manageFocus :: FocusHook -> ManageHook
manageFocus :: FocusHook -> ManageHook
manageFocus FocusHook
m       = do
    [(WorkspaceId, Maybe Window)]
fws <- forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
W.tag forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack a -> a
W.focus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces
    WorkspaceId
ct  <- Query WorkspaceId
currentWs
    let r :: Focus
r = forall a. Default a => a
def {currentWorkspace :: WorkspaceId
currentWorkspace = WorkspaceId
ct}
    [(WorkspaceId, Endo WindowSet)]
hs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(WorkspaceId, Maybe Window)]
fws forall a b. (a -> b) -> a -> b
$ \(WorkspaceId
i, Maybe Window
mw) -> do
      Endo WindowSet
f <- forall a. FocusQuery a -> Focus -> Query a
runFocusQuery FocusHook
m (Focus
r {focusedWindow :: Maybe Window
focusedWindow = Maybe Window
mw, newWorkspace :: WorkspaceId
newWorkspace = WorkspaceId
i})
      forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId
i, Endo WindowSet
f)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader ([(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook [(WorkspaceId, Endo WindowSet)]
hs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. (s -> s) -> Query (Endo s)
doF
  where
    -- | Select and apply @(Endo WindowSet)@ function depending on which
    -- workspace new window appeared now.
    selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
    selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook [(WorkspaceId, Endo WindowSet)]
cfs Window
nw WindowSet
ws    = forall a. a -> Maybe a -> a
fromMaybe WindowSet
ws forall a b. (a -> b) -> a -> b
$ do
        WorkspaceId
i <- forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
nw WindowSet
ws
        Endo WindowSet
f <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
i [(WorkspaceId, Endo WindowSet)]
cfs
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Endo a -> a -> a
appEndo Endo WindowSet
f WindowSet
ws)

when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' :: forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' Bool
b m a
mx
  | Bool
b               = m a
mx
  | Bool
otherwise       = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

-- Exmaple configurations.
-- $examples

-- | Default EWMH window activation behavior: switch to workspace with
-- activated window and switch focus to it. Not to be used in a 'manageHook'.
activateSwitchWs :: ManageHook
activateSwitchWs :: ManageHook
activateSwitchWs    = FocusHook -> ManageHook
manageFocus (FocusHook
switchWorkspace forall a. Semigroup a => a -> a -> a
<> FocusHook
switchFocus)

-- | Move activated window to current workspace. Not to be used in a 'manageHook'.
activateOnCurrent' :: ManageHook
activateOnCurrent' :: ManageHook
activateOnCurrent'  = Query WorkspaceId
currentWs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Monoid a => Query a -> Query a
unlessFocusLock forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> ManageHook
doShift

-- | Move activated window to current workspace and switch focus to it. Note,
-- that i need to explicitly call 'switchFocus' here, because otherwise, when
-- activated window is /already/ on current workspace, focus won't be
-- switched. Not to be used in a 'manageHook'.
activateOnCurrentWs :: ManageHook
activateOnCurrentWs :: ManageHook
activateOnCurrentWs = FocusHook -> ManageHook
manageFocus (FocusQuery Bool
newOnCur forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> FocusHook
switchFocus) forall a. Semigroup a => a -> a -> a
<> ManageHook
activateOnCurrent'

-- | Move activated window to current workspace, but keep focus unchanged.
-- Not to be used in a 'manageHook'.
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus  = FocusHook -> ManageHook
manageFocus (FocusQuery Bool
newOnCur forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> FocusHook
keepFocus) forall a. Semigroup a => a -> a -> a
<> ManageHook
activateOnCurrent'