{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Hooks.ManageHelpers
-- Description  : Helper functions to be used in manageHook.
-- Copyright    : (c) Lukas Mai
-- License      : BSD
--
-- Maintainer   : Lukas Mai <l.mai@web.de>
-- Stability    : unstable
-- Portability  : unportable
--
-- This module provides helper functions to be used in @manageHook@. Here's
-- how you might use this:
--
-- > import XMonad.Hooks.ManageHelpers
-- > main =
-- >     xmonad def{
-- >         ...
-- >         manageHook = composeOne [
-- >             isKDETrayWindow -?> doIgnore,
-- >             transience,
-- >             isFullscreen -?> doFullFloat,
-- >             resource =? "stalonetray" -?> doIgnore
-- >         ],
-- >         ...
-- >     }
--
-- Here's how you can define more helpers like the ones from this module:
--
-- > -- some function you want to transform into an infix operator
-- > f :: a -> b -> Bool
-- >
-- > -- a new helper
-- > q ***? x = fmap (\a -> f a x) q   -- or: (\b -> f x b)
-- > -- or
-- > q ***? x = fmap (`f` x) q         -- or: (x `f`)
--
-- Any existing operator can be "lifted" in the same way:
--
-- > q ++? x = fmap (++ x) q

module XMonad.Hooks.ManageHelpers (
    Side(..),
    composeOne,
    (-?>), (/=?), (^?), (~?), ($?), (<==?), (</=?), (-->>), (-?>>),
    currentWs,
    windowTag,
    isInProperty,
    isKDETrayWindow,
    isFullscreen,
    isMinimized,
    isDialog,
    isNotification,
    pid,
    desktop,
    transientTo,
    maybeToDefinite,
    MaybeManageHook,
    transience,
    transience',
    clientLeader,
    sameBy,
    shiftToSame,
    shiftToSame',
    doRectFloat,
    doFullFloat,
    doCenterFloat,
    doSideFloat,
    doFloatAt,
    doFloatDep,
    doHideIgnore,
    doSink,
    doLower,
    doRaise,
    doFocus,
    Match,
) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties (getProp32s)

import System.Posix (ProcessID)

-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northeast
-- etc. @C@ stands for Center.
data Side = SC | NC | CE | CW | SE | SW | NE | NW | C
    deriving (ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS Side
Read, Int -> Side -> ShowS
[Side] -> ShowS
Side -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> WorkspaceId
$cshow :: Side -> WorkspaceId
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> Side -> ShowS
Show, Side -> Side -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: Side -> Side -> Bool
Eq)

-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe
type MaybeManageHook = Query (Maybe (Endo WindowSet))
-- | A grouping type, which can hold the outcome of a predicate Query.
-- This is analogous to group types in regular expressions.
-- TODO: create a better API for aggregating multiple Matches logically
data Match a = Match Bool a

-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
-- a candidate returns a 'Just' value, effectively running only the first match
-- (whereas 'composeAll' continues and executes all matching rules).
composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a
composeOne :: forall a (m :: * -> *). (Monoid a, Monad m) => [m (Maybe a)] -> m a
composeOne = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {m :: * -> *} {b}. Monad m => m (Maybe b) -> m b -> m b
try (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty)
    where
    try :: m (Maybe b) -> m b -> m b
try m (Maybe b)
q m b
z = do
        Maybe b
x <- m (Maybe b)
q
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
z forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
x

infixr 0 -?>, -->>, -?>>

-- | q \/=? x. if the result of q equals x, return False
(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool
m a
q /=? :: forall a (m :: * -> *). (Eq a, Functor m) => m a -> a -> m Bool
/=? a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
/= a
x) m a
q

-- | q ^? x. if the result of @x `isPrefixOf` q@, return True
(^?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool
m [a]
q ^? :: forall a (m :: * -> *). (Eq a, Functor m) => m [a] -> [a] -> m Bool
^? [a]
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
x forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) m [a]
q

-- | q ~? x. if the result of @x `isInfixOf` q@, return True
(~?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool
m [a]
q ~? :: forall a (m :: * -> *). (Eq a, Functor m) => m [a] -> [a] -> m Bool
~? [a]
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
x forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) m [a]
q

-- | q $? x. if the result of @x `isSuffixOf` q@, return True
($?) :: (Eq a, Functor m) => m [a] -> [a] -> m Bool
m [a]
q $? :: forall a (m :: * -> *). (Eq a, Functor m) => m [a] -> [a] -> m Bool
$? [a]
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a]
x forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) m [a]
q

-- | q <==? x. if the result of q equals x, return True grouped with q
(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
m a
q <==? :: forall a (m :: * -> *).
(Eq a, Functor m) =>
m a -> a -> m (Match a)
<==? a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Eq a => a -> a -> Match a
`eq` a
x) m a
q
    where
    eq :: a -> a -> Match a
eq a
q' a
x' = forall a. Bool -> a -> Match a
Match (a
q' forall a. Eq a => a -> a -> Bool
== a
x') a
q'

-- | q <\/=? x. if the result of q notequals x, return True grouped with q
(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
m a
q </=? :: forall a (m :: * -> *).
(Eq a, Functor m) =>
m a -> a -> m (Match a)
</=? a
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Eq a => a -> a -> Match a
`neq` a
x) m a
q
    where
    neq :: a -> a -> Match a
neq a
q' a
x' = forall a. Bool -> a -> Match a
Match (a
q' forall a. Eq a => a -> a -> Bool
/= a
x') a
q'

-- | A helper operator for use in 'composeOne'. It takes a condition and an action;
-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
-- go on and try the next rule.
(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a)
m Bool
p -?> :: forall (m :: * -> *) a.
(Functor m, Monad m) =>
m Bool -> m a -> m (Maybe a)
-?> m a
f = do
    Bool
x <- m Bool
p
    if Bool
x then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just m a
f else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.
(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
m (Match a)
p -->> :: forall b (m :: * -> *) a.
(Monoid b, Monad m) =>
m (Match a) -> (a -> m b) -> m b
-->> a -> m b
f = do
    Match Bool
b a
m <- m (Match a)
p
    if Bool
b then a -> m b
f a
m else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

-- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
m (Match a)
p -?>> :: forall (m :: * -> *) a b.
(Functor m, Monad m) =>
m (Match a) -> (a -> m b) -> m (Maybe b)
-?>> a -> m b
f = do
    Match Bool
b a
m <- m (Match a)
p
    if Bool
b then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap  forall a. a -> Maybe a
Just (a -> m b
f a
m) else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Return the current workspace
currentWs :: Query WorkspaceId
currentWs :: Query WorkspaceId
currentWs = forall a. X a -> Query a
liftX (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 i l a s sd. StackSet i l a s sd -> i
W.currentTag)

-- | Return the workspace tag of a window, if already managed
windowTag :: Query (Maybe WorkspaceId)
windowTag :: Query (Maybe WorkspaceId)
windowTag = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ 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 i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w

-- | A predicate to check whether a window is a KDE system tray icon.
isKDETrayWindow :: Query Bool
isKDETrayWindow :: Query Bool
isKDETrayWindow = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ do
    Maybe [CLong]
r <- WorkspaceId -> Window -> X (Maybe [CLong])
getProp32s WorkspaceId
"_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" Window
w
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [CLong]
r of
        Just [CLong
_] -> Bool
True
        Maybe [CLong]
_ -> Bool
False

-- | Helper to check if a window property contains certain value.
isInProperty :: String -> String -> Query Bool
isInProperty :: WorkspaceId -> WorkspaceId -> Query Bool
isInProperty WorkspaceId
p WorkspaceId
v = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ do
    Window
va <- WorkspaceId -> X Window
getAtom WorkspaceId
v
    Maybe [CLong]
r <- WorkspaceId -> Window -> X (Maybe [CLong])
getProp32s WorkspaceId
p Window
w
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe [CLong]
r of
        Just [CLong]
xs -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Window
va forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CLong]
xs
        Maybe [CLong]
_ -> Bool
False

-- | A predicate to check whether a window wants to fill the whole screen.
-- See also 'doFullFloat'.
isFullscreen :: Query Bool
isFullscreen :: Query Bool
isFullscreen = WorkspaceId -> WorkspaceId -> Query Bool
isInProperty WorkspaceId
"_NET_WM_STATE" WorkspaceId
"_NET_WM_STATE_FULLSCREEN"

-- | A predicate to check whether a window is hidden (minimized).
-- See also "XMonad.Actions.Minimize".
isMinimized :: Query Bool
isMinimized :: Query Bool
isMinimized = WorkspaceId -> WorkspaceId -> Query Bool
isInProperty WorkspaceId
"_NET_WM_STATE" WorkspaceId
"_NET_WM_STATE_HIDDEN"

-- | A predicate to check whether a window is a dialog.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
isDialog :: Query Bool
isDialog :: Query Bool
isDialog = WorkspaceId -> WorkspaceId -> Query Bool
isInProperty WorkspaceId
"_NET_WM_WINDOW_TYPE" WorkspaceId
"_NET_WM_WINDOW_TYPE_DIALOG"

-- | A predicate to check whether a window is a notification.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
isNotification :: Query Bool
isNotification :: Query Bool
isNotification =
  WorkspaceId -> WorkspaceId -> Query Bool
isInProperty WorkspaceId
"_NET_WM_WINDOW_TYPE" WorkspaceId
"_NET_WM_WINDOW_TYPE_NOTIFICATION"

-- | This function returns 'Just' the @_NET_WM_PID@ property for a
-- particular window if set, 'Nothing' otherwise.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm45623487788432>.
pid :: Query (Maybe ProcessID)
pid :: Query (Maybe ProcessID)
pid = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Window -> X (Maybe [CLong])
getProp32s WorkspaceId
"_NET_WM_PID" Window
w forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Just [CLong
x] -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x)
    Maybe [CLong]
_        -> forall a. Maybe a
Nothing

-- | This function returns 'Just' the @_NET_WM_DESKTOP@ property for a
-- particular window if set, 'Nothing' otherwise.
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46181547492704>.
desktop :: Query (Maybe Int)
desktop :: Query (Maybe Int)
desktop = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Window -> X (Maybe [CLong])
getProp32s WorkspaceId
"_NET_WM_DESKTOP" Window
w forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Just [CLong
x] -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x)
    Maybe [CLong]
_        -> forall a. Maybe a
Nothing

-- | A predicate to check whether a window is Transient.
-- It holds the result which might be the window it is transient to
-- or it might be 'Nothing'.
transientTo :: Query (Maybe Window)
transientTo :: Query (Maybe Window)
transientTo = do
    Window
w <- forall r (m :: * -> *). MonadReader r m => m r
ask
    Display
d <- (forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks) XConf -> Display
display
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO (Maybe Window)
getTransientForHint Display
d Window
w

-- | A convenience 'MaybeManageHook' that will check to see if a window
-- is transient, and then move it to its parent.
transience :: MaybeManageHook
transience :: MaybeManageHook
transience = Query (Maybe Window)
transientTo forall a (m :: * -> *).
(Eq a, Functor m) =>
m a -> a -> m (Match a)
</=? forall a. Maybe a
Nothing forall (m :: * -> *) a b.
(Functor m, Monad m) =>
m (Match a) -> (a -> m b) -> m (Maybe b)
-?>> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
idHook Window -> Query (Endo WindowSet)
doShiftTo

-- | 'transience' set to a 'ManageHook'
transience' :: ManageHook
transience' :: Query (Endo WindowSet)
transience' = forall a (m :: * -> *). (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite MaybeManageHook
transience

-- | This function returns 'Just' the @WM_CLIENT_LEADER@ property for a
-- particular window if set, 'Nothing' otherwise. Note that, generally,
-- the window ID returned from this property (by firefox, for example)
-- corresponds to an unmapped or unmanaged dummy window. For this to be
-- useful in most cases, it should be used together with 'sameBy'.
--
-- See <https://tronche.com/gui/x/icccm/sec-5.html>.
clientLeader :: Query (Maybe Window)
clientLeader :: Query (Maybe Window)
clientLeader = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Window -> X (Maybe [CLong])
getProp32s WorkspaceId
"WM_CLIENT_LEADER" Window
w forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Just [CLong
x] -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
x)
    Maybe [CLong]
_        -> forall a. Maybe a
Nothing

-- | For a given window, 'sameBy' returns all windows that have a matching
-- property (e.g. those obtained from Queries of 'clientLeader' and 'pid').
sameBy :: Eq prop => Query (Maybe prop) -> Query [Window]
sameBy :: forall prop. Eq prop => Query (Maybe prop) -> Query [Window]
sameBy Query (Maybe prop)
prop = Query (Maybe prop)
prop forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe prop
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Maybe prop
propVal -> 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 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
$ \WindowSet
s ->
        forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe prop
propVal forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Query a -> Window -> X a
runQuery Query (Maybe prop)
prop) (forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
W.allWindows WindowSet
s forall a. Eq a => [a] -> [a] -> [a]
\\ [Window
w])

-- | 'MaybeManageHook' that moves the window to the same workspace as the
-- first other window that has the same value of a given 'Query'. Useful
-- Queries for this include 'clientLeader' and 'pid'.
shiftToSame :: Eq prop => Query (Maybe prop) -> MaybeManageHook
shiftToSame :: forall prop. Eq prop => Query (Maybe prop) -> MaybeManageHook
shiftToSame Query (Maybe prop)
prop = forall prop. Eq prop => Query (Maybe prop) -> Query [Window]
sameBy Query (Maybe prop)
prop forall a (m :: * -> *).
(Eq a, Functor m) =>
m a -> a -> m (Match a)
</=? [] forall (m :: * -> *) a b.
(Functor m, Monad m) =>
m (Match a) -> (a -> m b) -> m (Maybe b)
-?>> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
idHook Window -> Query (Endo WindowSet)
doShiftTo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe

-- | 'shiftToSame' set to a 'ManageHook'
shiftToSame' :: Eq prop => Query (Maybe prop) -> ManageHook
shiftToSame' :: forall prop.
Eq prop =>
Query (Maybe prop) -> Query (Endo WindowSet)
shiftToSame' = forall a (m :: * -> *). (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Eq prop => Query (Maybe prop) -> MaybeManageHook
shiftToSame

-- | converts 'MaybeManageHook's to 'ManageHook's
maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite :: forall a (m :: * -> *). (Monoid a, Functor m) => m (Maybe a) -> m a
maybeToDefinite = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty)

-- | Move the window to the same workspace as another window.
doShiftTo :: Window -> ManageHook
doShiftTo :: Window -> Query (Endo WindowSet)
doShiftTo Window
target = forall s. (s -> s) -> Query (Endo s)
doF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {s} {i} {l} {sd}.
(Eq s, Eq i) =>
Window -> StackSet i l Window s sd -> StackSet i l Window s sd
shiftTo forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *). MonadReader r m => m r
ask
  where shiftTo :: Window -> StackSet i l Window s sd -> StackSet i l Window s sd
shiftTo Window
w StackSet i l Window s sd
s = forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet i l Window s sd
s (\i
t -> forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin i
t Window
w StackSet i l Window s sd
s) (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
target StackSet i l Window s sd
s)

-- | Floats the new window in the given rectangle.
doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.
            -> ManageHook
doRectFloat :: RationalRect -> Query (Endo WindowSet)
doRectFloat RationalRect
r = 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 i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w RationalRect
r)

-- | Floats the window and makes it use the whole screen. Equivalent to
-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.
doFullFloat :: ManageHook
doFullFloat :: Query (Endo WindowSet)
doFullFloat = RationalRect -> Query (Endo WindowSet)
doRectFloat forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
0 Rational
0 Rational
1 Rational
1

-- | Floats a new window using a rectangle computed as a function of
--   the rectangle that it would have used by default.
doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook
doFloatDep :: (RationalRect -> RationalRect) -> Query (Endo WindowSet)
doFloatDep RationalRect -> RationalRect
move = 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Ord a =>
a -> RationalRect -> StackSet i l a s sd -> StackSet i l a s sd
W.float Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. RationalRect -> RationalRect
move forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. X a -> Query a
liftX (Window -> X (ScreenId, RationalRect)
floatLocation Window
w)

-- | Floats a new window with its original size, and its top left
--   corner at a specific point on the screen (both coordinates should
--   be in the range 0 to 1).
doFloatAt :: Rational -> Rational -> ManageHook
doFloatAt :: Rational -> Rational -> Query (Endo WindowSet)
doFloatAt Rational
x Rational
y = (RationalRect -> RationalRect) -> Query (Endo WindowSet)
doFloatDep RationalRect -> RationalRect
move
  where
    move :: RationalRect -> RationalRect
move (W.RationalRect Rational
_ Rational
_ Rational
w Rational
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
x Rational
y Rational
w Rational
h

-- | Floats a new window with its original size on the specified side of a
-- screen
doSideFloat :: Side -> ManageHook
doSideFloat :: Side -> Query (Endo WindowSet)
doSideFloat Side
side = (RationalRect -> RationalRect) -> Query (Endo WindowSet)
doFloatDep RationalRect -> RationalRect
move
  where
    move :: RationalRect -> RationalRect
move (W.RationalRect Rational
_ Rational
_ Rational
w Rational
h) = Rational -> Rational -> Rational -> Rational -> RationalRect
W.RationalRect Rational
cx Rational
cy Rational
w Rational
h
      where cx :: Rational
cx
              | Side
side forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
SC,Side
C ,Side
NC] = (Rational
1forall a. Num a => a -> a -> a
-Rational
w)forall a. Fractional a => a -> a -> a
/Rational
2
              | Side
side forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
SW,Side
CW,Side
NW] = Rational
0
              | Bool
otherwise = {- side `elem` [SE,CE,NE] -} Rational
1forall a. Num a => a -> a -> a
-Rational
w
            cy :: Rational
cy
              | Side
side forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
CE,Side
C ,Side
CW] = (Rational
1forall a. Num a => a -> a -> a
-Rational
h)forall a. Fractional a => a -> a -> a
/Rational
2
              | Side
side forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Side
NE,Side
NC,Side
NW] = Rational
0
              | Bool
otherwise = {- side `elem` [SE,SC,SW] -} Rational
1forall a. Num a => a -> a -> a
-Rational
h

-- | Floats a new window with its original size, but centered.
doCenterFloat :: ManageHook
doCenterFloat :: Query (Endo WindowSet)
doCenterFloat = Side -> Query (Endo WindowSet)
doSideFloat Side
C

-- | Hides window and ignores it.
doHideIgnore :: ManageHook
doHideIgnore :: Query (Endo WindowSet)
doHideIgnore = 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 a. X a -> Query a
liftX (Window -> X ()
hide Window
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. (s -> s) -> Query (Endo s)
doF (forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete Window
w)

-- | Sinks a window
doSink :: ManageHook
doSink :: Query (Endo WindowSet)
doSink = forall s. (s -> s) -> Query (Endo s)
doF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Lower an unmanaged window. Useful together with 'doIgnore' to lower
-- special windows that for some reason don't do it themselves.
doLower :: ManageHook
doLower :: Query (Endo WindowSet)
doLower = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Window -> IO ()
lowerWindow Display
dpy Window
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Monoid a => a
mempty

-- | Raise an unmanaged window. Useful together with 'doIgnore' to raise
-- special windows that for some reason don't do it themselves.
doRaise :: ManageHook
doRaise :: Query (Endo WindowSet)
doRaise = 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 a. X a -> Query a
liftX forall a b. (a -> b) -> a -> b
$ forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Display -> Window -> IO ()
raiseWindow Display
dpy Window
w) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Monoid a => a
mempty

-- | Focus a window (useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook').
doFocus :: ManageHook
doFocus :: Query (Endo WindowSet)
doFocus = forall s. (s -> s) -> Query (Endo s)
doF 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *). MonadReader r m => m r
ask