{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.WindowNavigation
-- Description :  Experimental rewrite of "XMonad.Layout.WindowNavigation".
-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,
--                          Devin Mullins <me@twifkak.com>
-- Maintainer  :  Devin Mullins <me@twifkak.com>,
--                Platon Pronko <platon7pronko@gmail.com>
-- License     :  BSD3-style (see LICENSE)
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is a rewrite of "XMonad.Layout.WindowNavigation".  WindowNavigation
-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian
-- window coordinates, rather than just going j\/k on the stack.
--
-- This module is experimental. You'll have better luck with the original.
--
-- This module differs from the other in a few ways:
--
--   (1) You can go up\/down\/left\/right across multiple screens.
--
--   (2) It doesn't provide little border colors for your neighboring windows.
--
--   (3) It doesn't provide the \'Move\' action, which seems to be related to
--      the XMonad.Layout.Combo extension.
--
--   (4) It tries to be slightly smarter about tracking your current position.
--
--   (5) Configuration is different.
--
-----------------------------------------------------------------------------

module XMonad.Actions.WindowNavigation (
                                       -- * Usage
                                       -- $usage
                                       withWindowNavigation,
                                       withWindowNavigationKeys,
                                       WNAction(..),
                                       go, swap,
                                       goPure, swapPure,
                                       Direction2D(..), WNState,
                                       ) where

import XMonad hiding (state)
import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W

import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import Data.List (partition, find)
import qualified Data.Map as M
import qualified Data.Set as S

-- $usage
--
-- To use it, you're going to apply the 'withWindowNavigation' function.
-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use
-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog".
-- In particular:
--
-- > main = do
-- >     config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
-- >             $ def { ... }
-- >     xmonad config
--
-- Or, for the brave souls:
--
-- > main = xmonad =<< withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
-- >             $ def { ... }
--
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
-- to swap windows.
--
-- If you want more flexibility over your keybindings, you can use
-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather
-- than a tuple of the four directional keys. See the source code of
-- 'withWindowNavigation' for an example.

-- TODO:
--  - monad for WNState?
--  - cleanup (including inr)
--  - more documentation
--  - tests? (esp. for edge cases in currentPosition)
--  - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2
--  - solve the 2+3, middle right to bottom left problem
--  - command to iteratively swapUp/swapDown instead of directly swapping with target
--  - manageHook to draw window decos?

withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation :: forall (l :: * -> *).
(KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
withWindowNavigation (KeySym
u,KeySym
l,KeySym
d,KeySym
r) conf :: XConfig l
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
modMask=KeyMask
modm} =
    forall (l :: * -> *).
[((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [ ((KeyMask
modm              , KeySym
u), Direction2D -> WNAction
WNGo   Direction2D
U),
                               ((KeyMask
modm              , KeySym
l), Direction2D -> WNAction
WNGo   Direction2D
L),
                               ((KeyMask
modm              , KeySym
d), Direction2D -> WNAction
WNGo   Direction2D
D),
                               ((KeyMask
modm              , KeySym
r), Direction2D -> WNAction
WNGo   Direction2D
R),
                               ((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
u), Direction2D -> WNAction
WNSwap Direction2D
U),
                               ((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
l), Direction2D -> WNAction
WNSwap Direction2D
L),
                               ((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
d), Direction2D -> WNAction
WNSwap Direction2D
D),
                               ((KeyMask
modm forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
r), Direction2D -> WNAction
WNSwap Direction2D
R) ]
                             XConfig l
conf

withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys :: forall (l :: * -> *).
[((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys [((KeyMask, KeySym), WNAction)]
wnKeys XConfig l
conf = do
    IORef (Map WorkspaceId Point)
stateRef <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
M.empty
    forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
conf { keys :: XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys = \XConfig Layout
cnf -> forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
stateRef)) [((KeyMask, KeySym), WNAction)]
wnKeys)
                                 forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf XConfig Layout
cnf,
                  logHook :: X ()
logHook = forall (l :: * -> *). XConfig l -> X ()
logHook XConfig l
conf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
stateRef }
  where fromWNAction :: IORef (Map WorkspaceId Point) -> WNAction -> X ()
fromWNAction IORef (Map WorkspaceId Point)
stateRef (WNGo Direction2D
dir)   = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go   IORef (Map WorkspaceId Point)
stateRef Direction2D
dir
        fromWNAction IORef (Map WorkspaceId Point)
stateRef (WNSwap Direction2D
dir) = IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
stateRef Direction2D
dir

data WNAction = WNGo Direction2D | WNSwap Direction2D

type WNState = Map WorkspaceId Point

-- | Focus window in the given direction.
go :: IORef WNState -> Direction2D -> X ()
go :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
go IORef (Map WorkspaceId Point)
stateRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef (forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
goPure Direction2D
dir)

-- | Swap current window with the window in the given direction.
-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows).
swap :: IORef WNState -> Direction2D -> X ()
swap :: IORef (Map WorkspaceId Point) -> Direction2D -> X ()
swap IORef (Map WorkspaceId Point)
stateRef Direction2D
dir = IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef (forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
swapPure Direction2D
dir)

type WindowRectFn x = (Window -> x (Maybe Rectangle))
-- | (state, oldWindowSet, mappedWindows, windowRect)
type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)
type WNOutput = (WNState, WindowSet)

-- | Run the pure action inside X monad.
runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()
runPureAction :: IORef (Map WorkspaceId Point) -> (WNInput X -> X WNOutput) -> X ()
runPureAction IORef (Map WorkspaceId Point)
stateRef WNInput X -> X WNOutput
action = do
  Map WorkspaceId Point
oldState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
  WindowSet
oldWindowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  Set KeySym
mappedWindows <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped
  (Map WorkspaceId Point
newState, WindowSet
newWindowSet) <- WNInput X -> X WNOutput
action (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, KeySym -> X (Maybe Rectangle)
windowRectX)
  (WindowSet -> WindowSet) -> X ()
windows (forall a b. a -> b -> a
const WindowSet
newWindowSet)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WorkspaceId Point)
stateRef Map WorkspaceId Point
newState

-- | Version of `go` not dependent on X monad (needed for testing).
goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
goPure :: forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
goPure Direction2D
dir input :: WNInput x
input@(Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, WindowRectFn x
_) =
  if forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.member` Set KeySym
mappedWindows) 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 forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
oldWindowSet) forall a. Eq a => a -> a -> Bool
== Int
1
  then
    -- Handle the special case of Full layout, when there's only one mapped window on a screen.
    forall (m :: * -> *) a. Monad m => a -> m a
return ( Map WorkspaceId Point
oldState
           , case Direction2D
dir of
               Direction2D
U -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
               Direction2D
L -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
               Direction2D
D -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
               Direction2D
R -> forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
           )
  else
    forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow 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 Direction2D
dir WNInput x
input

-- | Version of `swap` not dependent on X monad (needed for testing).
swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
swapPure :: forall (x :: * -> *).
Monad x =>
Direction2D -> WNInput x -> x WNOutput
swapPure = forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow 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
swapWithFocused
  where swapWithFocused :: a -> StackSet i l a s sd -> StackSet i l a s sd
swapWithFocused a
targetWin StackSet i l a s sd
winSet =
            case forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l a s sd
winSet of
                Just a
currentWin -> 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 a
currentWin forall a b. (a -> b) -> a -> b
$
                                   forall {a} {i} {l} {s} {sd}.
(a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows (forall {a}. Eq a => a -> a -> a -> a
swapWin a
currentWin a
targetWin) StackSet i l a s sd
winSet
                Maybe a
Nothing -> StackSet i l a s sd
winSet
        mapWindows :: (a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows a -> a
f = forall i l a s sd.
(Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
W.mapWorkspace (forall {a} {a} {i} {l}.
(a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f)
        mapWindows' :: (a -> a) -> Workspace i l a -> Workspace i l a
mapWindows' a -> a
f ws :: Workspace i l a
ws@W.Workspace{ stack :: forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack = Maybe (Stack a)
s } = Workspace i l a
ws { stack :: Maybe (Stack a)
W.stack = forall {a} {a}. (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Stack a)
s }
        mapWindows'' :: (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f (W.Stack a
focused [a]
up [a]
down) = forall a. a -> [a] -> [a] -> Stack a
W.Stack (a -> a
f a
focused) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
up) (forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
down)
        swapWin :: a -> a -> a -> a
swapWin a
win1 a
win2 a
win
          | a
win forall a. Eq a => a -> a -> Bool
== a
win1 = a
win2
          | a
win forall a. Eq a => a -> a -> Bool
== a
win2 = a
win1
          | Bool
otherwise = a
win

-- | Select a target window in the given direction and modify the WindowSet.
-- 1. Get current position, verifying it matches the current window (exit if no focused window).
-- 2. Get the target window.
-- 3. Execute an action on the target window and windowset.
-- 4. Set the new position.
withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput
withTargetWindow :: forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow KeySym -> WindowSet -> WindowSet
adj Direction2D
dir input :: WNInput x
input@(Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) = do
  forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow WNInput x
input) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ \(KeySym
win, Rectangle
winRect, Point
pos) -> do
    Maybe (KeySym, Point)
targetMaybe <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
/= KeySym
win) 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 (x :: * -> *).
Monad x =>
WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
navigableTargets WNInput x
input Direction2D
dir Rectangle
winRect Point
pos
    forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (KeySym, Point)
targetMaybe) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ \(KeySym
targetWin, Point
newPos) ->
      let newWindowSet :: WindowSet
newWindowSet = KeySym -> WindowSet -> WindowSet
adj KeySym
targetWin WindowSet
oldWindowSet
      in forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
newWindowSet Point
newPos Map WorkspaceId Point
oldState, WindowSet
newWindowSet)

-- | Update position on outside changes in windows.
trackMovement :: IORef WNState -> X ()
trackMovement :: IORef (Map WorkspaceId Point) -> X ()
trackMovement IORef (Map WorkspaceId Point)
stateRef = do
  Map WorkspaceId Point
oldState <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
  WindowSet
oldWindowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  Set KeySym
mappedWindows <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped
  forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet, Set KeySym
mappedWindows, KeySym -> X (Maybe Rectangle)
windowRectX)) () forall a b. (a -> b) -> a -> b
$ \(KeySym
_, Rectangle
_, Point
pos) -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WorkspaceId Point)
stateRef forall a b. (a -> b) -> a -> b
$ WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
oldWindowSet Point
pos Map WorkspaceId Point
oldState

-- | Get focused window and current position.
getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
getCurrentWindow :: forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow input :: WNInput x
input@(Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) =
  forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ \KeySym
window -> do
    (Point
pos, Rectangle
rect) <- forall (x :: * -> *). Monad x => WNInput x -> x (Point, Rectangle)
currentPosition WNInput x
input
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (KeySym
window, Rectangle
rect, Point
pos)

-- | Gets the current position from the state passed in, or if nothing
-- (say, from a restart), derives the current position from the current window.
-- Also, verifies that the position is congruent with the current window
-- (say, if you moved focus using mouse or something).
-- Returns the window rectangle for convenience, since we'll need it later anyway.
currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
currentPosition :: forall (x :: * -> *). Monad x => WNInput x -> x (Point, Rectangle)
currentPosition (Map WorkspaceId Point
state, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
windowRect) = do
  Rectangle
currentRect <- forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) WindowRectFn x
windowRect (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet)
  let posMaybe :: Maybe Point
posMaybe = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
oldWindowSet) Map WorkspaceId Point
state
      middleOf :: Rectangle -> Point
middleOf (Rectangle Position
x Position
y Dimension
w Dimension
h) = Position -> Position -> Point
Point (Position -> Dimension -> Position
midPoint Position
x Dimension
w) (Position -> Dimension -> Position
midPoint Position
y Dimension
h)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Point
posMaybe of
    Maybe Point
Nothing -> (Rectangle -> Point
middleOf Rectangle
currentRect, Rectangle
currentRect)
    Just Point
pos -> (Rectangle -> Point -> Point
centerPosition Rectangle
currentRect Point
pos, Rectangle
currentRect)

-- | Inserts new position into the state.
modifyState :: WindowSet -> Point -> WNState -> WNState
modifyState :: WindowSet
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
modifyState WindowSet
oldWindowSet =
  forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
oldWindowSet)

-- | "Jumps" the current position into the middle of target rectangle.
-- (keeps the position as-is if it is already inside the target rectangle)
centerPosition :: Rectangle -> Point -> Point
centerPosition :: Rectangle -> Point -> Point
centerPosition r :: Rectangle
r@(Rectangle Position
rx Position
ry Dimension
rw Dimension
rh) pos :: Point
pos@(Point Position
x Position
y) = do
  if Position -> Position -> Rectangle -> Bool
pointWithin Position
x Position
y Rectangle
r
  then Point
pos
  else Position -> Position -> Point
Point (Position -> Dimension -> Position
midPoint Position
rx Dimension
rw) (Position -> Dimension -> Position
midPoint Position
ry Dimension
rh)

midPoint :: Position -> Dimension -> Position
midPoint :: Position -> Dimension -> Position
midPoint Position
pos Dimension
dim = Position
pos forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim forall a. Integral a => a -> a -> a
`div` Position
2

-- | Make a list of target windows we can navigate to,
-- sorted by desirability of navigation.
navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]
navigableTargets :: forall (x :: * -> *).
Monad x =>
WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
navigableTargets input :: WNInput x
input@(Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
_, WindowRectFn x
_) Direction2D
dir Rectangle
currentRect Point
currentPos = do
  [(KeySym, DirRectangle)]
allScreensWindowsAndRectangles <- forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: * -> *).
Monad x =>
WNInput x -> x [(KeySym, Rectangle)]
windowRects WNInput x
input
  let
    screenWindows :: Set KeySym
screenWindows = forall a. Ord a => [a] -> Set a
S.fromList 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 forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
oldWindowSet
    ([(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles, [(KeySym, DirRectangle)]
otherScreensWindowsAndRectangles) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(KeySym
w, DirRectangle
_) -> forall a. Ord a => a -> Set a -> Bool
S.member KeySym
w Set KeySym
screenWindows) [(KeySym, DirRectangle)]
allScreensWindowsAndRectangles

    pos :: DirPoint
pos = Direction2D -> Point -> DirPoint
pointTransform Direction2D
dir Point
currentPos
    wr :: DirRectangle
wr = Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir Rectangle
currentRect

    rectInside :: DirRectangle -> Bool
rectInside DirRectangle
r = (DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr) Bool -> Bool -> Bool
&&
                   ((DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o2 DirRectangle
wr) Bool -> Bool -> Bool
||
                    (DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o2 DirRectangle
wr)) -- include windows that fully overlaps current on the orthogonal axis
    sortByP2 :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DirRectangle -> Position
rect_p2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    posBeforeEdge :: DirRectangle -> Bool
posBeforeEdge DirRectangle
r = DirPoint -> Position
point_p DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
r

    rectOverlapsEdge :: DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&&
                         DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr
    rectOverlapsOneEdge :: DirRectangle -> Bool
rectOverlapsOneEdge DirRectangle
r = DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p1 DirRectangle
wr
    rectOverlapsBothEdges :: DirRectangle -> Bool
rectOverlapsBothEdges DirRectangle
r = DirRectangle -> Bool
rectOverlapsEdge DirRectangle
r Bool -> Bool -> Bool
&&
                              DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
r
    distanceToRectEdge :: DirRectangle -> Position
distanceToRectEdge DirRectangle
r = forall a. Ord a => a -> a -> a
max (forall a. Ord a => a -> a -> a
max Position
0 (DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos)) (forall a. Ord a => a -> a -> a
max Position
0 (DirPoint -> Position
point_o DirPoint
pos forall a. Num a => a -> a -> a
+ Position
1 forall a. Num a => a -> a -> a
- DirRectangle -> Position
rect_o2 DirRectangle
r))
    distanceToRectCenter :: DirRectangle -> Position
distanceToRectCenter DirRectangle
r =
      let distance :: Position
distance = (DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Num a => a -> a -> a
+ DirRectangle -> Position
rect_o2 DirRectangle
r) forall a. Integral a => a -> a -> a
`div` Position
2 forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos
      in if Position
distance forall a. Ord a => a -> a -> Bool
<= Position
0
         then Position
distance forall a. Num a => a -> a -> a
+ Position
1
         else Position
distance
    sortByPosDistance :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((\DirRectangle
r -> (DirRectangle -> Position
rect_p1 DirRectangle
r, DirRectangle -> Position
distanceToRectEdge DirRectangle
r, DirRectangle -> Position
distanceToRectCenter DirRectangle
r)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

    rectOutside :: DirRectangle -> Bool
rectOutside DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&&
                    DirRectangle -> Position
rect_o1 DirRectangle
r forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o2 DirRectangle
wr
    sortByLength :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByLength = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DirRectangle -> Dimension
rect_psize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

    rectAfterEdge :: DirRectangle -> Bool
rectAfterEdge DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr

    -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:
    inr :: DirRectangle -> Bool
inr DirRectangle
r = DirPoint -> Position
point_p DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
r

    clamp :: a -> a -> a -> a
clamp a
v a
v1 a
v2 | a
v forall a. Ord a => a -> a -> Bool
< a
v1 = a
v1
                  | a
v forall a. Ord a => a -> a -> Bool
>= a
v2 = a
v2 forall a. Num a => a -> a -> a
- a
1
                  | Bool
otherwise = a
v
    dragPos :: DirRectangle -> DirPoint
dragPos DirRectangle
r = Position -> Position -> DirPoint
DirPoint (forall a. Ord a => a -> a -> a
max (DirPoint -> Position
point_p DirPoint
pos) (DirRectangle -> Position
rect_p1 DirRectangle
r)) (forall {a}. (Ord a, Num a) => a -> a -> a -> a
clamp (DirPoint -> Position
point_o DirPoint
pos) (DirRectangle -> Position
rect_o1 DirRectangle
r) (DirRectangle -> Position
rect_o2 DirRectangle
r))

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> DirPoint -> Point
inversePointTransform Direction2D
dir) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [
      -- First, navigate to windows that are fully inside current window
      -- and have higher coordinate bigger than current position.
      -- ┌──────────────────┐
      -- │   current        │  (all examples assume direction=R)
      -- │    ┌──────────┐  │
      -- │  ──┼─► inside │  │
      -- │    └──────────┘  │
      -- └──────────────────┘
      -- Also include windows fully overlapping current on the orthogonal axis:
      --             ┌──────────────┐
      --             │ overlapping  │
      -- ┌───────────┤              ├────┐
      -- │ current ──┼─►            │    │
      -- └───────────┤              ├────┘
      --             └──────────────┘
      forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
posBeforeEdge forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectInside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles

      -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.
      -- ┌──────────────┬─────────────┐   ┌───────────┐                   ┌─────────────┐
      -- │ current      │ adjacent    │   │ current   │                   │ current     │
      -- │            ──┼─►           │   │       ┌───┴───────────────┐   │         ┌───┴─────────────┐
      -- │              │             │   │     ──┼─► │   overlapping │   │       ──┼─►               │
      -- │              ├─────────────┘   │       └───┬───────────────┘   └─────────┤     overlapping │
      -- │              │                 │           │                             │                 │
      -- └──────────────┘                 └───────────┘                             └─────────────────┘
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOverlapsOneEdge [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles

      -- Windows fully overlapping current window "in the middle" on the parallel axis are also included,
      -- if position is inside them:
      --     ┌───────────┐
      --     │  current  │
      -- ┌───┤-----------├────────────────┐
      -- │   │     *   ──┼─►  overlapping │
      -- └───┤-----------├────────────────┘
      --     └───────────┘
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
_ -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
wr) (DirPoint -> Position
point_o DirPoint
pos)) forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOverlapsBothEdges [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles

      -- Then navigate to windows that fully encompass the current window.
      -- ┌─────────────────────┐
      -- │    outer            │
      -- │  ┌─────────────┐    │
      -- │  │  current  ──┼─►  │
      -- │  └─────────────┘    │
      -- └─────────────────────┘
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
_ -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
wr) (DirPoint -> Position
point_o DirPoint
pos)) forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByLength forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectOutside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles

      -- Then navigate to windows that are fully after current window in the chosen direction.
      -- ┌──────────────┐
      -- │ current      │  ┌────────────────┐
      -- │              │  │                │
      -- │            ──┼──┼─► not adjacent │
      -- │              │  │                │
      -- │              │  └────────────────┘
      -- └──────────────┘
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectAfterEdge [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles

      -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
inr [(KeySym, DirRectangle)]
otherScreensWindowsAndRectangles

      -- If everything else fails, then navigate to the window that is fully inside current window,
      -- but is before the current position.
      -- This can happen when we are at the last window on a screen, and attempt to navigate even further.
      -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,
      -- and user is probably not so fully aware of the precise position anyway.
    , forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
r -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Num a => a -> a -> a
- Position
1) (forall {a}. (Ord a, Num a) => a -> a -> a -> a
clamp (DirPoint -> Position
point_o DirPoint
pos) (DirRectangle -> Position
rect_o1 DirRectangle
r) (DirRectangle -> Position
rect_o2 DirRectangle
r))) forall a b. (a -> b) -> a -> b
$
      forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirRectangle -> Bool
posBeforeEdge) forall a b. (a -> b) -> a -> b
$ forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
rectInside [(KeySym, DirRectangle)]
thisScreenWindowsAndRectangles
    ]

-- Structs for direction-independent space - equivalent to rotating points and rectangles such that
-- navigation direction points to the right.
-- Allows us to abstract over direction in the navigation functions.
data DirPoint = DirPoint
  { DirPoint -> Position
point_p :: Position -- coordinate parallel to the direction
  , DirPoint -> Position
point_o :: Position -- coordinate orthogonal to the direction
  }
data DirRectangle = DirRectangle
  { DirRectangle -> Position
rect_p1 :: Position -- lower rectangle coordinate parallel to the direction
  , DirRectangle -> Position
rect_p2 :: Position -- higher rectangle coordinate parallel to the direction
  , DirRectangle -> Position
rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction
  , DirRectangle -> Position
rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction
  }
{- HLINT ignore "Use camelCase" -}
rect_psize :: DirRectangle -> Dimension
rect_psize :: DirRectangle -> Dimension
rect_psize DirRectangle
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral (DirRectangle -> Position
rect_p2 DirRectangle
r forall a. Num a => a -> a -> a
- DirRectangle -> Position
rect_p1 DirRectangle
r)

-- | Transform a point from screen space into direction-independent space.
pointTransform :: Direction2D -> Point -> DirPoint
pointTransform :: Direction2D -> Point -> DirPoint
pointTransform Direction2D
dir (Point Position
x Position
y) = case Direction2D
dir of
  Direction2D
U -> Position -> Position -> DirPoint
DirPoint (forall a. Num a => a -> a
negate Position
y forall a. Num a => a -> a -> a
- Position
1) Position
x
  Direction2D
L -> Position -> Position -> DirPoint
DirPoint (forall a. Num a => a -> a
negate Position
x forall a. Num a => a -> a -> a
- Position
1) (forall a. Num a => a -> a
negate Position
y forall a. Num a => a -> a -> a
- Position
1)
  Direction2D
D -> Position -> Position -> DirPoint
DirPoint Position
y (forall a. Num a => a -> a
negate Position
x forall a. Num a => a -> a -> a
- Position
1)
  Direction2D
R -> Position -> Position -> DirPoint
DirPoint Position
x Position
y

-- | Transform a point from direction-independent space back into screen space.
inversePointTransform :: Direction2D -> DirPoint -> Point
inversePointTransform :: Direction2D -> DirPoint -> Point
inversePointTransform Direction2D
dir DirPoint
p = case Direction2D
dir of
  Direction2D
U -> Position -> Position -> Point
Point (DirPoint -> Position
point_o DirPoint
p) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p forall a. Num a => a -> a -> a
+ Position
1)
  Direction2D
L -> Position -> Position -> Point
Point (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p forall a. Num a => a -> a -> a
+ Position
1) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p forall a. Num a => a -> a -> a
+ Position
1)
  Direction2D
D -> Position -> Position -> Point
Point (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p forall a. Num a => a -> a -> a
+ Position
1) (DirPoint -> Position
point_p DirPoint
p)
  Direction2D
R -> Position -> Position -> Point
Point (DirPoint -> Position
point_p DirPoint
p) (DirPoint -> Position
point_o DirPoint
p)

-- | Transform a rectangle from screen space into direction-independent space.
rectTransform :: Direction2D -> Rectangle -> DirRectangle
rectTransform :: Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir (Rectangle Position
x Position
y Dimension
w Dimension
h) = case Direction2D
dir of
  Direction2D
U -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate Position
y) Position
x (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w)
  Direction2D
L -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (forall a. Num a => a -> a
negate Position
x) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate Position
y)
  Direction2D
D -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
y (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (forall a. Num a => a -> a
negate Position
x)
  Direction2D
R -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
x (Position
x forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) Position
y (Position
y forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h)

-- | Produces a list of normal-state windows on all screens, excluding currently focused window.
windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]
windowRects :: forall (x :: * -> *).
Monad x =>
WNInput x -> x [(KeySym, Rectangle)]
windowRects (Map WorkspaceId Point
_, WindowSet
oldWindowSet, Set KeySym
mappedWindows, WindowRectFn x
windowRect) =
  let
    allWindows :: [KeySym]
allWindows = forall a. (a -> Bool) -> [a] -> [a]
filter (\KeySym
w -> KeySym
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set KeySym
mappedWindows
    windowRect2 :: KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 KeySym
w = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeySym
w,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowRectFn x
windowRect KeySym
w
  in forall a. [Maybe a] -> [a]
catMaybes 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 KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 [KeySym]
allWindows

windowRectX :: Window -> X (Maybe Rectangle)
windowRectX :: KeySym -> X (Maybe Rectangle)
windowRectX KeySym
win = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    (KeySym
_, 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
-> KeySym
-> IO
     (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy KeySym
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

-- Maybe below functions can be replaced with some standard helper functions?

-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' :: forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' x (Maybe a)
monadMaybeValue b
deflt a -> x b
f = do
  Maybe a
maybeValue <- x (Maybe a)
monadMaybeValue
  case Maybe a
maybeValue of
    Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return b
deflt
    Just a
value -> a -> x b
f a
value

-- | Filter a list of tuples on the second tuple member.
filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd :: forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd b -> Bool
f = forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)

-- | Map a second tuple member in a list of tuples.
mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd :: forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd b -> b'
f = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> b'
f)