{-# 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} =
    [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
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 KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
u), Direction2D -> WNAction
WNSwap Direction2D
U),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
l), Direction2D -> WNAction
WNSwap Direction2D
L),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, KeySym
d), Direction2D -> WNAction
WNSwap Direction2D
D),
                               ((KeyMask
modm KeyMask -> KeyMask -> KeyMask
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 <- Map WorkspaceId Point -> IO (IORef (Map WorkspaceId Point))
forall a. a -> IO (IORef a)
newIORef Map WorkspaceId Point
forall k a. Map k a
M.empty
    XConfig l -> IO (XConfig l)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return XConfig l
conf { keys = \XConfig Layout
cnf -> [((KeyMask, KeySym), X ())] -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((((KeyMask, KeySym), WNAction) -> ((KeyMask, KeySym), X ()))
-> [((KeyMask, KeySym), WNAction)] -> [((KeyMask, KeySym), X ())]
forall a b. (a -> b) -> [a] -> [b]
map ((WNAction -> X ())
-> ((KeyMask, KeySym), WNAction) -> ((KeyMask, KeySym), X ())
forall b c d. (b -> c) -> (d, b) -> (d, c)
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)
                                 Map (KeyMask, KeySym) (X ())
-> Map (KeyMask, KeySym) (X ()) -> Map (KeyMask, KeySym) (X ())
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, KeySym) (X ())
keys XConfig l
conf XConfig Layout
cnf,
                  logHook = logHook conf >> trackMovement 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 (Direction2D -> WNInput X -> X WNOutput
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 (Direction2D -> WNInput X -> X WNOutput
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 <- IO (Map WorkspaceId Point) -> X (Map WorkspaceId Point)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Map WorkspaceId Point) -> IO (Map WorkspaceId Point)
forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
  WindowSet
oldWindowSet <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  Set KeySym
mappedWindows <- (XState -> Set KeySym) -> X (Set KeySym)
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 (WindowSet -> WindowSet -> WindowSet
forall a b. a -> b -> a
const WindowSet
newWindowSet)
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ IORef (Map WorkspaceId Point) -> Map WorkspaceId Point -> IO ()
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 [KeySym] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((KeySym -> Bool) -> [KeySym] -> [KeySym]
forall a. (a -> Bool) -> [a] -> [a]
filter (KeySym -> Set KeySym -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set KeySym
mappedWindows) ([KeySym] -> [KeySym]) -> [KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Maybe (Stack KeySym) -> [KeySym]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack KeySym) -> [KeySym])
-> Maybe (Stack KeySym) -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceId (Layout KeySym) KeySym
-> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout KeySym) KeySym
 -> Maybe (Stack KeySym))
-> Workspace WorkspaceId (Layout KeySym) KeySym
-> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout KeySym) KeySym)
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
oldWindowSet) Int -> Int -> Bool
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.
    WNOutput -> x WNOutput
forall a. a -> x a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Map WorkspaceId Point
oldState
           , case Direction2D
dir of
               Direction2D
U -> WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
               Direction2D
L -> WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
               Direction2D
D -> WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusDown WindowSet
oldWindowSet
               Direction2D
R -> WindowSet -> WindowSet
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusUp WindowSet
oldWindowSet
           )
  else
    (KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow KeySym -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow 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 = (KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
forall (x :: * -> *).
Monad x =>
(KeySym -> WindowSet -> WindowSet)
-> Direction2D -> WNInput x -> x WNOutput
withTargetWindow KeySym -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
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 StackSet i l a s sd -> Maybe a
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 -> a -> StackSet i l a s sd -> StackSet i l a s sd
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 (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$
                                   (a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
forall {a} {i} {l} {s} {sd}.
(a -> a) -> StackSet i l a s sd -> StackSet i l a s sd
mapWindows (a -> a -> a -> a
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 = (Workspace i l a -> Workspace i l a)
-> StackSet i l a s sd -> StackSet i l a s sd
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 ((a -> a) -> Workspace i l a -> Workspace i l a
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 { W.stack = mapWindows'' f <$> s }
        mapWindows'' :: (a -> a) -> Stack a -> Stack a
mapWindows'' a -> a
f (W.Stack a
focused [a]
up [a]
down) = a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack (a -> a
f a
focused) ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
up) ((a -> a) -> [a] -> [a]
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
win1 = a
win2
          | a
win a -> a -> Bool
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
  x (Maybe (KeySym, Rectangle, Point))
-> WNOutput
-> ((KeySym, Rectangle, Point) -> x WNOutput)
-> x WNOutput
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (WNInput x -> x (Maybe (KeySym, Rectangle, Point))
forall (x :: * -> *).
Monad x =>
WNInput x -> x (Maybe (KeySym, Rectangle, Point))
getCurrentWindow WNInput x
input) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) (((KeySym, Rectangle, Point) -> x WNOutput) -> x WNOutput)
-> ((KeySym, Rectangle, Point) -> x WNOutput) -> x WNOutput
forall a b. (a -> b) -> a -> b
$ \(KeySym
win, Rectangle
winRect, Point
pos) -> do
    Maybe (KeySym, Point)
targetMaybe <- ((KeySym, Point) -> Bool)
-> [(KeySym, Point)] -> Maybe (KeySym, Point)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
/= KeySym
win) (KeySym -> Bool)
-> ((KeySym, Point) -> KeySym) -> (KeySym, Point) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeySym, Point) -> KeySym
forall a b. (a, b) -> a
fst) ([(KeySym, Point)] -> Maybe (KeySym, Point))
-> x [(KeySym, Point)] -> x (Maybe (KeySym, Point))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
forall (x :: * -> *).
Monad x =>
WNInput x
-> Direction2D -> Rectangle -> Point -> x [(KeySym, Point)]
navigableTargets WNInput x
input Direction2D
dir Rectangle
winRect Point
pos
    x (Maybe (KeySym, Point))
-> WNOutput -> ((KeySym, Point) -> x WNOutput) -> x WNOutput
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (Maybe (KeySym, Point) -> x (Maybe (KeySym, Point))
forall a. a -> x a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (KeySym, Point)
targetMaybe) (Map WorkspaceId Point
oldState, WindowSet
oldWindowSet) (((KeySym, Point) -> x WNOutput) -> x WNOutput)
-> ((KeySym, Point) -> x WNOutput) -> x WNOutput
forall a b. (a -> b) -> a -> b
$ \(KeySym
targetWin, Point
newPos) ->
      let newWindowSet :: WindowSet
newWindowSet = KeySym -> WindowSet -> WindowSet
adj KeySym
targetWin WindowSet
oldWindowSet
      in WNOutput -> x WNOutput
forall a. a -> x a
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 <- IO (Map WorkspaceId Point) -> X (Map WorkspaceId Point)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (Map WorkspaceId Point) -> IO (Map WorkspaceId Point)
forall a. IORef a -> IO a
readIORef IORef (Map WorkspaceId Point)
stateRef)
  WindowSet
oldWindowSet <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  Set KeySym
mappedWindows <- (XState -> Set KeySym) -> X (Set KeySym)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> Set KeySym
mapped
  X (Maybe (KeySym, Rectangle, Point))
-> () -> ((KeySym, Rectangle, Point) -> X ()) -> X ()
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (WNInput X -> X (Maybe (KeySym, Rectangle, Point))
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)) () (((KeySym, Rectangle, Point) -> X ()) -> X ())
-> ((KeySym, Rectangle, Point) -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \(KeySym
_, Rectangle
_, Point
pos) -> do
      IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ IORef (Map WorkspaceId Point) -> Map WorkspaceId Point -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Map WorkspaceId Point)
stateRef (Map WorkspaceId Point -> IO ()) -> Map WorkspaceId Point -> IO ()
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
_) =
  x (Maybe KeySym)
-> Maybe (KeySym, Rectangle, Point)
-> (KeySym -> x (Maybe (KeySym, Rectangle, Point)))
-> x (Maybe (KeySym, Rectangle, Point))
forall (x :: * -> *) a b.
Monad x =>
x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' (Maybe KeySym -> x (Maybe KeySym)
forall a. a -> x a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe KeySym -> x (Maybe KeySym))
-> Maybe KeySym -> x (Maybe KeySym)
forall a b. (a -> b) -> a -> b
$ WindowSet -> Maybe KeySym
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) Maybe (KeySym, Rectangle, Point)
forall a. Maybe a
Nothing ((KeySym -> x (Maybe (KeySym, Rectangle, Point)))
 -> x (Maybe (KeySym, Rectangle, Point)))
-> (KeySym -> x (Maybe (KeySym, Rectangle, Point)))
-> x (Maybe (KeySym, Rectangle, Point))
forall a b. (a -> b) -> a -> b
$ \KeySym
window -> do
    (Point
pos, Rectangle
rect) <- WNInput x -> x (Point, Rectangle)
forall (x :: * -> *). Monad x => WNInput x -> x (Point, Rectangle)
currentPosition WNInput x
input
    Maybe (KeySym, Rectangle, Point)
-> x (Maybe (KeySym, Rectangle, Point))
forall a. a -> x a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (KeySym, Rectangle, Point)
 -> x (Maybe (KeySym, Rectangle, Point)))
-> Maybe (KeySym, Rectangle, Point)
-> x (Maybe (KeySym, Rectangle, Point))
forall a b. (a -> b) -> a -> b
$ (KeySym, Rectangle, Point) -> Maybe (KeySym, Rectangle, Point)
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 <- Rectangle -> Maybe Rectangle -> Rectangle
forall a. a -> Maybe a -> a
fromMaybe (Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0) (Maybe Rectangle -> Rectangle)
-> x (Maybe Rectangle) -> x Rectangle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x (Maybe Rectangle)
-> WindowRectFn x -> Maybe KeySym -> x (Maybe Rectangle)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Rectangle -> x (Maybe Rectangle)
forall a. a -> x a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Rectangle
forall a. Maybe a
Nothing) WindowRectFn x
windowRect (WindowSet -> Maybe KeySym
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet)
  let posMaybe :: Maybe Point
posMaybe = WorkspaceId -> Map WorkspaceId Point -> Maybe Point
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (WindowSet -> WorkspaceId
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)
  (Point, Rectangle) -> x (Point, Rectangle)
forall a. a -> x a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point, Rectangle) -> x (Point, Rectangle))
-> (Point, Rectangle) -> x (Point, Rectangle)
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 =
  WorkspaceId
-> Point -> Map WorkspaceId Point -> Map WorkspaceId Point
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (WindowSet -> WorkspaceId
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
dim Position -> Position -> Position
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 <- (Rectangle -> DirRectangle)
-> [(KeySym, Rectangle)] -> [(KeySym, DirRectangle)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> Rectangle -> DirRectangle
rectTransform Direction2D
dir) ([(KeySym, Rectangle)] -> [(KeySym, DirRectangle)])
-> x [(KeySym, Rectangle)] -> x [(KeySym, DirRectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WNInput x -> x [(KeySym, Rectangle)]
forall (x :: * -> *).
Monad x =>
WNInput x -> x [(KeySym, Rectangle)]
windowRects WNInput x
input
  let
    screenWindows :: Set KeySym
screenWindows = [KeySym] -> Set KeySym
forall a. Ord a => [a] -> Set a
S.fromList ([KeySym] -> Set KeySym) -> [KeySym] -> Set KeySym
forall a b. (a -> b) -> a -> b
$ Maybe (Stack KeySym) -> [KeySym]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack KeySym) -> [KeySym])
-> Maybe (Stack KeySym) -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Workspace WorkspaceId (Layout KeySym) KeySym
-> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack (Workspace WorkspaceId (Layout KeySym) KeySym
 -> Maybe (Stack KeySym))
-> Workspace WorkspaceId (Layout KeySym) KeySym
-> Maybe (Stack KeySym)
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout KeySym) KeySym)
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout KeySym) KeySym
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
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) = ((KeySym, DirRectangle) -> Bool)
-> [(KeySym, DirRectangle)]
-> ([(KeySym, DirRectangle)], [(KeySym, DirRectangle)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(KeySym
w, DirRectangle
_) -> KeySym -> Set KeySym -> Bool
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 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p1 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr) Bool -> Bool -> Bool
&&
                   ((DirRectangle -> Position
rect_o1 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o1 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o2 DirRectangle
wr) Bool -> Bool -> Bool
||
                    (DirRectangle -> Position
rect_o1 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r Position -> Position -> Bool
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 = ((a, DirRectangle) -> Position)
-> [(a, DirRectangle)] -> [(a, DirRectangle)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (DirRectangle -> Position
rect_p2 (DirRectangle -> Position)
-> ((a, DirRectangle) -> DirRectangle)
-> (a, DirRectangle)
-> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DirRectangle) -> DirRectangle
forall a b. (a, b) -> b
snd)
    posBeforeEdge :: DirRectangle -> Bool
posBeforeEdge DirRectangle
r = DirPoint -> Position
point_p DirPoint
pos Position -> Position -> Bool
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 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_p2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_p2 DirRectangle
wr Bool -> Bool -> Bool
&&
                         DirRectangle -> Position
rect_o1 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r Position -> Position -> Bool
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 Position -> Position -> Bool
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 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> DirRectangle -> Position
rect_o1 DirRectangle
wr Bool -> Bool -> Bool
&& DirRectangle -> Position
rect_o2 DirRectangle
r Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
wr Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_o2 DirRectangle
r
    distanceToRectEdge :: DirRectangle -> Position
distanceToRectEdge DirRectangle
r = Position -> Position -> Position
forall a. Ord a => a -> a -> a
max (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
0 (DirRectangle -> Position
rect_o1 DirRectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos)) (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max Position
0 (DirPoint -> Position
point_o DirPoint
pos Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1 Position -> Position -> Position
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 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ DirRectangle -> Position
rect_o2 DirRectangle
r) Position -> Position -> Position
forall a. Integral a => a -> a -> a
`div` Position
2 Position -> Position -> Position
forall a. Num a => a -> a -> a
- DirPoint -> Position
point_o DirPoint
pos
      in if Position
distance Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
0
         then Position
distance Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1
         else Position
distance
    sortByPosDistance :: [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance = ((a, DirRectangle) -> (Position, Position, Position))
-> [(a, DirRectangle)] -> [(a, DirRectangle)]
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)) (DirRectangle -> (Position, Position, Position))
-> ((a, DirRectangle) -> DirRectangle)
-> (a, DirRectangle)
-> (Position, Position, Position)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, DirRectangle) -> DirRectangle
forall a b. (a, b) -> b
snd)

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

    rectAfterEdge :: DirRectangle -> Bool
rectAfterEdge DirRectangle
r = DirRectangle -> Position
rect_p1 DirRectangle
r Position -> Position -> Bool
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 Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< DirRectangle -> Position
rect_p2 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
>= DirRectangle -> Position
rect_o1 DirRectangle
r Bool -> Bool -> Bool
&& DirPoint -> Position
point_o DirPoint
pos Position -> Position -> Bool
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v1 = a
v1
                  | a
v a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
v2 = a
v2 a -> a -> a
forall a. Num a => a -> a -> a
- a
1
                  | Bool
otherwise = a
v
    dragPos :: DirRectangle -> DirPoint
dragPos DirRectangle
r = Position -> Position -> DirPoint
DirPoint (Position -> Position -> Position
forall a. Ord a => a -> a -> a
max (DirPoint -> Position
point_p DirPoint
pos) (DirRectangle -> Position
rect_p1 DirRectangle
r)) (Position -> Position -> Position -> Position
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))

  [(KeySym, Point)] -> x [(KeySym, Point)]
forall a. a -> x a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(KeySym, Point)] -> x [(KeySym, Point)])
-> [(KeySym, Point)] -> x [(KeySym, Point)]
forall a b. (a -> b) -> a -> b
$ (DirPoint -> Point) -> [(KeySym, DirPoint)] -> [(KeySym, Point)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (Direction2D -> DirPoint -> Point
inversePointTransform Direction2D
dir) ([(KeySym, DirPoint)] -> [(KeySym, Point)])
-> [(KeySym, DirPoint)] -> [(KeySym, Point)]
forall a b. (a -> b) -> a -> b
$ [[(KeySym, DirPoint)]] -> [(KeySym, DirPoint)]
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 ──┼─►            │    │
      -- └───────────┤              ├────┘
      --             └──────────────┘
      (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd DirRectangle -> Bool
posBeforeEdge ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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 │
      -- │              │                 │           │                             │                 │
      -- └──────────────┘                 └───────────┘                             └─────────────────┘
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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 │
      -- └───┤-----------├────────────────┘
      --     └───────────┘
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
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)) ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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  ──┼─►  │
      -- │  └─────────────┘    │
      -- └─────────────────────┘
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
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)) ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByLength ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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 │
      -- │              │  │                │
      -- │              │  └────────────────┘
      -- └──────────────┘
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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.
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd DirRectangle -> DirPoint
dragPos ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$ [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByPosDistance ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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.
    , (DirRectangle -> DirPoint)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall b b' a. (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd (\DirRectangle
r -> Position -> Position -> DirPoint
DirPoint (DirRectangle -> Position
rect_p2 DirRectangle
r Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1) (Position -> Position -> Position -> Position
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))) ([(KeySym, DirRectangle)] -> [(KeySym, DirPoint)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirPoint)]
forall a b. (a -> b) -> a -> b
$
      [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall {a}. [(a, DirRectangle)] -> [(a, DirRectangle)]
sortByP2 ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall b a. (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd (Bool -> Bool
not (Bool -> Bool) -> (DirRectangle -> Bool) -> DirRectangle -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirRectangle -> Bool
posBeforeEdge) ([(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)])
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
forall a b. (a -> b) -> a -> b
$ (DirRectangle -> Bool)
-> [(KeySym, DirRectangle)] -> [(KeySym, DirRectangle)]
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 = Position -> Dimension
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DirRectangle -> Position
rect_p2 DirRectangle
r Position -> Position -> Position
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 (Position -> Position
forall a. Num a => a -> a
negate Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1) Position
x
  Direction2D
L -> Position -> Position -> DirPoint
DirPoint (Position -> Position
forall a. Num a => a -> a
negate Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1) (Position -> Position
forall a. Num a => a -> a
negate Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
1)
  Direction2D
D -> Position -> Position -> DirPoint
DirPoint Position
y (Position -> Position
forall a. Num a => a -> a
negate Position
x Position -> Position -> Position
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) (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1)
  Direction2D
L -> Position -> Position -> Point
Point (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_p DirPoint
p Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1) (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1)
  Direction2D
D -> Position -> Position -> Point
Point (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ DirPoint -> Position
point_o DirPoint
p Position -> Position -> Position
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 (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (Position -> Position
forall a. Num a => a -> a
negate Position
y) Position
x (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w)
  Direction2D
L -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (Position -> Position
forall a. Num a => a -> a
negate Position
x) (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (Position -> Position
forall a. Num a => a -> a
negate Position
y)
  Direction2D
D -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
y (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
h) (Position -> Position
forall a. Num a => a -> a
negate (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$ Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) (Position -> Position
forall a. Num a => a -> a
negate Position
x)
  Direction2D
R -> Position -> Position -> Position -> Position -> DirRectangle
DirRectangle Position
x (Position
x Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
w) Position
y (Position
y Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Dimension -> Position
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 = (KeySym -> Bool) -> [KeySym] -> [KeySym]
forall a. (a -> Bool) -> [a] -> [a]
filter (\KeySym
w -> KeySym
w KeySym -> Maybe KeySym -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` WindowSet -> Maybe KeySym
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
oldWindowSet) ([KeySym] -> [KeySym]) -> [KeySym] -> [KeySym]
forall a b. (a -> b) -> a -> b
$ Set KeySym -> [KeySym]
forall a. Set a -> [a]
S.toList Set KeySym
mappedWindows
    windowRect2 :: KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 KeySym
w = (Rectangle -> (KeySym, Rectangle))
-> Maybe Rectangle -> Maybe (KeySym, Rectangle)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KeySym
w,) (Maybe Rectangle -> Maybe (KeySym, Rectangle))
-> x (Maybe Rectangle) -> x (Maybe (KeySym, Rectangle))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowRectFn x
windowRect KeySym
w
  in [Maybe (KeySym, Rectangle)] -> [(KeySym, Rectangle)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (KeySym, Rectangle)] -> [(KeySym, Rectangle)])
-> x [Maybe (KeySym, Rectangle)] -> x [(KeySym, Rectangle)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeySym -> x (Maybe (KeySym, Rectangle)))
-> [KeySym] -> x [Maybe (KeySym, Rectangle)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM KeySym -> x (Maybe (KeySym, Rectangle))
windowRect2 [KeySym]
allWindows

windowRectX :: Window -> X (Maybe Rectangle)
windowRectX :: KeySym -> X (Maybe Rectangle)
windowRectX KeySym
win = (Display -> X (Maybe Rectangle)) -> X (Maybe Rectangle)
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X (Maybe Rectangle)) -> X (Maybe Rectangle))
-> (Display -> X (Maybe Rectangle)) -> X (Maybe Rectangle)
forall a b. (a -> b) -> a -> b
$ \Display
dpy -> do
    (KeySym
_, Position
x, Position
y, Dimension
w, Dimension
h, Dimension
bw, CInt
_) <- IO
  (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO
   (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
 -> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
       CInt))
-> IO
     (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
-> X (KeySym, Position, Position, Dimension, Dimension, Dimension,
      CInt)
forall a b. (a -> b) -> a -> b
$ Display
-> KeySym
-> IO
     (KeySym, Position, Position, Dimension, Dimension, Dimension, CInt)
getGeometry Display
dpy KeySym
win
    Maybe Rectangle -> X (Maybe Rectangle)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Rectangle -> X (Maybe Rectangle))
-> Maybe Rectangle -> X (Maybe Rectangle)
forall a b. (a -> b) -> a -> b
$ Rectangle -> Maybe Rectangle
forall a. a -> Maybe a
Just (Rectangle -> Maybe Rectangle) -> Rectangle -> Maybe Rectangle
forall a b. (a -> b) -> a -> b
$ Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
x Position
y (Dimension
w Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
bw) (Dimension
h Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
+ Dimension
2 Dimension -> Dimension -> Dimension
forall a. Num a => a -> a -> a
* Dimension
bw)
    X (Maybe Rectangle) -> X (Maybe Rectangle) -> X (Maybe Rectangle)
forall a. X a -> X a -> X a
`catchX` Maybe Rectangle -> X (Maybe Rectangle)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Rectangle
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 -> b -> x b
forall a. a -> x a
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 = ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (b -> Bool
f (b -> Bool) -> ((a, b) -> b) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> b
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 = ((a, b) -> (a, b')) -> [(a, b)] -> [(a, b')]
forall a b. (a -> b) -> [a] -> [b]
map ((b -> b') -> (a, b) -> (a, b')
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second b -> b'
f)