{-# 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PhysicalScreen -> PhysicalScreen -> Bool
$c/= :: PhysicalScreen -> PhysicalScreen -> Bool
== :: PhysicalScreen -> PhysicalScreen -> Bool
$c== :: PhysicalScreen -> PhysicalScreen -> Bool
Eq,Eq 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
min :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmin :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
max :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmax :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
>= :: PhysicalScreen -> PhysicalScreen -> Bool
$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
compare :: PhysicalScreen -> PhysicalScreen -> Ordering
$ccompare :: PhysicalScreen -> PhysicalScreen -> Ordering
Ord,Int -> PhysicalScreen -> ShowS
[PhysicalScreen] -> ShowS
PhysicalScreen -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [PhysicalScreen] -> ShowS
$cshowList :: [PhysicalScreen] -> ShowS
show :: PhysicalScreen -> WorkspaceId
$cshow :: PhysicalScreen -> WorkspaceId
showsPrec :: Int -> PhysicalScreen -> ShowS
$cshowsPrec :: Int -> PhysicalScreen -> ShowS
Show,ReadPrec [PhysicalScreen]
ReadPrec PhysicalScreen
Int -> ReadS PhysicalScreen
ReadS [PhysicalScreen]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PhysicalScreen]
$creadListPrec :: ReadPrec [PhysicalScreen]
readPrec :: ReadPrec PhysicalScreen
$creadPrec :: ReadPrec PhysicalScreen
readList :: ReadS [PhysicalScreen]
$creadList :: ReadS [PhysicalScreen]
readsPrec :: Int -> ReadS PhysicalScreen
$creadsPrec :: Int -> ReadS PhysicalScreen
Read,Int -> PhysicalScreen
PhysicalScreen -> Int
PhysicalScreen -> [PhysicalScreen]
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [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
enumFromThenTo :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromThenTo :: PhysicalScreen
-> PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromTo :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
$cenumFromThen :: PhysicalScreen -> PhysicalScreen -> [PhysicalScreen]
enumFrom :: PhysicalScreen -> [PhysicalScreen]
$cenumFrom :: PhysicalScreen -> [PhysicalScreen]
fromEnum :: PhysicalScreen -> Int
$cfromEnum :: PhysicalScreen -> Int
toEnum :: Int -> PhysicalScreen
$ctoEnum :: Int -> PhysicalScreen
pred :: PhysicalScreen -> PhysicalScreen
$cpred :: PhysicalScreen -> PhysicalScreen
succ :: PhysicalScreen -> PhysicalScreen
$csucc :: PhysicalScreen -> PhysicalScreen
Enum,Integer -> PhysicalScreen
PhysicalScreen -> PhysicalScreen
PhysicalScreen -> PhysicalScreen -> PhysicalScreen
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PhysicalScreen
$cfromInteger :: Integer -> PhysicalScreen
signum :: PhysicalScreen -> PhysicalScreen
$csignum :: PhysicalScreen -> PhysicalScreen
abs :: PhysicalScreen -> PhysicalScreen
$cabs :: PhysicalScreen -> PhysicalScreen
negate :: PhysicalScreen -> PhysicalScreen
$cnegate :: PhysicalScreen -> PhysicalScreen
* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c* :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c- :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$c+ :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
Num,Enum PhysicalScreen
Real 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
toInteger :: PhysicalScreen -> Integer
$ctoInteger :: PhysicalScreen -> Integer
divMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$cdivMod :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
quotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
$cquotRem :: PhysicalScreen
-> PhysicalScreen -> (PhysicalScreen, PhysicalScreen)
mod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cmod :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
div :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cdiv :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
rem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$crem :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
quot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
$cquot :: PhysicalScreen -> PhysicalScreen -> PhysicalScreen
Integral,Num PhysicalScreen
Ord PhysicalScreen
PhysicalScreen -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: PhysicalScreen -> Rational
$ctoRational :: 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 = (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 forall a b. (a -> b) -> a -> b
$ 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 WindowSet
w <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
                                                  let screens :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
                                                  if Int
iforall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| Int
i forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens
                                                    then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                                                    else let ss :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
ss = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
screens
                                                    in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
ss forall a. [a] -> Int -> a
!! Int
i

-- | Switch to a given physical screen
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
viewScreen ScreenComparator
sc PhysicalScreen
p = do Maybe ScreenId
i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                     forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ScreenId
i forall a b. (a -> b) -> a -> b
$ \ScreenId
s -> do
                         Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view

-- | Send the active window to a given physical screen
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
sendToScreen ScreenComparator
sc PhysicalScreen
p = do Maybe ScreenId
i <- ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen ScreenComparator
sc PhysicalScreen
p
                       forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe ScreenId
i forall a b. (a -> b) -> a -> b
$ \ScreenId
s -> do
                         Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                         forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift

-- | 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 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 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
_) = 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
_) = 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 WindowSet
w <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
     let ss :: [ScreenId]
ss = forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
w forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
w
         curPos :: Int
curPos = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (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
pos = (Int
curPos forall a. Num a => a -> a -> a
+ Int
d) forall a. Integral a => a -> a -> a
`mod` forall (t :: * -> *) a. Foldable t => t a -> Int
length [ScreenId]
ss
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ScreenId]
ss forall a. [a] -> Int -> a
!! Int
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 ScreenId
s <- ScreenComparator -> Int -> X ScreenId
getNeighbour ScreenComparator
sc Int
d
                             Maybe WorkspaceId
w <- ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
s
                             forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WorkspaceId
w forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> WindowSet -> WindowSet
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) = forall a. (Display -> X a) -> X a
withDisplay (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> Maybe (NonEmpty a)
nonEmpty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (NonEmpty Rectangle)
Nothing -> forall (m :: * -> *). MonadIO m => WorkspaceId -> m ()
trace WorkspaceId
"getCleanedScreenInfo returned []"
    Just NonEmpty Rectangle
xinescs -> (WindowSet -> WindowSet) -> X ()
windows 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
      | forall a. NonEmpty a -> Int
NE.length NonEmpty Rectangle
xinescs forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws) 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) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Rectangle]
xinescs) (forall a b. (a -> b) -> [a] -> [b]
map forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vs forall a. [a] -> [a] -> [a]
++ [Workspace WorkspaceId (Layout Window) Window]
hs)
            a :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
a = forall i l a sid sd.
Workspace i l a -> sid -> sd -> Screen i l a sid sd
W.Screen (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 = forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 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..] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Rectangle -> ScreenDetail
SD [Rectangle]
xinescs
        in  WindowSet
ws{ current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
W.current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
a
              , visible :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
W.visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
as
              , hidden :: [Workspace WorkspaceId (Layout Window) Window]
W.hidden  = [Workspace WorkspaceId (Layout Window) Window]
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{ current :: Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
W.current = (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws){ screenDetail :: ScreenDetail
W.screenDetail = Rectangle -> ScreenDetail
SD Rectangle
newCurrentRect }
          , visible :: [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
W.visible = [ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
w{ screenDetail :: ScreenDetail
W.screenDetail = Rectangle -> ScreenDetail
SD Rectangle
r } | Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
w <- forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws | Rectangle
r <- [Rectangle]
newVisibleRects ]
          }
      where
        undoSort :: NonEmpty Int
undoSort =
            forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
            forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)) forall a b. (a -> b) -> a -> b
$
            forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip ((Int
0 :: Int) forall a. a -> [a] -> NonEmpty a
:| [Int
1..]) forall a b. (a -> b) -> a -> b
$ -- add indices to undo the sort later
            forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws forall a. a -> [a] -> NonEmpty a
:| 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 =
            forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty Int
undoSort forall a b. (a -> b) -> a -> b
$ -- sort back into current:visible order
            forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
cmpScreen forall a b. (a -> b) -> a -> b
$ forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip (ScreenId
0 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.