{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_HADDOCK show-extensions #-}
module XMonad.Hooks.Focus
(
Focus (..)
, FocusLock (..)
, toggleLock
, focusLockOn
, focusLockOff
, FocusQuery
, runFocusQuery
, FocusHook
, liftQuery
, new
, focused
, focused'
, focusedOn
, focusedOn'
, focusedCur
, focusedCur'
, newOn
, newOnCur
, unlessFocusLock
, keepFocus
, switchFocus
, keepWorkspace
, switchWorkspace
, manageFocus
, 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)
data Focus = Focus
{
Focus -> WorkspaceId
newWorkspace :: WorkspaceId
, Focus -> Maybe Window
focusedWindow :: Maybe Window
, Focus -> WorkspaceId
currentWorkspace :: WorkspaceId
}
deriving (Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> WorkspaceId
(Int -> Focus -> ShowS)
-> (Focus -> WorkspaceId) -> ([Focus] -> ShowS) -> Show Focus
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 :: WorkspaceId -> Maybe Window -> WorkspaceId -> Focus
Focus
{ focusedWindow :: Maybe Window
focusedWindow = Maybe Window
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
(Int -> FocusLock -> ShowS)
-> (FocusLock -> WorkspaceId)
-> ([FocusLock] -> ShowS)
-> Show FocusLock
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
toggleLock :: X ()
toggleLock :: X ()
toggleLock = (FocusLock -> FocusLock) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (\(FocusLock Bool
b) -> Bool -> FocusLock
FocusLock (Bool -> Bool
not Bool
b))
focusLockOn :: X ()
focusLockOn :: X ()
focusLockOn = (FocusLock -> FocusLock) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (FocusLock -> FocusLock -> FocusLock
forall a b. a -> b -> a
const (Bool -> FocusLock
FocusLock Bool
True))
focusLockOff :: X ()
focusLockOff :: X ()
focusLockOff = (FocusLock -> FocusLock) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (FocusLock -> FocusLock -> FocusLock
forall a b. a -> b -> a
const (Bool -> FocusLock
FocusLock Bool
False))
newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
instance Functor FocusQuery where
fmap :: forall a b. (a -> b) -> FocusQuery a -> FocusQuery b
fmap a -> b
f (FocusQuery ReaderT Focus Query a
x) = ReaderT Focus Query b -> FocusQuery b
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery ((a -> b) -> ReaderT Focus Query a -> ReaderT Focus Query b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f ReaderT Focus Query a
x)
instance Applicative FocusQuery where
pure :: forall a. a -> FocusQuery a
pure a
x = ReaderT Focus Query a -> FocusQuery a
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery (a -> ReaderT Focus Query a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
(FocusQuery ReaderT Focus Query (a -> b)
f) <*> :: forall a b. FocusQuery (a -> b) -> FocusQuery a -> FocusQuery b
<*> (FocusQuery ReaderT Focus Query a
mx) = ReaderT Focus Query b -> FocusQuery b
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery (ReaderT Focus Query (a -> b)
f ReaderT Focus Query (a -> b)
-> ReaderT Focus Query a -> ReaderT Focus Query b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReaderT Focus Query a
mx)
instance Monad FocusQuery where
(FocusQuery ReaderT Focus Query a
mx) >>= :: forall a b. FocusQuery a -> (a -> FocusQuery b) -> FocusQuery b
>>= a -> FocusQuery b
f = ReaderT Focus Query b -> FocusQuery b
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery (ReaderT Focus Query b -> FocusQuery b)
-> ReaderT Focus Query b -> FocusQuery b
forall a b. (a -> b) -> a -> b
$ ReaderT Focus Query a
mx ReaderT Focus Query a
-> (a -> ReaderT Focus Query b) -> ReaderT Focus Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x ->
let FocusQuery ReaderT Focus Query b
y = a -> FocusQuery b
f a
x in ReaderT Focus Query b
y
instance MonadReader Focus FocusQuery where
ask :: FocusQuery Focus
ask = ReaderT Focus Query Focus -> FocusQuery Focus
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery ReaderT Focus Query Focus
forall r (m :: * -> *). MonadReader r m => m r
ask
local :: forall a. (Focus -> Focus) -> FocusQuery a -> FocusQuery a
local Focus -> Focus
f (FocusQuery ReaderT Focus Query a
mx) = ReaderT Focus Query a -> FocusQuery a
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery ((Focus -> Focus) -> ReaderT Focus Query a -> ReaderT Focus Query a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Focus -> Focus
f ReaderT Focus Query a
mx)
instance MonadIO FocusQuery where
liftIO :: forall a. IO a -> FocusQuery a
liftIO IO a
mx = ReaderT Focus Query a -> FocusQuery a
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery (IO a -> ReaderT Focus Query a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
mx)
instance Semigroup a => Semigroup (FocusQuery a) where
<> :: FocusQuery a -> FocusQuery a -> FocusQuery a
(<>) = (a -> a -> a) -> FocusQuery a -> FocusQuery a -> FocusQuery a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (FocusQuery a) where
mempty :: FocusQuery a
mempty = a -> FocusQuery a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
runFocusQuery :: FocusQuery a -> Focus -> Query a
runFocusQuery :: forall a. FocusQuery a -> Focus -> Query a
runFocusQuery (FocusQuery ReaderT Focus Query a
m) = ReaderT Focus Query a -> Focus -> Query a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Focus Query a
m
type FocusHook = FocusQuery (Endo WindowSet)
liftQuery :: Query a -> FocusQuery a
liftQuery :: forall a. Query a -> FocusQuery a
liftQuery = ReaderT Focus Query a -> FocusQuery a
forall a. ReaderT Focus Query a -> FocusQuery a
FocusQuery (ReaderT Focus Query a -> FocusQuery a)
-> (Query a -> ReaderT Focus Query a) -> Query a -> FocusQuery a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query a -> ReaderT Focus Query a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
new :: Query a -> FocusQuery a
new :: forall a. Query a -> FocusQuery a
new = Query a -> FocusQuery a
forall a. Query a -> FocusQuery a
liftQuery
focused :: Query Bool -> FocusQuery Bool
focused :: Query Bool -> FocusQuery Bool
focused Query Bool
m = Any -> Bool
getAny (Any -> Bool) -> FocusQuery Any -> FocusQuery Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Any -> FocusQuery Any
forall a. Monoid a => Query a -> FocusQuery a
focused' (Bool -> Any
Any (Bool -> Any) -> Query Bool -> Query Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
focused' :: Monoid a => Query a -> FocusQuery a
focused' :: forall a. Monoid a => Query a -> FocusQuery a
focused' Query a
m = do
Maybe Window
mw <- (Focus -> Maybe Window) -> FocusQuery (Maybe Window)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> Maybe Window
focusedWindow
Query a -> FocusQuery a
forall a. Query a -> FocusQuery a
liftQuery (Query a -> (Window -> Query a) -> Maybe Window -> Query a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query a
forall a. Monoid a => a
mempty (((Window -> Window) -> Query a -> Query a)
-> Query a -> (Window -> Window) -> Query a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Window -> Window) -> Query a -> Query a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Query a
m ((Window -> Window) -> Query a)
-> (Window -> Window -> Window) -> Window -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window -> Window
forall a b. a -> b -> a
const) Maybe Window
mw)
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
focusedOn WorkspaceId
i Query Bool
m = Any -> Bool
getAny (Any -> Bool) -> FocusQuery Any -> FocusQuery Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WorkspaceId -> Query Any -> FocusQuery Any
forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i (Bool -> Any
Any (Bool -> Any) -> Query Bool -> Query Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' :: forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i Query a
m = Query a -> FocusQuery a
forall a. Query a -> FocusQuery a
liftQuery (Query a -> FocusQuery a) -> Query a -> FocusQuery a
forall a b. (a -> b) -> a -> b
$ do
Maybe Window
mw <- X (Maybe Window) -> Query (Maybe Window)
forall a. X a -> Query a
liftX (X (Maybe Window) -> Query (Maybe Window))
-> X (Maybe Window) -> Query (Maybe Window)
forall a b. (a -> b) -> a -> b
$ (WindowSet -> X (Maybe Window)) -> X (Maybe Window)
forall a. (WindowSet -> X a) -> X a
withWindowSet (Maybe Window -> X (Maybe Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> X (Maybe Window))
-> (WindowSet -> Maybe Window) -> WindowSet -> X (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window)
-> (WindowSet -> WindowSet) -> WindowSet -> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
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)
Query a -> (Window -> Query a) -> Maybe Window -> Query a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query a
forall a. Monoid a => a
mempty (((Window -> Window) -> Query a -> Query a)
-> Query a -> (Window -> Window) -> Query a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Window -> Window) -> Query a -> Query a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local Query a
m ((Window -> Window) -> Query a)
-> (Window -> Window -> Window) -> Window -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Window -> Window
forall a b. a -> b -> a
const) Maybe Window
mw
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur :: Query Bool -> FocusQuery Bool
focusedCur Query Bool
m = Any -> Bool
getAny (Any -> Bool) -> FocusQuery Any -> FocusQuery Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Any -> FocusQuery Any
forall a. Monoid a => Query a -> FocusQuery a
focusedCur' (Bool -> Any
Any (Bool -> Any) -> Query Bool -> Query Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Bool
m)
focusedCur' :: Monoid a => Query a -> FocusQuery a
focusedCur' :: forall a. Monoid a => Query a -> FocusQuery a
focusedCur' Query a
m = (Focus -> WorkspaceId) -> FocusQuery WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace FocusQuery WorkspaceId
-> (WorkspaceId -> FocusQuery a) -> FocusQuery a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \WorkspaceId
i -> WorkspaceId -> Query a -> FocusQuery a
forall a. Monoid a => WorkspaceId -> Query a -> FocusQuery a
focusedOn' WorkspaceId
i Query a
m
newOn :: WorkspaceId -> FocusQuery Bool
newOn :: WorkspaceId -> FocusQuery Bool
newOn WorkspaceId
i = (Focus -> Bool) -> FocusQuery Bool
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((WorkspaceId
i WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
==) (WorkspaceId -> Bool) -> (Focus -> WorkspaceId) -> Focus -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Focus -> WorkspaceId
newWorkspace)
newOnCur :: FocusQuery Bool
newOnCur :: FocusQuery Bool
newOnCur = (Focus -> WorkspaceId) -> FocusQuery WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace FocusQuery WorkspaceId
-> (WorkspaceId -> FocusQuery Bool) -> FocusQuery Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> FocusQuery Bool
newOn
unlessFocusLock :: Monoid a => Query a -> Query a
unlessFocusLock :: forall a. Monoid a => Query a -> Query a
unlessFocusLock Query a
m = do
FocusLock Bool
b <- X FocusLock -> Query FocusLock
forall a. X a -> Query a
liftX X FocusLock
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
Bool -> Query a -> Query a
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (Bool -> Bool
not Bool
b) Query a
m
keepFocus :: FocusHook
keepFocus :: FocusHook
keepFocus = ManageHook -> FocusHook
forall a. Monoid a => Query a -> FocusQuery a
focused' (ManageHook -> FocusHook) -> ManageHook -> FocusHook
forall a b. (a -> b) -> a -> b
$ 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 -> (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF ((WindowSet -> WindowSet) -> ManageHook)
-> (WindowSet -> WindowSet) -> ManageHook
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
WorkspaceId -> WindowSet -> WindowSet
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 (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
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 (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
switchFocus :: FocusHook
switchFocus :: FocusHook
switchFocus = do
FocusLock Bool
b <- Query FocusLock -> FocusQuery FocusLock
forall a. Query a -> FocusQuery a
liftQuery (Query FocusLock -> FocusQuery FocusLock)
-> (X FocusLock -> Query FocusLock)
-> X FocusLock
-> FocusQuery FocusLock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X FocusLock -> Query FocusLock
forall a. X a -> Query a
liftX (X FocusLock -> FocusQuery FocusLock)
-> X FocusLock -> FocusQuery FocusLock
forall a b. (a -> b) -> a -> b
$ X FocusLock
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
if Bool
b
then FocusHook
keepFocus
else ManageHook -> FocusHook
forall a. Query a -> FocusQuery a
new (ManageHook -> FocusHook) -> ManageHook -> FocusHook
forall a b. (a -> b) -> a -> b
$ 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 -> (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF ((WindowSet -> WindowSet) -> ManageHook)
-> (WindowSet -> WindowSet) -> ManageHook
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
WorkspaceId -> WindowSet -> WindowSet
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 (WindowSet -> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
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 (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ WindowSet
ws
keepWorkspace :: FocusHook
keepWorkspace :: FocusHook
keepWorkspace = do
WorkspaceId
ws <- (Focus -> WorkspaceId) -> FocusQuery WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
currentWorkspace
ManageHook -> FocusHook
forall a. Query a -> FocusQuery a
liftQuery (ManageHook -> FocusHook)
-> ((WindowSet -> WindowSet) -> ManageHook)
-> (WindowSet -> WindowSet)
-> FocusHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF ((WindowSet -> WindowSet) -> FocusHook)
-> (WindowSet -> WindowSet) -> FocusHook
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
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
switchWorkspace :: FocusHook
switchWorkspace :: FocusHook
switchWorkspace = do
FocusLock Bool
b <- Query FocusLock -> FocusQuery FocusLock
forall a. Query a -> FocusQuery a
liftQuery (Query FocusLock -> FocusQuery FocusLock)
-> (X FocusLock -> Query FocusLock)
-> X FocusLock
-> FocusQuery FocusLock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X FocusLock -> Query FocusLock
forall a. X a -> Query a
liftX (X FocusLock -> FocusQuery FocusLock)
-> X FocusLock -> FocusQuery FocusLock
forall a b. (a -> b) -> a -> b
$ X FocusLock
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
if Bool
b
then FocusHook
keepWorkspace
else do
WorkspaceId
ws <- (Focus -> WorkspaceId) -> FocusQuery WorkspaceId
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Focus -> WorkspaceId
newWorkspace
ManageHook -> FocusHook
forall a. Query a -> FocusQuery a
liftQuery (ManageHook -> FocusHook)
-> ((WindowSet -> WindowSet) -> ManageHook)
-> (WindowSet -> WindowSet)
-> FocusHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF ((WindowSet -> WindowSet) -> FocusHook)
-> (WindowSet -> WindowSet) -> FocusHook
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
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
manageFocus :: FocusHook -> ManageHook
manageFocus :: FocusHook -> ManageHook
manageFocus FocusHook
m = do
[(WorkspaceId, Maybe Window)]
fws <- X [(WorkspaceId, Maybe Window)]
-> Query [(WorkspaceId, Maybe Window)]
forall a. X a -> Query a
liftX (X [(WorkspaceId, Maybe Window)]
-> Query [(WorkspaceId, Maybe Window)])
-> ((WindowSet -> X [(WorkspaceId, Maybe Window)])
-> X [(WorkspaceId, Maybe Window)])
-> (WindowSet -> X [(WorkspaceId, Maybe Window)])
-> Query [(WorkspaceId, Maybe Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> X [(WorkspaceId, Maybe Window)])
-> X [(WorkspaceId, Maybe Window)]
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X [(WorkspaceId, Maybe Window)])
-> Query [(WorkspaceId, Maybe Window)])
-> (WindowSet -> X [(WorkspaceId, Maybe Window)])
-> Query [(WorkspaceId, Maybe Window)]
forall a b. (a -> b) -> a -> b
$ [(WorkspaceId, Maybe Window)] -> X [(WorkspaceId, Maybe Window)]
forall (m :: * -> *) a. Monad m => a -> m a
return
([(WorkspaceId, Maybe Window)] -> X [(WorkspaceId, Maybe Window)])
-> (WindowSet -> [(WorkspaceId, Maybe Window)])
-> WindowSet
-> X [(WorkspaceId, Maybe Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace WorkspaceId (Layout Window) Window
-> (WorkspaceId, Maybe Window))
-> [Workspace WorkspaceId (Layout Window) Window]
-> [(WorkspaceId, Maybe Window)]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (Workspace WorkspaceId (Layout Window) Window -> Maybe Window)
-> Workspace WorkspaceId (Layout Window) Window
-> (WorkspaceId, Maybe Window)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Stack Window -> Window) -> Maybe (Stack Window) -> Maybe Window
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stack Window -> Window
forall a. Stack a -> a
W.focus (Maybe (Stack Window) -> Maybe Window)
-> (Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window))
-> Workspace WorkspaceId (Layout Window) Window
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) ([Workspace WorkspaceId (Layout Window) Window]
-> [(WorkspaceId, Maybe Window)])
-> (WindowSet -> [Workspace WorkspaceId (Layout Window) Window])
-> WindowSet
-> [(WorkspaceId, Maybe Window)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> [Workspace WorkspaceId (Layout Window) Window]
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 = Focus
forall a. Default a => a
def {currentWorkspace :: WorkspaceId
currentWorkspace = WorkspaceId
ct}
[(WorkspaceId, Endo WindowSet)]
hs <- [(WorkspaceId, Maybe Window)]
-> ((WorkspaceId, Maybe Window)
-> Query (WorkspaceId, Endo WindowSet))
-> Query [(WorkspaceId, Endo WindowSet)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(WorkspaceId, Maybe Window)]
fws (((WorkspaceId, Maybe Window)
-> Query (WorkspaceId, Endo WindowSet))
-> Query [(WorkspaceId, Endo WindowSet)])
-> ((WorkspaceId, Maybe Window)
-> Query (WorkspaceId, Endo WindowSet))
-> Query [(WorkspaceId, Endo WindowSet)]
forall a b. (a -> b) -> a -> b
$ \(WorkspaceId
i, Maybe Window
mw) -> do
Endo WindowSet
f <- FocusHook -> Focus -> ManageHook
forall a. FocusQuery a -> Focus -> Query a
runFocusQuery FocusHook
m (Focus
r {focusedWindow :: Maybe Window
focusedWindow = Maybe Window
mw, newWorkspace :: WorkspaceId
newWorkspace = WorkspaceId
i})
(WorkspaceId, Endo WindowSet)
-> Query (WorkspaceId, Endo WindowSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceId
i, Endo WindowSet
f)
(Window -> WindowSet -> WindowSet)
-> Query (WindowSet -> WindowSet)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader ([(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook [(WorkspaceId, Endo WindowSet)]
hs) Query (WindowSet -> WindowSet)
-> ((WindowSet -> WindowSet) -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WindowSet -> WindowSet) -> ManageHook
forall s. (s -> s) -> Query (Endo s)
doF
where
selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
selectHook [(WorkspaceId, Endo WindowSet)]
cfs Window
nw WindowSet
ws = WindowSet -> Maybe WindowSet -> WindowSet
forall a. a -> Maybe a -> a
fromMaybe WindowSet
ws (Maybe WindowSet -> WindowSet) -> Maybe WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ do
WorkspaceId
i <- Window -> WindowSet -> Maybe WorkspaceId
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 <- WorkspaceId
-> [(WorkspaceId, Endo WindowSet)] -> Maybe (Endo WindowSet)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
i [(WorkspaceId, Endo WindowSet)]
cfs
WindowSet -> Maybe WindowSet
forall (m :: * -> *) a. Monad m => a -> m a
return (Endo WindowSet -> WindowSet -> WindowSet
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 = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
activateSwitchWs :: ManageHook
activateSwitchWs :: ManageHook
activateSwitchWs = FocusHook -> ManageHook
manageFocus (FocusHook
switchWorkspace FocusHook -> FocusHook -> FocusHook
forall a. Semigroup a => a -> a -> a
<> FocusHook
switchFocus)
activateOnCurrent' :: ManageHook
activateOnCurrent' :: ManageHook
activateOnCurrent' = Query WorkspaceId
currentWs Query WorkspaceId -> (WorkspaceId -> ManageHook) -> ManageHook
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ManageHook -> ManageHook
forall a. Monoid a => Query a -> Query a
unlessFocusLock (ManageHook -> ManageHook)
-> (WorkspaceId -> ManageHook) -> WorkspaceId -> ManageHook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> ManageHook
doShift
activateOnCurrentWs :: ManageHook
activateOnCurrentWs :: ManageHook
activateOnCurrentWs = FocusHook -> ManageHook
manageFocus (FocusQuery Bool
newOnCur FocusQuery Bool -> FocusHook -> FocusHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> FocusHook
switchFocus) ManageHook -> ManageHook -> ManageHook
forall a. Semigroup a => a -> a -> a
<> ManageHook
activateOnCurrent'
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus :: ManageHook
activateOnCurrentKeepFocus = FocusHook -> ManageHook
manageFocus (FocusQuery Bool
newOnCur FocusQuery Bool -> FocusHook -> FocusHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> FocusHook
keepFocus) ManageHook -> ManageHook -> ManageHook
forall a. Semigroup a => a -> a -> a
<> ManageHook
activateOnCurrent'