{-# LANGUAGE MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Navigation2D
-- Description :  Directional navigation of windows and screens.
-- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Norbert Zeh <nzeh@cs.dal.ca>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Navigation2D is an xmonad extension that allows easy directional
-- navigation of windows and screens (in a multi-monitor setup).
-----------------------------------------------------------------------------

module XMonad.Actions.Navigation2D ( -- * Usage
                                     -- $usage

                                     -- * Finer points
                                     -- $finer_points

                                     -- * Alternative directional navigation modules
                                     -- $alternatives

                                     -- * Incompatibilities
                                     -- $incompatibilities

                                     -- * Detailed technical discussion
                                     -- $technical

                                     -- * Exported functions and types
                                     -- #Exports#

                                     navigation2D
                                   , navigation2DP
                                   , additionalNav2DKeys
                                   , additionalNav2DKeysP
                                   , withNavigation2DConfig
                                   , Navigation2DConfig(..)
                                   , def
                                   , Navigation2D
                                   , lineNavigation
                                   , centerNavigation
                                   , sideNavigation
                                   , sideNavigationWithBias
                                   , hybridOf
                                   , fullScreenRect
                                   , singleWindowRect
                                   , switchLayer
                                   , windowGo
                                   , windowSwap
                                   , windowToScreen
                                   , screenGo
                                   , screenSwap
                                   , Direction2D(..)
                                   ) where

import qualified Data.List as L
import qualified Data.Map as M
import Control.Arrow (second)
import XMonad.Prelude
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
import XMonad.Util.Types
import qualified Data.List.NonEmpty as NE

-- $usage
-- #Usage#
-- Navigation2D provides directional navigation (go left, right, up, down) for
-- windows and screens.  It treats floating and tiled windows as two separate
-- layers and provides mechanisms to navigate within each layer and to switch
-- between layers.  Navigation2D provides three different navigation strategies
-- (see <#Technical_Discussion> for details): /Line navigation/ and
-- /Side navigation/ feel rather natural but may make it impossible to navigate
-- to a given window from the current window, particularly in the floating
-- layer. /Center navigation/ feels less natural in certain situations but
-- ensures that all windows can be reached without the need to involve the
-- mouse. Another option is to use a /Hybrid/ of the three strategies,
-- automatically choosing whichever first provides a suitable target window.
-- Navigation2D allows different navigation strategies to be used in the two
-- layers and allows customization of the navigation strategy for the tiled
-- layer based on the layout currently in effect.
--
-- You can use this module with (a subset of) the following in your @xmonad.hs@:
--
-- > import XMonad.Actions.Navigation2D
--
-- Then add the configuration of the module to your main function:
--
-- > main = xmonad $ navigation2D def
-- >                              (xK_Up, xK_Left, xK_Down, xK_Right)
-- >                              [(mod4Mask,               windowGo  ),
-- >                               (mod4Mask .|. shiftMask, windowSwap)]
-- >                              False
-- >               $ def
--
-- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy
-- that decides which windows actually get selected.  While the default
-- behaviour tries to keep them into account, if you use modules that
-- influence tiling in some way, like "XMonad.Layout.Spacing" or
-- "XMonad.Layout.Gaps", you should think about using a different
-- strategy, if you find the default behaviour to be unnatural.  Check
-- out the [finer points](#g:Finer_Points) below for more information.
--
-- Alternatively to 'navigation2D', you can use 'navigation2DP':
--
-- > main = xmonad $ navigation2DP def
-- >                               ("<Up>", "<Left>", "<Down>", "<Right>")
-- >                               [("M-",   windowGo  ),
-- >                                ("M-S-", windowSwap)]
-- >                               False
-- >               $ def
--
-- That's it. If instead you'd like more control, you can combine
-- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP':
--
-- > main = xmonad $ withNavigation2DConfig def
-- >               $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
-- >                                     [(mod4Mask,               windowGo  ),
-- >                                      (mod4Mask .|. shiftMask, windowSwap)]
-- >                                     False
-- >               $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r)
-- >                                     [(mod4Mask,               screenGo  ),
-- >                                      (mod4Mask .|. shiftMask, screenSwap)]
-- >                                     False
-- >               $ def
--
-- Or you can add the configuration of the module to your main function:
--
-- > main = xmonad $ withNavigation2DConfig def $ def
--
-- And specify your keybindings normally:
--
-- >    -- Switch between layers
-- >    , ((modm,                 xK_space), switchLayer)
-- >
-- >    -- Directional navigation of windows
-- >    , ((modm,                 xK_Right), windowGo R False)
-- >    , ((modm,                 xK_Left ), windowGo L False)
-- >    , ((modm,                 xK_Up   ), windowGo U False)
-- >    , ((modm,                 xK_Down ), windowGo D False)
-- >
-- >    -- Swap adjacent windows
-- >    , ((modm .|. controlMask, xK_Right), windowSwap R False)
-- >    , ((modm .|. controlMask, xK_Left ), windowSwap L False)
-- >    , ((modm .|. controlMask, xK_Up   ), windowSwap U False)
-- >    , ((modm .|. controlMask, xK_Down ), windowSwap D False)
-- >
-- >    -- Directional navigation of screens
-- >    , ((modm,                 xK_r    ), screenGo R False)
-- >    , ((modm,                 xK_l    ), screenGo L False)
-- >    , ((modm,                 xK_u    ), screenGo U False)
-- >    , ((modm,                 xK_d    ), screenGo D False)
-- >
-- >    -- Swap workspaces on adjacent screens
-- >    , ((modm .|. controlMask, xK_r    ), screenSwap R False)
-- >    , ((modm .|. controlMask, xK_l    ), screenSwap L False)
-- >    , ((modm .|. controlMask, xK_u    ), screenSwap U False)
-- >    , ((modm .|. controlMask, xK_d    ), screenSwap D False)
-- >
-- >    -- Send window to adjacent screen
-- >    , ((modm .|. mod1Mask,    xK_r    ), windowToScreen R False)
-- >    , ((modm .|. mod1Mask,    xK_l    ), windowToScreen L False)
-- >    , ((modm .|. mod1Mask,    xK_u    ), windowToScreen U False)
-- >    , ((modm .|. mod1Mask,    xK_d    ), windowToScreen D False)
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.

-- $finer_points
-- #Finer_Points#
-- The above should get you started.  Here are some finer points:
--
-- Navigation2D has the ability to wrap around at screen edges.  For example, if
-- you navigated to the rightmost window on the rightmost screen and you
-- continued to go right, this would get you to the leftmost window on the
-- leftmost screen.  This feature may be useful for switching between screens
-- that are far apart but may be confusing at least to novice users.  Therefore,
-- it is disabled in the above example (e.g., navigation beyond the rightmost
-- window on the rightmost screen is not possible and trying to do so will
-- simply not do anything.)  If you want this feature, change all the 'False'
-- values in the above example to 'True'.  You could also decide you want
-- wrapping only for a subset of the operations and no wrapping for others.
--
-- By default, all layouts use the 'defaultTiledNavigation' strategy
-- specified in the 'Navigation2DConfig' (by default, line navigation is
-- used).  Many more navigation strategies are available; some may feel
-- more natural, depending on the layout and user:
--
--   * 'lineNavigation'
--   * 'centerNavigation'
--   * 'sideNavigation'
--   * 'sideNavigationWithBias'
--
-- There is also the ability to combine two strategies with 'hybridOf'.
--
-- To override the default behaviour for some layouts, add a pair (\"layout name\",
-- navigation strategy) to the 'layoutNavigation' list in the
-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
-- layout's description method (normally what is shown as the layout name in
-- your status bar).  For example, all navigation strategies normally allow only
-- navigation between mapped windows.  The first step to overcome this, for
-- example, for the Full layout, is to switch to center navigation for the Full
-- layout:
--
-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- >               $ def
--
-- The navigation between windows is based on their screen rectangles, which are
-- available /and meaningful/ only for mapped windows.  Thus, as already said,
-- the default is to allow navigation only between mapped windows.  However,
-- there are layouts that do not keep all windows mapped.  One example is the
-- Full layout, which unmaps all windows except the one that has the focus,
-- thereby preventing navigation to any other window in the layout.  To make
-- navigation to unmapped windows possible, unmapped windows need to be assigned
-- rectangles to pretend they are mapped, and a natural way to do this for the
-- Full layout is to pretend all windows occupy the full screen and are stacked
-- on top of each other so that only the frontmost one is visible.  This can be
-- done as follows:
--
-- > myNavigation2DConfig = def { layoutNavigation   = [("Full", centerNavigation)]
-- >                            , unmappedWindowRect = [("Full", singleWindowRect)]
-- >                            }
-- >
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
-- >               $ def
--
-- With this setup, Left/Up navigation behaves like standard
-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
-- layout.
--
-- In general, each entry in the 'unmappedWindowRect' association list is a pair
-- (\"layout description\", function), where the function computes a rectangle
-- for each unmapped window from the screen it is on and the window ID.
-- Currently, Navigation2D provides only two functions of this type:
-- 'singleWindowRect' and 'fullScreenRect'.
--
-- With per-layout navigation strategies, if different layouts are in effect on
-- different screens in a multi-monitor setup, and different navigation
-- strategies are defined for these active layouts, the most general of these
-- navigation strategies is used across all screens (because Navigation2D does
-- not distinguish between windows on different workspaces), where center
-- navigation is more general than line navigation, as discussed formally under
-- <#Technical_Discussion>.

-- $alternatives
-- #Alternatives#
--
-- There exist two alternatives to Navigation2D:
-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
-- window that would receive the focus in each navigation direction, but it does
-- not support navigation across multiple monitors, does not support directional
-- navigation of floating windows, and has a very unintuitive definition of
-- which window receives the focus next in each direction.  X.A.WindowNavigation
-- does support navigation across multiple monitors but does not provide window
-- colouring while retaining the unintuitive navigational semantics of
-- X.L.WindowNavigation.  This makes it very difficult to predict which window
-- receives the focus next.  Neither X.A.WindowNavigation nor
-- X.L.WindowNavigation supports directional navigation of screens.

-- $technical
-- #Technical_Discussion#
-- An in-depth discussion of the navigational strategies implemented in
-- Navigation2D, including formal proofs of their properties, can be found
-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.

-- $incompatibilities
-- #Incompatibilities#
-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
-- it should work well with any other tiled layout.  My hope is to address the
-- incompatibility with tabbed layouts in a future version.  The navigation to
-- unmapped windows, for example in a Full layout, by assigning rectangles to
-- unmapped windows is more a workaround than a clean solution.  Figuring out
-- how to deal with tabbed layouts may also lead to a more general and cleaner
-- solution to query the layout for a window's rectangle that may make this
-- workaround unnecessary.  At that point, the 'unmappedWindowRect' field of the
-- 'Navigation2DConfig' will disappear.

-- | A rectangle paired with an object
type Rect a = (a, Rectangle)

-- | A shorthand for window-rectangle pairs.  Reduces typing.
type WinRect = Rect Window

-- | A shorthand for workspace-rectangle pairs.  Reduces typing.
type WSRect = Rect WorkspaceId

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                        PUBLIC INTERFACE                                        --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Encapsulates the navigation strategy
data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)

runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
runNav :: forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav (N Int
_ forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
nav) = forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
nav

-- | Score that indicates how general a navigation strategy is
type Generality = Int

instance Eq Navigation2D where
  (N Int
x forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) == :: Navigation2D -> Navigation2D -> Bool
== (N Int
y forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) = Int
x forall a. Eq a => a -> a -> Bool
== Int
y

instance Ord Navigation2D where
  (N Int
x forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) <= :: Navigation2D -> Navigation2D -> Bool
<= (N Int
y forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
_) = Int
x forall a. Ord a => a -> a -> Bool
<= Int
y

-- | Line navigation.  To illustrate this navigation strategy, consider
-- navigating to the left from the current window.  In this case, we draw a
-- horizontal line through the center of the current window and consider all
-- windows that intersect this horizontal line and whose right boundaries are to
-- the left of the left boundary of the current window.  From among these
-- windows, we choose the one with the rightmost right boundary.
lineNavigation :: Navigation2D
lineNavigation :: Navigation2D
lineNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation

-- | Center navigation.  Again, consider navigating to the left.  Then we
-- consider the cone bounded by the two rays shot at 45-degree angles in
-- north-west and south-west direction from the center of the current window.  A
-- window is a candidate to receive the focus if its center lies in this cone.
-- We choose the window whose center has minimum L1-distance from the current
-- window center.  The tie breaking strategy for windows with the same distance
-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
-- windows can be reached and that windows with the same center are traversed in
-- their order in the window stack, that is, in the order
-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
-- them.
centerNavigation :: Navigation2D
centerNavigation :: Navigation2D
centerNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
2 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation

-- | Side navigation. Consider navigating to the right this time. The strategy
-- is to take the line segment forming the right boundary of the current window,
-- and push it to the right until it intersects with at least one other window.
-- Of those windows, one with a point that is the closest to the centre of the
-- line (+1) is selected. This is probably the most intuitive strategy for the
-- tiled layer when using "XMonad.Layout.Spacing".
sideNavigation :: Navigation2D
sideNavigation :: Navigation2D
sideNavigation = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 (forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
1)

-- | Side navigation with bias. Consider a case where the screen is divided
-- up into three vertical panes; the side panes occupied by one window each and
-- the central pane split across the middle by two windows. By the criteria
-- of side navigation, the two central windows are equally good choices when
-- navigating inwards from one of the side panes. Hence in order to be
-- equitable, symmetric and pleasant to use, different windows are chosen when
-- navigating from different sides. In particular, the lower is chosen when
-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
-- cycle through the four windows clockwise. This is implemented by using a bias
-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
-- this behaviour is lost and the same window chosen every time. A negative bias
-- swaps the preferred window for each direction. A bias of zero disables the
-- behaviour.
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias :: Int -> Navigation2D
sideNavigationWithBias Int
b = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N Int
1 (forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
b)

-- | Hybrid of two modes of navigation, preferring the motions of the first.
-- Use this if you want to fall back on a second strategy whenever the first
-- does not find a candidate window. E.g.
-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
-- you to take advantage of some of the latter strategy's more interesting
-- motions in the tiled layer.
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
hybridOf (N Int
g1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s1) (N Int
g2 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s2) = Int
-> (forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
-> Navigation2D
N (forall a. Ord a => a -> a -> a
max Int
g1 Int
g2) forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {t} {t} {t} {a}.
Alternative f =>
(t -> t -> t -> f a) -> (t -> t -> t -> f a) -> t -> t -> t -> f a
applyToBoth forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s1 forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
s2
  where
    applyToBoth :: (t -> t -> t -> f a) -> (t -> t -> t -> f a) -> t -> t -> t -> f a
applyToBoth t -> t -> t -> f a
f t -> t -> t -> f a
g t
a t
b t
c = t -> t -> t -> f a
f t
a t
b t
c forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> t -> t -> t -> f a
g t
a t
b t
c

-- | Stores the configuration of directional navigation. The 'Default' instance
-- uses line navigation for the tiled layer and for navigation between screens,
-- and center navigation for the float layer.  No custom navigation strategies
-- or rectangles for unmapped windows are defined for individual layouts.
data Navigation2DConfig = Navigation2DConfig
  { Navigation2DConfig -> Navigation2D
defaultTiledNavigation :: Navigation2D             -- ^ default navigation strategy for the tiled layer
  , Navigation2DConfig -> Navigation2D
floatNavigation        :: Navigation2D             -- ^ navigation strategy for the float layer
  , Navigation2DConfig -> Navigation2D
screenNavigation       :: Navigation2D             -- ^ strategy for navigation between screens
  , Navigation2DConfig -> [(WorkspaceId, Navigation2D)]
layoutNavigation       :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
                                                       -- for different layouts in the tiled layer.  Each pair
                                                       -- is of the form (\"layout description\", navigation
                                                       -- strategy).  If there is no pair in this list whose first
                                                       -- component is the name of the current layout, the
                                                       -- 'defaultTiledNavigation' strategy is used.
  , Navigation2DConfig
-> [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect     :: [(String, Screen -> Window -> X (Maybe Rectangle))]
                                                       -- ^ list associating functions to calculate rectangles
                                                       -- for unmapped windows with layouts to which they are
                                                       -- to be applied.  Each pair in this list is of
                                                       -- the form (\"layout description\", function), where the
                                                       -- function calculates a rectangle for a given unmapped
                                                       -- window from the screen it is on and its window ID.
                                                       -- See <#Finer_Points> for how to use this.
  }

-- | Shorthand for the tedious screen type
type Screen = WindowScreen

-- | Convenience function for enabling Navigation2D with typical keybindings.
-- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from
-- modifier key to action, and a bool to indicate if wrapping should occur, and
-- returns a function from XConfig to XConfig.
-- Example:
--
-- >  navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
                Bool -> XConfig l -> XConfig l
navigation2D :: forall (l :: * -> *).
Navigation2DConfig
-> (Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
navigation2D Navigation2DConfig
navConfig (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap XConfig l
xconfig =
  forall (l :: * -> *).
(Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeys (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap forall a b. (a -> b) -> a -> b
$
  forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
navConfig XConfig l
xconfig

-- | Convenience function for enabling Navigation2D with typical keybindings,
-- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a
-- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key
-- prefix to action, and a bool to indicate if wrapping should occur, and
-- returns a function from XConfig to XConfig. Example:
--
-- >  navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
                 Bool -> XConfig l -> XConfig l
navigation2DP :: forall (l :: * -> *).
Navigation2DConfig
-> (WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
navigation2DP Navigation2DConfig
navConfig (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap XConfig l
xconfig =
  forall (l :: * -> *).
(WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeysP (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap forall a b. (a -> b) -> a -> b
$
  forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
navConfig XConfig l
xconfig

-- | Convenience function for adding keybindings. Takes an (up, left, down,
-- right) tuple, a mapping from key prefix to action, and a bool to indicate if
-- wrapping should occur, and returns a function from XConfig to XConfig.
-- Example:
--
-- >  additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
                       Bool -> XConfig l -> XConfig l
additionalNav2DKeys :: forall (l :: * -> *).
(Window, Window, Window, Window)
-> [(ButtonMask, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeys (Window
u, Window
l, Window
d, Window
r) [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers Bool
wrap =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (a :: * -> *).
XConfig a -> [((ButtonMask, Window), X ())] -> XConfig a
additionalKeys [((ButtonMask
modif, Window
k), Direction2D -> Bool -> X ()
func Direction2D
dir Bool
wrap) | (ButtonMask
modif, Direction2D -> Bool -> X ()
func) <- [(ButtonMask, Direction2D -> Bool -> X ())]
modifiers, (Window
k, Direction2D
dir) <- [(Window, Direction2D)]
dirKeys]
  where dirKeys :: [(Window, Direction2D)]
dirKeys = [(Window
u, Direction2D
U), (Window
l, Direction2D
L), (Window
d, Direction2D
D), (Window
r, Direction2D
R)]

-- | Convenience function for adding keybindings, using the syntax defined in
-- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a
-- mapping from key prefix to action, and a bool to indicate if wrapping should
-- occur, and returns a function from XConfig to XConfig. Example:
--
-- >  additionalNav2DKeysP ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
                        Bool -> XConfig l -> XConfig l
additionalNav2DKeysP :: forall (l :: * -> *).
(WorkspaceId, WorkspaceId, WorkspaceId, WorkspaceId)
-> [(WorkspaceId, Direction2D -> Bool -> X ())]
-> Bool
-> XConfig l
-> XConfig l
additionalNav2DKeysP (WorkspaceId
u, WorkspaceId
l, WorkspaceId
d, WorkspaceId
r) [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers Bool
wrap =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (l :: * -> *).
XConfig l -> [(WorkspaceId, X ())] -> XConfig l
additionalKeysP [(WorkspaceId
modif forall a. [a] -> [a] -> [a]
++ WorkspaceId
k, Direction2D -> Bool -> X ()
func Direction2D
dir Bool
wrap) | (WorkspaceId
modif, Direction2D -> Bool -> X ()
func) <- [(WorkspaceId, Direction2D -> Bool -> X ())]
modifiers, (WorkspaceId
k, Direction2D
dir) <- [(WorkspaceId, Direction2D)]
dirKeys]
  where dirKeys :: [(WorkspaceId, Direction2D)]
dirKeys = [(WorkspaceId
u, Direction2D
U), (WorkspaceId
l, Direction2D
L), (WorkspaceId
d, Direction2D
D), (WorkspaceId
r, Direction2D
R)]

-- So we can store the configuration in extensible state
instance ExtensionClass Navigation2DConfig where
  initialValue :: Navigation2DConfig
initialValue = forall a. Default a => a
def

-- | Modifies the xmonad configuration to store the Navigation2D configuration
withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig :: forall (a :: * -> *). Navigation2DConfig -> XConfig a -> XConfig a
withNavigation2DConfig Navigation2DConfig
conf2d XConfig a
xconf = XConfig a
xconf { startupHook :: X ()
startupHook  = forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
xconf
                                                          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put Navigation2DConfig
conf2d
                                            }

instance Default Navigation2DConfig where
    def :: Navigation2DConfig
def                   = Navigation2DConfig { defaultTiledNavigation :: Navigation2D
defaultTiledNavigation = Navigation2D -> Navigation2D -> Navigation2D
hybridOf Navigation2D
lineNavigation Navigation2D
sideNavigation
                                               , floatNavigation :: Navigation2D
floatNavigation        = Navigation2D
centerNavigation
                                               , screenNavigation :: Navigation2D
screenNavigation       = Navigation2D
lineNavigation
                                               , layoutNavigation :: [(WorkspaceId, Navigation2D)]
layoutNavigation       = []
                                               , unmappedWindowRect :: [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect     = []
                                               }

-- | Switches focus to the closest window in the other layer (floating if the
-- current window is tiled, tiled if the current window is floating).  Closest
-- means that the L1-distance between the centers of the windows is minimized.
switchLayer :: X ()
switchLayer :: X ()
switchLayer = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
otherLayer
                         ( \ Navigation2DConfig
_ WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                           forall a b. (a -> b) -> a -> b
$ WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow WinRect
cur [WinRect]
wins
                         )
                         ( \ Navigation2DConfig
_ WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                           forall a b. (a -> b) -> a -> b
$ WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow WinRect
cur [WinRect]
wins
                         )
                         ( \ Navigation2DConfig
_ WSRect
_ [WSRect]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () )
                         Bool
False

-- | Moves the focus to the next window in the given direction and in the same
-- layer as the current window.  The second argument indicates whether
-- navigation should wrap around (e.g., from the left edge of the leftmost
-- screen to the right edge of the rightmost screen).
windowGo :: Direction2D -> Bool -> X ()
windowGo :: Direction2D -> Bool -> X ()
windowGo Direction2D
dir = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
thisLayer
                               ( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                                 forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir 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 WinRect
cur [WinRect]
wins
                               )
                               ( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                                 forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir 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 WinRect
cur [WinRect]
wins
                               )
                               ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
                                 forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir 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 WSRect
cur [WSRect]
wspcs
                               )

-- | Swaps the current window with the next window in the given direction and in
-- the same layer as the current window.  (In the floating layer, all that
-- changes for the two windows is their stacking order if they're on the same
-- screen.  If they're on different screens, each window is moved to the other
-- window's screen but retains its position and size relative to the screen.)
-- The second argument indicates wrapping (see 'windowGo').
windowSwap :: Direction2D -> Bool -> X ()
windowSwap :: Direction2D -> Bool -> X ()
windowSwap Direction2D
dir = ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer forall a. a -> a -> a
thisLayer
                                 ( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                                   forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
swap WinRect
cur [WinRect]
wins
                                 )
                                 ( \ Navigation2DConfig
conf WinRect
cur [WinRect]
wins -> (WindowSet -> WindowSet) -> X ()
windows
                                   forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
swap WinRect
cur [WinRect]
wins
                                 )
                                 ( \ Navigation2DConfig
_ WSRect
_ [WSRect]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return () )

-- | Moves the current window to the next screen in the given direction.  The
-- second argument indicates wrapping (see 'windowGo').
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen :: Direction2D -> Bool -> X ()
windowToScreen Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
                                         forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift WSRect
cur [WSRect]
wspcs
                                       )

-- | Moves the focus to the next screen in the given direction.  The second
-- argument indicates wrapping (see 'windowGo').
screenGo :: Direction2D -> Bool -> X ()
screenGo :: Direction2D -> Bool -> X ()
screenGo Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
                                   forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir 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 WSRect
cur [WSRect]
wspcs
                                 )

-- | Swaps the workspace on the current screen with the workspace on the screen
-- in the given direction.  The second argument indicates wrapping (see
-- 'windowGo').
screenSwap :: Direction2D -> Bool -> X ()
screenSwap :: Direction2D -> Bool -> X ()
screenSwap Direction2D
dir = (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens ( \ Navigation2DConfig
conf WSRect
cur [WSRect]
wspcs -> (WindowSet -> WindowSet) -> X ()
windows
                                     forall a b. (a -> b) -> a -> b
$ Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView WSRect
cur [WSRect]
wspcs
                                   )

-- | Maps each window to a fullscreen rect.  This may not be the same rectangle the
-- window maps to under the Full layout or a similar layout if the layout
-- respects statusbar struts.  In such cases, it may be better to use
-- 'singleWindowRect'.
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
fullScreenRect Screen
scr Window
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr)

-- | Maps each window to the rectangle it would receive if it was the only
-- window in the layout.  Useful, for example, for determining the default
-- rectangle for unmapped windows in a Full layout that respects statusbar
-- struts.
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
singleWindowRect Screen
scr Window
win  =  forall a. [a] -> Maybe a
listToMaybe
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a, b) -> a
fst
                         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout ((forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen
scr) { stack :: Maybe (Stack Window)
W.stack = forall a. [a] -> Maybe (Stack a)
W.differentiate [Window
win] })
                                       (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr)

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                       PRIVATE X ACTIONS                                        --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Acts on the appropriate layer using the given action functions
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])                -- ^ Chooses which layer to operate on, relative
                                                                   -- to the current window (same or other layer)
           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
           -> (Navigation2DConfig -> WSRect  -> [WSRect]  -> X ()) -- ^ The action if the current workspace is empty
           -> Bool                                                 -- ^ Should navigation wrap around screen edges?
           -> X ()
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ())
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
-> Bool
-> X ()
actOnLayer [WinRect] -> [WinRect] -> [WinRect]
choice Navigation2DConfig -> WinRect -> [WinRect] -> X ()
tiledact Navigation2DConfig -> WinRect -> [WinRect] -> X ()
floatact Navigation2DConfig -> WSRect -> [WSRect] -> X ()
wsact Bool
wrap = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winset -> do
  Navigation2DConfig
conf <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  ([WinRect]
floating, [WinRect]
tiled) <- Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows Navigation2DConfig
conf Bool
wrap WindowSet
winset
  let cur :: Maybe Window
cur = forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
winset
  case Maybe Window
cur of
    Maybe Window
Nothing                                   -> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens Navigation2DConfig -> WSRect -> [WSRect] -> X ()
wsact Bool
wrap
    Just Window
w | Just Rectangle
rect <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Window
w [WinRect]
tiled    -> Navigation2DConfig -> WinRect -> [WinRect] -> X ()
tiledact Navigation2DConfig
conf (Window
w, Rectangle
rect) ([WinRect] -> [WinRect] -> [WinRect]
choice [WinRect]
tiled [WinRect]
floating)
           | Just Rectangle
rect <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup Window
w [WinRect]
floating -> Navigation2DConfig -> WinRect -> [WinRect] -> X ()
floatact Navigation2DConfig
conf (Window
w, Rectangle
rect) ([WinRect] -> [WinRect] -> [WinRect]
choice [WinRect]
floating [WinRect]
tiled)
           | Bool
otherwise                        -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Returns the list of windows on the currently visible workspaces
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
navigableWindows Navigation2DConfig
conf Bool
wrap WindowSet
winset  =  forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\(Window
win, Rectangle
_) -> forall k a. Ord k => k -> Map k a -> Bool
M.member Window
win (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
winset))
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
winset Bool
wrap
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. [Maybe a] -> [a]
catMaybes
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                                  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                   (  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ( \Screen
scr -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Screen -> Window -> X (Maybe WinRect)
maybeWinRect Screen
scr)
                                                   forall a b. (a -> b) -> a -> b
$ forall a. Maybe (Stack a) -> [a]
W.integrate'
                                                   forall a b. (a -> b) -> a -> b
$ forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack
                                                   forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen
scr
                                           )
                                   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  WindowSet -> [Screen]
sortedScreens
                                   )  WindowSet
winset
  where
    maybeWinRect :: Screen -> Window -> X (Maybe WinRect)
maybeWinRect Screen
scr Window
win = do
      Maybe Rectangle
winrect <- Window -> X (Maybe Rectangle)
windowRect Window
win
      Maybe Rectangle
rect <- case Maybe Rectangle
winrect of
                Just Rectangle
_  -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Rectangle
winrect
                Maybe Rectangle
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
                                 (\Screen -> Window -> X (Maybe Rectangle)
f -> Screen -> Window -> X (Maybe Rectangle)
f Screen
scr Window
win)
                                 (forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall a b. (a -> b) -> a -> b
$ Screen
scr) (Navigation2DConfig
-> [(WorkspaceId, Screen -> Window -> X (Maybe Rectangle))]
unmappedWindowRect Navigation2DConfig
conf))
      forall (m :: * -> *) a. Monad m => a -> m a
return ((,) Window
win forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Rectangle
rect)

-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
windowRect :: Window -> X (Maybe Rectangle)
windowRect :: Window -> X (Maybe Rectangle)
windowRect Window
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
  Bool
mp <- Window -> X Bool
isMapped Window
win
  if Bool
mp then do (Window
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display
-> Window
-> IO
     (Window, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy Window
win
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw) (Dimension
h forall a. Num a => a -> a -> a
+ Dimension
2 forall a. Num a => a -> a -> a
* Dimension
bw)
                forall a. X a -> X a -> X a
`catchX` forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- | Acts on the screens using the given action function
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
             -> Bool  -- ^ Should wrapping be used?
             -> X ()
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -> Bool -> X ()
actOnScreens Navigation2DConfig -> WSRect -> [WSRect] -> X ()
act Bool
wrap = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
winset -> do
  Navigation2DConfig
conf <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  let wsrects :: [WSRect]
wsrects = WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
wrap
      cur :: WorkspaceId
cur     = forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall a b. (a -> b) -> a -> b
$ WindowSet
winset
      rect :: Rectangle
rect    = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup WorkspaceId
cur [WSRect]
wsrects
  Navigation2DConfig -> WSRect -> [WSRect] -> X ()
act Navigation2DConfig
conf (WorkspaceId
cur, Rectangle
rect) [WSRect]
wsrects

-- | Determines whether a given window is mapped
isMapped :: Window -> X Bool
isMapped :: Window -> X Bool
isMapped = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((CInt
waIsUnmapped forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
.  WindowAttributes -> CInt
wa_map_state))
         forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X (Maybe WindowAttributes)
safeGetWindowAttributes

----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
--                                                                                                --
--                                     PRIVATE PURE FUNCTIONS                                     --
--                                                                                                --
----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

-- | Finds the window closest to the given window and focuses it. Ties are
-- broken by choosing the first window in the window stack among the tied
-- windows.  (The stack order is the one produced by integrate'ing each visible
-- workspace's window stack and concatenating these lists for all visible
-- workspaces.)
doFocusClosestWindow :: WinRect
                     -> [WinRect]
                     -> (WindowSet -> WindowSet)
doFocusClosestWindow :: WinRect -> [WinRect] -> WindowSet -> WindowSet
doFocusClosestWindow (Window
cur, Rectangle
rect) [WinRect]
winrects
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Window, (Position, Position))]
winctrs = forall a. a -> a
id
  | Bool
otherwise    = 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}.
(a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closer [(Window, (Position, Position))]
winctrs
  where
    ctr :: (Position, Position)
ctr     = Rectangle -> (Position, Position)
centerOf Rectangle
rect
    winctrs :: [(Window, (Position, Position))]
winctrs = forall a. (a -> Bool) -> [a] -> [a]
filter ((Window
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Rectangle -> (Position, Position)
centerOf) [WinRect]
winrects
    closer :: (a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closer wc1 :: (a, (Position, Position))
wc1@(a
_, (Position, Position)
c1) wc2 :: (a, (Position, Position))
wc2@(a
_, (Position, Position)
c2) | (Position, Position) -> (Position, Position) -> Int
lDist (Position, Position)
ctr (Position, Position)
c1 forall a. Ord a => a -> a -> Bool
> (Position, Position) -> (Position, Position) -> Int
lDist (Position, Position)
ctr (Position, Position)
c2 = (a, (Position, Position))
wc2
                                   | Bool
otherwise                   = (a, (Position, Position))
wc1

-- | Implements navigation for the tiled layer
doTiledNavigation :: Navigation2DConfig
                  -> Direction2D
                  -> (Window -> WindowSet -> WindowSet)
                  -> WinRect
                  -> [WinRect]
                  -> (WindowSet -> WindowSet)
doTiledNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doTiledNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
act WinRect
cur [WinRect]
winrects WindowSet
winset
  | Just Window
win <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WinRect
cur [WinRect]
winrects = Window -> WindowSet -> WindowSet
act Window
win WindowSet
winset
  | Bool
otherwise                               = WindowSet
winset
  where
    layouts :: [WorkspaceId]
layouts = forall a b. (a -> b) -> [a] -> [b]
map (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> WorkspaceId
description forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> l
W.layout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace)
            forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset
    nav :: Navigation2D
nav     = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ( forall a. a -> Maybe a -> a
fromMaybe (Navigation2DConfig -> Navigation2D
defaultTiledNavigation Navigation2DConfig
conf)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup (Navigation2DConfig -> [(WorkspaceId, Navigation2D)]
layoutNavigation Navigation2DConfig
conf)
                  ) [WorkspaceId]
layouts

-- | Implements navigation for the float layer
doFloatNavigation :: Navigation2DConfig
                  -> Direction2D
                  -> (Window -> WindowSet -> WindowSet)
                  -> WinRect
                  -> [WinRect]
                  -> (WindowSet -> WindowSet)
doFloatNavigation :: Navigation2DConfig
-> Direction2D
-> (Window -> WindowSet -> WindowSet)
-> WinRect
-> [WinRect]
-> WindowSet
-> WindowSet
doFloatNavigation Navigation2DConfig
conf Direction2D
dir Window -> WindowSet -> WindowSet
act WinRect
cur [WinRect]
winrects
  | Just Window
win <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WinRect
cur [WinRect]
winrects = Window -> WindowSet -> WindowSet
act Window
win
  | Bool
otherwise                               = forall a. a -> a
id
  where
    nav :: Navigation2D
nav = Navigation2DConfig -> Navigation2D
floatNavigation Navigation2DConfig
conf

-- | Implements navigation between screens
doScreenNavigation :: Navigation2DConfig
                   -> Direction2D
                   -> (WorkspaceId -> WindowSet -> WindowSet)
                   -> WSRect
                   -> [WSRect]
                   -> (WindowSet -> WindowSet)
doScreenNavigation :: Navigation2DConfig
-> Direction2D
-> (WorkspaceId -> WindowSet -> WindowSet)
-> WSRect
-> [WSRect]
-> WindowSet
-> WindowSet
doScreenNavigation Navigation2DConfig
conf Direction2D
dir WorkspaceId -> WindowSet -> WindowSet
act WSRect
cur [WSRect]
wsrects
  | Just WorkspaceId
ws <- forall a.
Eq a =>
Navigation2D -> Direction2D -> Rect a -> [Rect a] -> Maybe a
runNav Navigation2D
nav Direction2D
dir WSRect
cur [WSRect]
wsrects = WorkspaceId -> WindowSet -> WindowSet
act WorkspaceId
ws
  | Bool
otherwise                             = forall a. a -> a
id
  where
    nav :: Navigation2D
nav = Navigation2DConfig -> Navigation2D
screenNavigation Navigation2DConfig
conf

-- | Implements line navigation.  For layouts without overlapping windows, there
-- is no need to break ties between equidistant windows.  When windows do
-- overlap, even the best tie breaking rule cannot make line navigation feel
-- natural.  Thus, we fairly arbtitrarily break ties by preferring the window
-- that comes first in the window stack.  (The stack order is the one produced
-- by integrate'ing each visible workspace's window stack and concatenating
-- these lists for all visible workspaces.)
doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation :: forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doLineNavigation Direction2D
dir (a
cur, Rectangle
rect) [(a, Rectangle)]
winrects
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, Rectangle)]
winrects' = forall a. Maybe a
Nothing
  | Bool
otherwise      = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}. (a, Rectangle) -> (a, Rectangle) -> (a, Rectangle)
closer [(a, Rectangle)]
winrects'
  where
    -- The current window's center
    ctr :: (Position, Position)
ctr@(Position
xc, Position
yc)  = Rectangle -> (Position, Position)
centerOf Rectangle
rect

    -- The list of windows that are candidates to receive focus.
    winrects' :: [(a, Rectangle)]
winrects'     = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Rectangle) -> Bool
dirFilter
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((a
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                  forall a b. (a -> b) -> a -> b
$ [(a, Rectangle)]
winrects

    -- Decides whether a given window matches the criteria to be a candidate to
    -- receive the focus.
    dirFilter :: (a, Rectangle) -> Bool
dirFilter (a
_, Rectangle
r) =  (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
leftOf Rectangle
r Rectangle
rect Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsY Position
yc Rectangle
r)
                     Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
leftOf Rectangle
rect Rectangle
r Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsY Position
yc Rectangle
r)
                     Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
above  Rectangle
r Rectangle
rect Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsX Position
xc Rectangle
r)
                     Bool -> Bool -> Bool
|| (Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
D Bool -> Bool -> Bool
&& Rectangle -> Rectangle -> Bool
above  Rectangle
rect Rectangle
r Bool -> Bool -> Bool
&& Position -> Rectangle -> Bool
intersectsX Position
xc Rectangle
r)

    -- Decide whether r1 is left of/above r2.
    leftOf :: Rectangle -> Rectangle -> Bool
leftOf Rectangle
r1 Rectangle
r2 = Rectangle -> Position
rect_x Rectangle
r1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width  Rectangle
r1) forall a. Ord a => a -> a -> Bool
<= Rectangle -> Position
rect_x Rectangle
r2
    above :: Rectangle -> Rectangle -> Bool
above  Rectangle
r1 Rectangle
r2 = Rectangle -> Position
rect_y Rectangle
r1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r1) forall a. Ord a => a -> a -> Bool
<= Rectangle -> Position
rect_y Rectangle
r2

    -- Check whether r's x-/y-range contains the given x-/y-coordinate.
    intersectsX :: Position -> Rectangle -> Bool
intersectsX Position
x Rectangle
r = Rectangle -> Position
rect_x Rectangle
r forall a. Ord a => a -> a -> Bool
<= Position
x Bool -> Bool -> Bool
&& Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width  Rectangle
r) forall a. Ord a => a -> a -> Bool
>= Position
x
    intersectsY :: Position -> Rectangle -> Bool
intersectsY Position
y Rectangle
r = Rectangle -> Position
rect_y Rectangle
r forall a. Ord a => a -> a -> Bool
<= Position
y Bool -> Bool -> Bool
&& Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) forall a. Ord a => a -> a -> Bool
>= Position
y

    -- Decides whether r1 is closer to the current window's center than r2
    closer :: (a, Rectangle) -> (a, Rectangle) -> (a, Rectangle)
closer wr1 :: (a, Rectangle)
wr1@(a
_, Rectangle
r1) wr2 :: (a, Rectangle)
wr2@(a
_, Rectangle
r2) | (Position, Position) -> Rectangle -> Position
dist (Position, Position)
ctr Rectangle
r1 forall a. Ord a => a -> a -> Bool
> (Position, Position) -> Rectangle -> Position
dist (Position, Position)
ctr Rectangle
r2 = (a, Rectangle)
wr2
                                   | Bool
otherwise                 = (a, Rectangle)
wr1

    -- Returns the distance of r from the point (x, y)
    dist :: (Position, Position) -> Rectangle -> Position
dist (Position
x, Position
y) Rectangle
r | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L  = Position
x forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r)
                  | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R  = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
- Position
x
                  | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U  = Position
y forall a. Num a => a -> a -> a
- Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)
                  | Bool
otherwise = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
- Position
y

-- | Implements center navigation
doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation :: forall a. Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
doCenterNavigation Direction2D
dir (a
cur, Rectangle
rect) [(a, Rectangle)]
winrects
  | ((a
w, (Position, Position)
_):[(a, (Position, Position))]
_) <- [(a, (Position, Position))]
onCtr' = forall a. a -> Maybe a
Just a
w
  | Bool
otherwise            = Maybe a
closestOffCtr
  where
    -- The center of the current window
    (Position
xc, Position
yc) = Rectangle -> (Position, Position)
centerOf Rectangle
rect

    -- All the windows with their center points relative to the current
    -- center rotated so the right cone becomes the relevant cone.
    -- The windows are ordered in the order they should be preferred
    -- when they are otherwise tied.
    winctrs :: [(a, (Position, Position))]
winctrs = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Position, Position) -> (Position, Position)
dirTransform forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> (Position, Position)
centerOf))
            forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [a]
stackTransform [(a, Rectangle)]
winrects

    -- Give preference to windows later in the stack for going left or up and to
    -- windows earlier in the stack for going right or down.  (The stack order
    -- is the one produced by integrate'ing each visible workspace's window
    -- stack and concatenating these lists for all visible workspaces.)
    stackTransform :: [a] -> [a]
stackTransform | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L Bool -> Bool -> Bool
|| Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
U = forall {a}. [a] -> [a]
reverse
                   | Bool
otherwise            = forall a. a -> a
id

    -- Transform a point into a difference to the current window center and
    -- rotate it so that the relevant cone becomes the right cone.
    dirTransform :: (Position, Position) -> (Position, Position)
dirTransform (Position
x, Position
y) | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
R  = (  Position
x forall a. Num a => a -> a -> a
- Position
xc ,   Position
y forall a. Num a => a -> a -> a
- Position
yc )
                        | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
L  = (-(Position
x forall a. Num a => a -> a -> a
- Position
xc), -(Position
y forall a. Num a => a -> a -> a
- Position
yc))
                        | Direction2D
dir forall a. Eq a => a -> a -> Bool
== Direction2D
D  = (  Position
y forall a. Num a => a -> a -> a
- Position
yc ,   Position
x forall a. Num a => a -> a -> a
- Position
xc )
                        | Bool
otherwise = (-(Position
y forall a. Num a => a -> a -> a
- Position
yc), -(Position
x forall a. Num a => a -> a -> a
- Position
xc))

    -- Partition the points into points that coincide with the center
    -- and points that do not.
    ([(a, (Position, Position))]
onCtr, [(a, (Position, Position))]
offCtr) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (\(a
_, (Position
x, Position
y)) -> Position
x forall a. Eq a => a -> a -> Bool
== Position
0 Bool -> Bool -> Bool
&& Position
y forall a. Eq a => a -> a -> Bool
== Position
0) [(a, (Position, Position))]
winctrs

    -- All the points that coincide with the current center and succeed it
    -- in the (appropriately ordered) window stack.
    onCtr' :: [(a, (Position, Position))]
onCtr' = forall a. Int -> [a] -> [a]
L.drop Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile ((a
cur forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(a, (Position, Position))]
onCtr

    -- All the points that do not coincide with the current center and which
    -- lie in the (rotated) right cone.
    offCtr' :: [(a, (Position, Position))]
offCtr' = forall a. (a -> Bool) -> [a] -> [a]
L.filter (\(a
_, (Position
x, Position
y)) -> Position
x forall a. Ord a => a -> a -> Bool
> Position
0 Bool -> Bool -> Bool
&& Position
y forall a. Ord a => a -> a -> Bool
< Position
x Bool -> Bool -> Bool
&& Position
y forall a. Ord a => a -> a -> Bool
>= -Position
x) [(a, (Position, Position))]
offCtr

    -- The off-center point closest to the center and
    -- closest to the bottom ray of the cone.  Nothing if no off-center
    -- point is in the cone
    closestOffCtr :: Maybe a
closestOffCtr = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, (Position, Position))]
offCtr' then forall a. Maybe a
Nothing
                                    else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> a) -> [a] -> a
L.foldl1' forall {a}.
(a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closest [(a, (Position, Position))]
offCtr'

    closest :: (a, (Position, Position))
-> (a, (Position, Position)) -> (a, (Position, Position))
closest wp :: (a, (Position, Position))
wp@(a
_, p :: (Position, Position)
p@(Position
_, Position
yp)) wq :: (a, (Position, Position))
wq@(a
_, q :: (Position, Position)
q@(Position
_, Position
yq))
      | (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
q forall a. Ord a => a -> a -> Bool
< (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
p = (a, (Position, Position))
wq -- q is closer than p
      | (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
p forall a. Ord a => a -> a -> Bool
< (Position, Position) -> (Position, Position) -> Int
lDist (Position
0, Position
0) (Position, Position)
q = (a, (Position, Position))
wp -- q is farther away than p
      | Position
yq forall a. Ord a => a -> a -> Bool
< Position
yp                         = (a, (Position, Position))
wq -- q is closer to the bottom ray than p
      | Bool
otherwise                       = (a, (Position, Position))
wp -- q is farther away from the bottom ray than p
                                             -- or it has the same distance but comes later
                                             -- in the window stack

-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
-- y1 <= y2, and make the assumption valid by initialising SideRects with the
-- property and carefully preserving it over any individual transformation.
data SideRect = SideRect { SideRect -> Int
x1 :: Int, SideRect -> Int
x2 :: Int, SideRect -> Int
y1 :: Int, SideRect -> Int
y2 :: Int }
  deriving Int -> SideRect -> ShowS
[SideRect] -> ShowS
SideRect -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [SideRect] -> ShowS
$cshowList :: [SideRect] -> ShowS
show :: SideRect -> WorkspaceId
$cshow :: SideRect -> WorkspaceId
showsPrec :: Int -> SideRect -> ShowS
$cshowsPrec :: Int -> SideRect -> ShowS
Show

-- Conversion from Rectangle format to SideRect.
toSR :: Rectangle -> SideRect
toSR :: Rectangle -> SideRect
toSR (Rectangle Position
x Position
y Dimension
w Dimension
h) = Int -> Int -> Int -> Int -> SideRect
SideRect (forall a b. (Integral a, Num b) => a -> b
fi Position
x) (forall a b. (Integral a, Num b) => a -> b
fi Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Dimension
w) (-forall a b. (Integral a, Num b) => a -> b
fi Position
y forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fi Dimension
h) (-forall a b. (Integral a, Num b) => a -> b
fi Position
y)

-- Implements side navigation with bias.
doSideNavigationWithBias ::
  Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias :: forall a.
Eq a =>
Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias Int
bias Direction2D
dir (a
cur, Rectangle
rect)
  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn forall {a}. (a, SideRect) -> Int
dist forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. (a, SideRect) -> [(a, SideRect)] -> [(a, SideRect)]
acClosest []
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a} {a}. (a, SideRect) -> (a, SideRect) -> Bool
`toRightOf` (a
cur, Rectangle -> SideRect
transform Rectangle
rect))
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rectangle -> SideRect
transform)
  where
    -- Getting the center of the current window so we can make it the new origin.
    cOf :: SideRect -> (Int, Int)
cOf SideRect
r = ((SideRect -> Int
x1 SideRect
r forall a. Num a => a -> a -> a
+ SideRect -> Int
x2 SideRect
r) forall a. Integral a => a -> a -> a
`div` Int
2, (SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
+ SideRect -> Int
y2 SideRect
r) forall a. Integral a => a -> a -> a
`div` Int
2)
    (Int
x0, Int
y0) = SideRect -> (Int, Int)
cOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> SideRect
toSR forall a b. (a -> b) -> a -> b
$ Rectangle
rect

    -- Translate the given SideRect by (-x0, -y0).
    translate :: SideRect -> SideRect
translate SideRect
r = Int -> Int -> Int -> Int -> SideRect
SideRect (SideRect -> Int
x1 SideRect
r forall a. Num a => a -> a -> a
- Int
x0) (SideRect -> Int
x2 SideRect
r forall a. Num a => a -> a -> a
- Int
x0) (SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
- Int
y0) (SideRect -> Int
y2 SideRect
r forall a. Num a => a -> a -> a
- Int
y0)

    -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
    rHalfPiCC :: SideRect -> SideRect
rHalfPiCC SideRect
r = Int -> Int -> Int -> Int -> SideRect
SideRect (-SideRect -> Int
y2 SideRect
r) (-SideRect -> Int
y1 SideRect
r) (SideRect -> Int
x1 SideRect
r) (SideRect -> Int
x2 SideRect
r)

    -- Apply the above function until d becomes synonymous with R (wolog).
    rotateToR :: Direction2D -> SideRect -> SideRect
rotateToR Direction2D
d = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Direction2D
d forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Direction2D
R, Direction2D
D, Direction2D
L, Direction2D
U] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate SideRect -> SideRect
rHalfPiCC

    transform :: Rectangle -> SideRect
transform = Direction2D -> SideRect -> SideRect
rotateToR Direction2D
dir forall b c a. (b -> c) -> (a -> b) -> a -> c
. SideRect -> SideRect
translate forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rectangle -> SideRect
toSR

    -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
    -- below or above c, i.e. iff:
    -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
    toRightOf :: (a, SideRect) -> (a, SideRect) -> Bool
toRightOf (a
_, SideRect
r) (a
_, SideRect
c) = (SideRect -> Int
x2 SideRect
r forall a. Ord a => a -> a -> Bool
> SideRect -> Int
x2 SideRect
c) Bool -> Bool -> Bool
&& (SideRect -> Int
y2 SideRect
r forall a. Ord a => a -> a -> Bool
> SideRect -> Int
y1 SideRect
c) Bool -> Bool -> Bool
&& (SideRect -> Int
y1 SideRect
r forall a. Ord a => a -> a -> Bool
< SideRect -> Int
y2 SideRect
c)

    -- Greedily accumulate the windows tied for the leftmost left side.
    acClosest :: (a, SideRect) -> [(a, SideRect)] -> [(a, SideRect)]
acClosest (a
w, SideRect
r) l :: [(a, SideRect)]
l@((a
_, SideRect
r'):[(a, SideRect)]
_) | SideRect -> Int
x1 SideRect
r forall a. Eq a => a -> a -> Bool
== SideRect -> Int
x1 SideRect
r' = (a
w, SideRect
r) forall a. a -> [a] -> [a]
: [(a, SideRect)]
l
                                   | SideRect -> Int
x1 SideRect
r forall a. Ord a => a -> a -> Bool
>  SideRect -> Int
x1 SideRect
r' =          [(a, SideRect)]
l
    acClosest (a
w, SideRect
r) [(a, SideRect)]
_                             = [(a
w, SideRect
r)]

    -- Given a (_, SideRect), calculate how far it is from the y=bias line.
    dist :: (a, SideRect) -> Int
dist (a
_, SideRect
r) | (SideRect -> Int
y1 SideRect
r forall a. Ord a => a -> a -> Bool
<= Int
bias) Bool -> Bool -> Bool
&& (Int
bias forall a. Ord a => a -> a -> Bool
<= SideRect -> Int
y2 SideRect
r) = Int
0
                | Bool
otherwise = forall a. Ord a => a -> a -> a
min (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ SideRect -> Int
y1 SideRect
r forall a. Num a => a -> a -> a
- Int
bias) (forall a. Num a => a -> a
abs forall a b. (a -> b) -> a -> b
$ SideRect -> Int
y2 SideRect
r forall a. Num a => a -> a -> a
- Int
bias)

-- | Swaps the current window with the window given as argument
swap :: Window -> WindowSet -> WindowSet
swap :: Window -> WindowSet -> WindowSet
swap Window
win WindowSet
winset = 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
cur
                forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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) WindowSet
newwinset [Window]
newfocused
  where
    -- The current window
    cur :: Window
cur      = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
winset

    -- All screens
    scrs :: [Screen]
scrs     = forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset

    -- All visible workspaces
    visws :: [Workspace WorkspaceId (Layout Window) Window]
visws    = forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen]
scrs

    -- The focused windows of the visible workspaces
    focused :: [Window]
focused  = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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) [Workspace WorkspaceId (Layout Window) Window]
visws

    -- The window lists of the visible workspaces
    wins :: [[Window]]
wins     = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) [Workspace WorkspaceId (Layout Window) Window]
visws

    -- Update focused windows and window lists to reflect swap of windows.
    newfocused :: [Window]
newfocused = forall a b. (a -> b) -> [a] -> [b]
map Window -> Window
swapWins [Window]
focused
    newwins :: [[Window]]
newwins    = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Window -> Window
swapWins) [[Window]]
wins

    -- Replaces the current window with the argument window and vice versa.
    swapWins :: Window -> Window
swapWins Window
x | Window
x forall a. Eq a => a -> a -> Bool
== Window
cur  = Window
win
               | Window
x forall a. Eq a => a -> a -> Bool
== Window
win  = Window
cur
               | Bool
otherwise = Window
x

    -- Reconstruct the workspaces' window stacks to reflect the swap.
    newvisws :: [Workspace WorkspaceId (Layout Window) Window]
newvisws  = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Workspace WorkspaceId (Layout Window) Window
ws [Window]
wns -> Workspace WorkspaceId (Layout Window) Window
ws { stack :: Maybe (Stack Window)
W.stack = forall a. [a] -> Maybe (Stack a)
W.differentiate [Window]
wns }) [Workspace WorkspaceId (Layout Window) Window]
visws [[Window]]
newwins
    newscrs :: [Screen]
newscrs   = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Screen
scr Workspace WorkspaceId (Layout Window) Window
ws -> Screen
scr { workspace :: Workspace WorkspaceId (Layout Window) Window
W.workspace = Workspace WorkspaceId (Layout Window) Window
ws }) [Screen]
scrs [Workspace WorkspaceId (Layout Window) Window]
newvisws
    newwinset :: WindowSet
newwinset = WindowSet
winset { current :: Screen
W.current = forall a. NonEmpty a -> a
NE.head (forall a. HasCallStack => [a] -> NonEmpty a
notEmpty [Screen]
newscrs) -- Always at least one screen.
                       , visible :: [Screen]
W.visible = forall a. Int -> [a] -> [a]
drop Int
1 [Screen]
newscrs
                       }

-- | Calculates the center of a rectangle
centerOf :: Rectangle -> (Position, Position)
centerOf :: Rectangle -> (Position, Position)
centerOf Rectangle
r = (Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width Rectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2, Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2)

-- | Functions to choose the subset of windows to operate on
thisLayer, otherLayer :: a -> a -> a
thisLayer :: forall a. a -> a -> a
thisLayer  = forall a b. a -> b -> a
const
otherLayer :: forall a. a -> a -> a
otherLayer a
_ a
x = a
x

-- | Returns the list of visible workspaces and their screen rects
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
wrap = forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
winset Bool
wrap
                              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ( \Screen
scr -> ( forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace         forall a b. (a -> b) -> a -> b
$ Screen
scr
                                              , ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen
scr
                                              )
                                    )
                              forall a b. (a -> b) -> a -> b
$ WindowSet -> [Screen]
sortedScreens WindowSet
winset

-- | Creates five copies of each (window/workspace, rect) pair in the input: the
-- original and four offset one desktop size (desktop = collection of all
-- screens) to the left, to the right, up, and down.  Wrap-around at desktop
-- edges is implemented by navigating into these displaced copies.
addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
            -> Bool      -- ^ Should wrapping be used?  Do nothing if not.
            -> [Rect a]  -- ^ Input set of (window/workspace, rect) pairs
            -> [Rect a]
addWrapping :: forall a. WindowSet -> Bool -> [Rect a] -> [Rect a]
addWrapping WindowSet
_      Bool
False [Rect a]
wrects = [Rect a]
wrects
addWrapping WindowSet
winset Bool
True  [Rect a]
wrects = [ (a
w, Rectangle
r { rect_x :: Position
rect_x = Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Integer
x
                                          , rect_y :: Position
rect_y = Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi Integer
y
                                          }
                                    )
                                  | (a
w, Rectangle
r) <- [Rect a]
wrects
                                  , (Integer
x, Integer
y)  <- [(Integer
0, Integer
0), (-Integer
xoff, Integer
0), (Integer
xoff, Integer
0), (Integer
0, -Integer
yoff), (Integer
0, Integer
yoff)]
                                  ]
  where
    (Integer
xoff, Integer
yoff) = WindowSet -> (Integer, Integer)
wrapOffsets WindowSet
winset

-- | Calculates the offsets for window/screen coordinates for the duplication
-- of windows/workspaces that implements wrap-around.
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets :: WindowSet -> (Integer, Integer)
wrapOffsets WindowSet
winset = (Integer
max_x forall a. Num a => a -> a -> a
- Integer
min_x, Integer
max_y forall a. Num a => a -> a -> a
- Integer
min_y)
  where
    min_x :: Integer
min_x = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Position
rect_x [Rectangle]
rects
    min_y :: Integer
min_y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> Position
rect_y [Rectangle]
rects
    max_x :: Integer
max_x = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle -> Position
rect_x Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_width  Rectangle
r)) [Rectangle]
rects
    max_y :: Integer
max_y = forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Rectangle
r -> Rectangle -> Position
rect_y Rectangle
r forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fi (Rectangle -> Dimension
rect_height Rectangle
r)) [Rectangle]
rects
    rects :: [Rectangle]
rects = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ WindowSet -> Bool -> [WSRect]
visibleWorkspaces WindowSet
winset Bool
False


-- | Returns the list of screens sorted primarily by their centers'
-- x-coordinates and secondarily by their y-coordinates.
sortedScreens :: WindowSet -> [Screen]
sortedScreens :: WindowSet -> [Screen]
sortedScreens WindowSet
winset = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy forall {i} {l} {a} {sid} {i} {l} {a} {sid}.
Screen i l a sid ScreenDetail
-> Screen i l a sid ScreenDetail -> Ordering
cmp
                     forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens WindowSet
winset
  where
    cmp :: Screen i l a sid ScreenDetail
-> Screen i l a sid ScreenDetail -> Ordering
cmp Screen i l a sid ScreenDetail
s1 Screen i l a sid ScreenDetail
s2 | Position
x forall a. Ord a => a -> a -> Bool
< Position
x'   = Ordering
LT
              | Position
x forall a. Ord a => a -> a -> Bool
> Position
x'   = Ordering
GT
              | Position
y forall a. Ord a => a -> a -> Bool
< Position
x'   = Ordering
LT
              | Position
y forall a. Ord a => a -> a -> Bool
> Position
y'   = Ordering
GT
              | Bool
otherwise = Ordering
EQ
      where
        (Position
x , Position
y ) = Rectangle -> (Position, Position)
centerOf (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen i l a sid ScreenDetail
s1)
        (Position
x', Position
y') = Rectangle -> (Position, Position)
centerOf (ScreenDetail -> Rectangle
screenRect forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail forall a b. (a -> b) -> a -> b
$ Screen i l a sid ScreenDetail
s2)


-- | Calculates the L1-distance between two points.
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist :: (Position, Position) -> (Position, Position) -> Int
lDist (Position
x, Position
y) (Position
x', Position
y') = forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
- Position
x') forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
- Position
y')