{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.PhysicalScreens
-- Description  : Manipulate screens ordered by physical location instead of ID.
-- Copyright    : (c) Nelson Elhage <nelhage@mit.edu>
-- License      : BSD
--
-- Maintainer   : Nelson Elhage <nelhage@mit.edu>
-- Stability    : unstable
-- Portability  : unportable
--
-- Manipulate screens ordered by physical location instead of ID
-----------------------------------------------------------------------------

module XMonad.Actions.PhysicalScreens (
                                        -- * Usage
                                        -- $usage
                                        PhysicalScreen(..)
                                      , getScreen
                                      , viewScreen
                                      , sendToScreen
                                      , onNextNeighbour
                                      , onPrevNeighbour
                                      , horizontalScreenOrderer
                                      , verticalScreenOrderer
                                      , ScreenComparator(ScreenComparator)
                                      , getScreenIdAndRectangle
                                      , screenComparatorById
                                      , screenComparatorByRectangle
                                      , rescreen
                                      ) where

import Data.List.NonEmpty (nonEmpty)
import XMonad hiding (rescreen)
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import qualified XMonad.StackSet as W

{- $usage

This module allows you name Xinerama screens from XMonad using their
physical location relative to each other (as reported by Xinerama),
rather than their @ScreenID@ s, which are arbitrarily determined by
your X server and graphics hardware.

You can specify how to order the screen by giving a ScreenComparator.
To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
and then left-to-right.

Example usage in your @xmonad.hs@ file:

> import XMonad.Actions.PhysicalScreens
> import Data.Default

> , ((modMask, xK_a), onPrevNeighbour def W.view)
> , ((modMask, xK_o), onNextNeighbour def W.view)
> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)

> --
> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
> -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
> --
> [((modm .|. mask, key), f sc)
>     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]

For detailed instructions on editing your key bindings, see
<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
 -}

-- | The type of the index of a screen by location
newtype PhysicalScreen = P Int deriving (PhysicalScreen -> PhysicalScreen -> Bool
(PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool) -> Eq PhysicalScreen
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PhysicalScreen -> PhysicalScreen -> Bool
== :: PhysicalScreen -> PhysicalScreen -> Bool
$c/= :: PhysicalScreen -> PhysicalScreen -> Bool
/= :: PhysicalScreen -> PhysicalScreen -> Bool
Eq,Eq PhysicalScreen
Eq PhysicalScreen =>
(PhysicalScreen -> PhysicalScreen -> Ordering)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> Bool)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> Ord PhysicalScreen
PhysicalScreen -> PhysicalScreen -> Bool
PhysicalScreen -> PhysicalScreen -> Ordering
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PhysicalScreen -> PhysicalScreen -> Ordering
compare :: PhysicalScreen -> PhysicalScreen -> Ordering
$c< :: PhysicalScreen -> PhysicalScreen -> Bool
< :: PhysicalScreen -> PhysicalScreen -> Bool
$c<= :: PhysicalScreen -> PhysicalScreen -> Bool
<= :: PhysicalScreen -> PhysicalScreen -> Bool
$c> :: PhysicalScreen -> PhysicalScreen -> Bool
> :: PhysicalScreen -> PhysicalScreen -> Bool
$c>= :: PhysicalScreen -> PhysicalScreen -> Bool
>= :: PhysicalScreen -> PhysicalScreen -> Bool
$cmax :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
max :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmin :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
min :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
Ord,Int -> PhysicalScreen -> ShowS
[PhysicalScreen] -> ShowS
PhysicalScreen -> WorkspaceId
(Int -> PhysicalScreen -> ShowS)
-> (PhysicalScreen -> WorkspaceId)
-> ([PhysicalScreen] -> ShowS)
-> Show PhysicalScreen
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PhysicalScreen -> ShowS
showsPrec :: Int -> PhysicalScreen -> ShowS
$cshow :: PhysicalScreen -> WorkspaceId
show :: PhysicalScreen -> WorkspaceId
$cshowList :: [PhysicalScreen] -> ShowS
showList :: [PhysicalScreen] -> ShowS
Show,ReadPrec [PhysicalScreen]
ReadPrec PhysicalScreen
Int -> ReadS PhysicalScreen
ReadS [PhysicalScreen]
(Int -> ReadS PhysicalScreen)
-> ReadS [PhysicalScreen]
-> ReadPrec PhysicalScreen
-> ReadPrec [PhysicalScreen]
-> Read PhysicalScreen
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PhysicalScreen
readsPrec :: Int -> ReadS PhysicalScreen
$creadList :: ReadS [PhysicalScreen]
readList :: ReadS [PhysicalScreen]
$creadPrec :: ReadPrec PhysicalScreen
readPrec :: ReadPrec PhysicalScreen
$creadListPrec :: ReadPrec [PhysicalScreen]
readListPrec :: ReadPrec [PhysicalScreen]
Read,Int -> PhysicalScreen
PhysicalScreen -> Int
PhysicalScreen -> [PhysicalScreen]
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
(PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (Int -> PhysicalScreen)
-> (PhysicalScreen -> Int)
-> (PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> (PhysicalScreen
    -> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen])
-> Enum PhysicalScreen
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PhysicalScreen -> PhysicalScreen
succ :: PhysicalScreen -> PhysicalScreen
$cpred :: PhysicalScreen -> PhysicalScreen
pred :: PhysicalScreen -> PhysicalScreen
$ctoEnum :: Int -> PhysicalScreen
toEnum :: Int -> PhysicalScreen
$cfromEnum :: PhysicalScreen -> Int
fromEnum :: PhysicalScreen -> Int
$cenumFrom :: PhysicalScreen -> [PhysicalScreen]
enumFrom :: PhysicalScreen -> [PhysicalScreen]
$cenumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromThenTo :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromThenTo :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
Enum,Integer -> PhysicalScreen
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
(PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen)
-> (Integer -> PhysicalScreen)
-> Num PhysicalScreen
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cnegate :: PhysicalScreen -> PhysicalScreen
negate :: PhysicalScreen -> PhysicalScreen
$cabs :: PhysicalScreen -> PhysicalScreen
abs :: PhysicalScreen -> PhysicalScreen
$csignum :: PhysicalScreen -> PhysicalScreen
signum :: PhysicalScreen -> PhysicalScreen
$cfromInteger :: Integer -> PhysicalScreen
fromInteger :: Integer -> PhysicalScreen
Num,Enum PhysicalScreen
Real PhysicalScreen
(Real PhysicalScreen, Enum PhysicalScreen) =>
(PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen -> PhysicalScreen -> PhysicalScreen)
-> (PhysicalScreen
    -> PhysicalScreen -> (PhysicalScreen, PhysicalScreen))
-> (PhysicalScreen
    -> PhysicalScreen -> (PhysicalScreen, PhysicalScreen))
-> (PhysicalScreen -> Integer)
-> Integral PhysicalScreen
PhysicalScreen -> Integer
PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
quot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$crem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
rem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cdiv :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
div :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
mod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cquotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
quotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$cdivMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
divMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$ctoInteger :: PhysicalScreen -> Integer
toInteger :: PhysicalScreen -> Integer
Integral,Num PhysicalScreen
Ord PhysicalScreen
(Num PhysicalScreen, Ord PhysicalScreen) =>
(PhysicalScreen -> Rational) -> Real PhysicalScreen
PhysicalScreen -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: PhysicalScreen -> Rational
toRational :: PhysicalScreen -> Rational
Real)

getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle :: forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle Screen i l a ScreenId ScreenDetail
screen = (Screen i l a ScreenId ScreenDetail -> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen i l a ScreenId ScreenDetail
screen, Rectangle
rect) where
  rect :: Rectangle
rect = ScreenDetail -> Rectangle
screenRect (ScreenDetail -> Rectangle) -> ScreenDetail -> Rectangle
forall a b. (a -> b) -> a -> b
$ Screen i l a ScreenId ScreenDetail -> ScreenDetail
forall i l a sid sd. Screen i l a sid sd -> sd
W.screenDetail Screen i l a ScreenId ScreenDetail
screen

-- | Translate a physical screen index to a 'ScreenId'
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen :: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen) (P Int
i) = do w <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
                                                  let screens = WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
                                                  if i<0 || i >= length screens
                                                    then return Nothing
                                                    else let ss = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Ordering)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> (ScreenId, Rectangle))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens
                                                    in return $ Just $ W.screen $ ss !! i

-- | Switch to a given physical screen
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen ScreenComparator
sc PhysicalScreen
p = do i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                     whenJust i $ \ScreenId
s -> do
                         w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         whenJust w $ windows . W.view

-- | Send the active window to a given physical screen
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen ScreenComparator
sc PhysicalScreen
p = do i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                       whenJust i $ \ScreenId
s -> do
                         w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         whenJust w $ windows . W.shift

-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)

-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
instance Default ScreenComparator where
  def :: ScreenComparator
def= ScreenComparator
verticalScreenOrderer

-- | Compare screen only by their coordonate
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
rectComparator = ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> ScreenComparator
ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
forall {a} {a}. (a, Rectangle) -> (a, Rectangle) -> Ordering
comparator where
  comparator :: (a, Rectangle) -> (a, Rectangle) -> Ordering
comparator (a
_, Rectangle
rec1) (a
_, Rectangle
rec2) = Rectangle -> Rectangle -> Ordering
rectComparator Rectangle
rec1 Rectangle
rec2

-- | Compare screen only by their Xinerama id
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById ScreenId -> ScreenId -> Ordering
idComparator = ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> ScreenComparator
ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
forall {b} {b}. (ScreenId, b) -> (ScreenId, b) -> Ordering
comparator where
  comparator :: (ScreenId, b) -> (ScreenId, b) -> Ordering
comparator (ScreenId
id1, b
_) (ScreenId
id2, b
_) = ScreenId -> ScreenId -> Ordering
idComparator ScreenId
id1 ScreenId
id2

-- | orders screens by the upper-left-most corner, from top-to-bottom
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer :: ScreenComparator
verticalScreenOrderer = (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
comparator where
    comparator :: Rectangle -> Rectangle -> Ordering
comparator (Rectangle Position
x1 Position
y1 Dimension
_ Dimension
_) (Rectangle Position
x2 Position
y2 Dimension
_ Dimension
_) = (Position, Position) -> (Position, Position) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position
y1, Position
x1) (Position
y2, Position
x2)

-- | orders screens by the upper-left-most corner, from left-to-right
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer :: ScreenComparator
horizontalScreenOrderer = (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
screenComparatorByRectangle Rectangle -> Rectangle -> Ordering
comparator where
    comparator :: Rectangle -> Rectangle -> Ordering
comparator (Rectangle Position
x1 Position
y1 Dimension
_ Dimension
_) (Rectangle Position
x2 Position
y2 Dimension
_ Dimension
_) = (Position, Position) -> (Position, Position) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position
x1, Position
y1) (Position
x2, Position
y2)

-- | Get ScreenId for neighbours of the current screen based on position offset.
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen) Int
d =
  do w <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
     let ss = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [ScreenId])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [ScreenId]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Ordering)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> (ScreenId, Rectangle))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
         curPos = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ScreenId -> [ScreenId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w)) [ScreenId]
ss
         pos = (Int
curPos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [ScreenId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScreenId]
ss
     return $ ss !! pos

neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows :: ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc Int
d WorkspaceId -> WindowSet -> WindowSet
f = do s <- ScreenComparator -> Int -> X ScreenId
getNeighbour ScreenComparator
sc Int
d
                             w <- screenWorkspace s
                             whenJust w $ windows . f

-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onNextNeighbour ScreenComparator
sc = ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc Int
1

-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
onPrevNeighbour ScreenComparator
sc = ScreenComparator
-> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
neighbourWindows ScreenComparator
sc (-Int
1)

-- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling
-- the workspaces if the number of screens doesn't change and only their
-- locations do. Useful for users of @xrandr --setmonitor@.
--
-- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you
-- replace the builtin rescreen handler.
rescreen :: ScreenComparator -> X ()
rescreen :: ScreenComparator -> X ()
rescreen (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen) = (Display -> X (Maybe (NonEmpty Rectangle)))
-> X (Maybe (NonEmpty Rectangle))
forall a. (Display -> X a) -> X a
withDisplay (([Rectangle] -> Maybe (NonEmpty Rectangle))
-> X [Rectangle] -> X (Maybe (NonEmpty Rectangle))
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rectangle] -> Maybe (NonEmpty Rectangle)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (X [Rectangle] -> X (Maybe (NonEmpty Rectangle)))
-> (Display -> X [Rectangle])
-> Display
-> X (Maybe (NonEmpty Rectangle))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Display -> X [Rectangle]
forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo) X (Maybe (NonEmpty Rectangle))
-> (Maybe (NonEmpty Rectangle) -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (NonEmpty Rectangle)
Nothing -> WorkspaceId -> X ()
forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace WorkspaceId
"getCleanedScreenInfo returned []"
    Just NonEmpty Rectangle
xinescs -> (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ NonEmpty Rectangle -> WindowSet -> WindowSet
rescreen' NonEmpty Rectangle
xinescs
  where
    rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet
rescreen' NonEmpty Rectangle
xinescs WindowSet
ws
      | NonEmpty Rectangle -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty Rectangle
xinescs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = NonEmpty Rectangle -> WindowSet -> WindowSet
rescreenSameLength NonEmpty Rectangle
xinescs WindowSet
ws
      | Bool
otherwise = NonEmpty Rectangle -> WindowSet -> WindowSet
rescreenCore NonEmpty Rectangle
xinescs WindowSet
ws

    -- the 'XMonad.Operations.rescreen' implementation from core as a fallback
    rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet
rescreenCore (Rectangle
xinesc :| [Rectangle]
xinescs) ws :: WindowSet
ws@W.StackSet{ current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
v, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vs, hidden :: forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden = [Workspace WorkspaceId (Layout Window) Window]
hs } =
        let ([Workspace WorkspaceId (Layout Window) Window]
xs, [Workspace WorkspaceId (Layout Window) Window]
ys) = Int
-> [Workspace WorkspaceId (Layout Window) Window]
-> ([Workspace WorkspaceId (Layout Window) Window],
    [Workspace WorkspaceId (Layout Window) Window])
forall a. Int -> [a] -> ([a], [a])
splitAt ([Rectangle] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rectangle]
xinescs) ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Workspace WorkspaceId (Layout Window) Window)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vs [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
-> [Workspace WorkspaceId (Layout Window) Window]
forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Window) Window]
hs)
            a :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
a = Workspace WorkspaceId (Layout Window) Window
-> ScreenId
-> ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
v) ScreenId
0 (Rectangle -> ScreenDetail
SD Rectangle
xinesc)
            as :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
as = (Workspace WorkspaceId (Layout Window) Window
 -> ScreenId
 -> ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> [Workspace WorkspaceId (Layout Window) Window]
-> [ScreenId]
-> [ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 Workspace WorkspaceId (Layout Window) Window
-> ScreenId
-> ScreenDetail
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen [Workspace WorkspaceId (Layout Window) Window]
xs [ScreenId
1..] ([ScreenDetail]
 -> [Screen
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> [ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ (Rectangle -> ScreenDetail) -> [Rectangle] -> [ScreenDetail]
forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
xinescs
        in  WindowSet
ws{ W.current = a
              , W.visible = as
              , W.hidden  = ys }

    -- sort both existing screens and the screens we just got from xinerama
    -- using cmpScreen, and then replace the rectangles in the WindowSet,
    -- keeping the order of current/visible workspaces intact
    rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet
    rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet
rescreenSameLength NonEmpty Rectangle
xinescs WindowSet
ws =
        WindowSet
ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect }
          , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ]
          }
      where
        undoSort :: NonEmpty Int
undoSort =
            ((Int,
  Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Int)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty Int
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int,
 Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Int
forall a b. (a, b) -> a
fst (NonEmpty
   (Int,
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> NonEmpty Int)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty Int
forall a b. (a -> b) -> a -> b
$
            ((Int,
  Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> (Int,
     Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Ordering)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> ((Int,
     Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> (ScreenId, Rectangle))
-> (Int,
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (Int,
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> (ScreenId, Rectangle))
-> ((Int,
     Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
    -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (Int,
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (ScreenId, Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int,
 Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a b. (a, b) -> b
snd)) (NonEmpty
   (Int,
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> NonEmpty
      (Int,
       Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$
            NonEmpty Int
-> NonEmpty
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip ((Int
0 :: Int) Int -> [Int] -> NonEmpty Int
forall a. a -> [a] -> NonEmpty a
:| [Int
1..]) (NonEmpty
   (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> NonEmpty
      (Int,
       Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> NonEmpty
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> NonEmpty
     (Int,
      Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a b. (a -> b) -> a -> b
$ -- add indices to undo the sort later
            WindowSet
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> NonEmpty
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. a -> [a] -> NonEmpty a
:| WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws
        Rectangle
newCurrentRect :| [Rectangle]
newVisibleRects =
            ((Int, Rectangle) -> Rectangle)
-> NonEmpty (Int, Rectangle) -> NonEmpty Rectangle
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (Int, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd (NonEmpty (Int, Rectangle) -> NonEmpty Rectangle)
-> NonEmpty (Int, Rectangle) -> NonEmpty Rectangle
forall a b. (a -> b) -> a -> b
$ ((Int, Rectangle) -> Int)
-> NonEmpty (Int, Rectangle) -> NonEmpty (Int, Rectangle)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith (Int, Rectangle) -> Int
forall a b. (a, b) -> a
fst (NonEmpty (Int, Rectangle) -> NonEmpty (Int, Rectangle))
-> NonEmpty (Int, Rectangle) -> NonEmpty (Int, Rectangle)
forall a b. (a -> b) -> a -> b
$ NonEmpty Int -> NonEmpty Rectangle -> NonEmpty (Int, Rectangle)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty Int
undoSort (NonEmpty Rectangle -> NonEmpty (Int, Rectangle))
-> NonEmpty Rectangle -> NonEmpty (Int, Rectangle)
forall a b. (a -> b) -> a -> b
$ -- sort back into current:visible order
            ((ScreenId, Rectangle) -> Rectangle)
-> NonEmpty (ScreenId, Rectangle) -> NonEmpty Rectangle
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (ScreenId, Rectangle) -> Rectangle
forall a b. (a, b) -> b
snd (NonEmpty (ScreenId, Rectangle) -> NonEmpty Rectangle)
-> NonEmpty (ScreenId, Rectangle) -> NonEmpty Rectangle
forall a b. (a -> b) -> a -> b
$ ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> NonEmpty (ScreenId, Rectangle) -> NonEmpty (ScreenId, Rectangle)
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen (NonEmpty (ScreenId, Rectangle) -> NonEmpty (ScreenId, Rectangle))
-> NonEmpty (ScreenId, Rectangle) -> NonEmpty (ScreenId, Rectangle)
forall a b. (a -> b) -> a -> b
$ NonEmpty ScreenId
-> NonEmpty Rectangle -> NonEmpty (ScreenId, Rectangle)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip (ScreenId
0 ScreenId -> [ScreenId] -> NonEmpty ScreenId
forall a. a -> [a] -> NonEmpty a
:| [ScreenId
1..]) NonEmpty Rectangle
xinescs

    -- TODO:
    -- If number of screens before and after isn't the same, we might still
    -- try to match locations and avoid changing the workspace for those that
    -- didn't move, while making sure that the current workspace is still
    -- visible somewhere.