{-# LANGUAGE LambdaCase #-}
module XMonad.Layout.IndependentScreens (
VirtualWorkspace, PhysicalWorkspace,
VirtualWindowSpace, PhysicalWindowSpace,
workspaces',
withScreen, withScreens,
onCurrentScreen,
marshallPP,
whenCurrentOn,
countScreens,
workspacesOn,
workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen,
marshall, unmarshall, unmarshallS, unmarshallW,
marshallWindowSpace, unmarshallWindowSpace, marshallSort,
) where
import Control.Arrow ((***))
import Graphics.X11.Xinerama
import XMonad
import XMonad.Hooks.StatusBar.PP
import XMonad.Prelude
import qualified XMonad.StackSet as W
type VirtualWorkspace = WorkspaceId
type PhysicalWorkspace = WorkspaceId
type PhysicalWindowSpace = WindowSpace
type VirtualWindowSpace = WindowSpace
marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace
marshall :: ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall (S Int
sc) PhysicalWorkspace
vws = forall a. Show a => a -> PhysicalWorkspace
show Int
sc forall a. [a] -> [a] -> [a]
++ Char
'_'forall a. a -> [a] -> [a]
:PhysicalWorkspace
vws
unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)
unmarshallS :: PhysicalWorkspace -> ScreenId
unmarshallW :: PhysicalWorkspace -> VirtualWorkspace
unmarshall :: PhysicalWorkspace -> (ScreenId, PhysicalWorkspace)
unmarshall = ((Int -> ScreenId
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => PhysicalWorkspace -> a
read) forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a. Int -> [a] -> [a]
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
'_')
unmarshallS :: PhysicalWorkspace -> ScreenId
unmarshallS = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> (ScreenId, PhysicalWorkspace)
unmarshall
unmarshallW :: PhysicalWorkspace -> PhysicalWorkspace
unmarshallW = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> (ScreenId, PhysicalWorkspace)
unmarshall
workspaces' :: XConfig l -> [VirtualWorkspace]
workspaces' :: forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces' = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map PhysicalWorkspace -> PhysicalWorkspace
unmarshallW forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces
withScreen :: ScreenId
-> [VirtualWorkspace]
-> [PhysicalWorkspace]
withScreen :: ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
withScreen ScreenId
n = forall a b. (a -> b) -> [a] -> [b]
map (ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
n)
withScreens :: ScreenId
-> [VirtualWorkspace]
-> [PhysicalWorkspace]
withScreens :: ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
withScreens ScreenId
n [PhysicalWorkspace]
vws = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
`withScreen` [PhysicalWorkspace]
vws) [ScreenId
0..ScreenId
nforall a. Num a => a -> a -> a
-ScreenId
1]
onCurrentScreen :: (PhysicalWorkspace -> WindowSet -> a) -> (VirtualWorkspace -> WindowSet -> a)
onCurrentScreen :: forall a.
(PhysicalWorkspace -> WindowSet -> a)
-> PhysicalWorkspace -> WindowSet -> a
onCurrentScreen PhysicalWorkspace -> WindowSet -> a
f PhysicalWorkspace
vws WindowSet
ws =
let currentScreenId :: ScreenId
currentScreenId = forall i l a sid sd. Screen i l a sid sd -> sid
W.screen 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
ws
in PhysicalWorkspace -> WindowSet -> a
f (ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
currentScreenId PhysicalWorkspace
vws) WindowSet
ws
workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace
workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace
workspaceOnScreen ScreenId
screenId WindowSet
ws = forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenId
-> WindowSet
-> Maybe
(Screen
PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail)
screenOnMonitor ScreenId
screenId WindowSet
ws
withWspOnScreen :: ScreenId
-> (PhysicalWorkspace -> WindowSet -> WindowSet)
-> WindowSet -> WindowSet
withWspOnScreen :: ScreenId
-> (PhysicalWorkspace -> WindowSet -> WindowSet)
-> WindowSet
-> WindowSet
withWspOnScreen ScreenId
screenId PhysicalWorkspace -> WindowSet -> WindowSet
operation WindowSet
ws = case ScreenId -> WindowSet -> Maybe PhysicalWorkspace
workspaceOnScreen ScreenId
screenId WindowSet
ws of
Just PhysicalWorkspace
wsp -> PhysicalWorkspace -> WindowSet -> WindowSet
operation PhysicalWorkspace
wsp WindowSet
ws
Maybe PhysicalWorkspace
Nothing -> WindowSet
ws
screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen
screenOnMonitor :: ScreenId
-> WindowSet
-> Maybe
(Screen
PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail)
screenOnMonitor ScreenId
screenId WindowSet
ws = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScreenId
screenId forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
ws 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
ws)
focusWindow' :: Window -> WindowSet -> WindowSet
focusWindow' :: Window -> WindowSet -> WindowSet
focusWindow' Window
window WindowSet
ws
| forall a. a -> Maybe a
Just Window
window forall a. Eq a => a -> a -> Bool
== forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws = WindowSet
ws
| Bool
otherwise = case forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
window WindowSet
ws of
Just PhysicalWorkspace
tag -> forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.focusWindow Window
window forall a b. (a -> b) -> a -> b
$ ScreenId -> WindowSet -> WindowSet
focusScreen (PhysicalWorkspace -> ScreenId
unmarshallS PhysicalWorkspace
tag) WindowSet
ws
Maybe PhysicalWorkspace
Nothing -> WindowSet
ws
focusScreen :: ScreenId -> WindowSet -> WindowSet
focusScreen :: ScreenId -> WindowSet -> WindowSet
focusScreen ScreenId
screenId = ScreenId
-> (PhysicalWorkspace -> WindowSet -> WindowSet)
-> WindowSet
-> WindowSet
withWspOnScreen ScreenId
screenId 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
nthWorkspace :: Int -> X (Maybe VirtualWorkspace)
nthWorkspace :: Int -> X (Maybe PhysicalWorkspace)
nthWorkspace Int
n = (forall a. [a] -> Int -> Maybe a
!? Int
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> XConfig Layout
config
countScreens :: (MonadIO m, Integral i) => m i
countScreens :: forall (m :: * -> *) i. (MonadIO m, Integral i) => m i
countScreens = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall i a. Num i => [a] -> i
genericLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PhysicalWorkspace -> IO Display
openDisplay PhysicalWorkspace
"" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) Display -> IO [Rectangle]
getScreenInfo Display -> IO ()
closeDisplay
marshallPP :: ScreenId -> PP -> PP
marshallPP :: ScreenId -> PP -> PP
marshallPP ScreenId
s PP
pp = PP
pp { ppRename :: PhysicalWorkspace -> WindowSpace -> PhysicalWorkspace
ppRename = PP -> PhysicalWorkspace -> WindowSpace -> PhysicalWorkspace
ppRename PP
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> PhysicalWorkspace
unmarshallW
, ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = (forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId -> [WindowSpace] -> [WindowSpace]
workspacesOn ScreenId
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp }
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn ScreenId
s PP
pp = PP
pp
{ ppSort :: X ([WindowSpace] -> [WindowSpace])
ppSort = do
[WindowSpace] -> [WindowSpace]
sorter <- PP -> X ([WindowSpace] -> [WindowSpace])
ppSort PP
pp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \case xs :: [WindowSpace]
xs@(WindowSpace
x:[WindowSpace]
_) | PhysicalWorkspace -> ScreenId
unmarshallS (forall i l a. Workspace i l a -> i
W.tag WindowSpace
x) forall a. Eq a => a -> a -> Bool
== ScreenId
s -> [WindowSpace] -> [WindowSpace]
sorter [WindowSpace]
xs
[WindowSpace]
_ -> []
, ppOrder :: [PhysicalWorkspace] -> [PhysicalWorkspace]
ppOrder = \case (PhysicalWorkspace
"":[PhysicalWorkspace]
_) -> [PhysicalWorkspace
"\0"]
[PhysicalWorkspace]
list -> PP -> [PhysicalWorkspace] -> [PhysicalWorkspace]
ppOrder PP
pp [PhysicalWorkspace]
list
, ppOutput :: PhysicalWorkspace -> IO ()
ppOutput = \case PhysicalWorkspace
"\0" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
PhysicalWorkspace
output -> PP -> PhysicalWorkspace -> IO ()
ppOutput PP
pp PhysicalWorkspace
output
}
workspacesOn :: ScreenId -> [PhysicalWindowSpace] -> [PhysicalWindowSpace]
workspacesOn :: ScreenId -> [WindowSpace] -> [WindowSpace]
workspacesOn ScreenId
s = forall a. (a -> Bool) -> [a] -> [a]
filter (\WindowSpace
ws -> PhysicalWorkspace -> ScreenId
unmarshallS (forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws) forall a. Eq a => a -> a -> Bool
== ScreenId
s)
marshallSort :: ScreenId -> ([VirtualWindowSpace] -> [VirtualWindowSpace]) -> ([PhysicalWindowSpace] -> [PhysicalWindowSpace])
marshallSort :: ScreenId
-> ([WindowSpace] -> [WindowSpace])
-> [WindowSpace]
-> [WindowSpace]
marshallSort ScreenId
s [WindowSpace] -> [WindowSpace]
vSort = [WindowSpace] -> [WindowSpace]
pScreens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
vSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WindowSpace] -> [WindowSpace]
vScreens where
vScreens :: [WindowSpace] -> [WindowSpace]
vScreens = forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WindowSpace
unmarshallWindowSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId -> [WindowSpace] -> [WindowSpace]
workspacesOn ScreenId
s
pScreens :: [WindowSpace] -> [WindowSpace]
pScreens = forall a b. (a -> b) -> [a] -> [b]
map (ScreenId -> WindowSpace -> WindowSpace
marshallWindowSpace ScreenId
s)
marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace
unmarshallWindowSpace :: WindowSpace -> WindowSpace
marshallWindowSpace :: ScreenId -> WindowSpace -> WindowSpace
marshallWindowSpace ScreenId
s WindowSpace
ws = WindowSpace
ws { tag :: PhysicalWorkspace
W.tag = ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
s (forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws) }
unmarshallWindowSpace :: WindowSpace -> WindowSpace
unmarshallWindowSpace WindowSpace
ws = WindowSpace
ws { tag :: PhysicalWorkspace
W.tag = PhysicalWorkspace -> PhysicalWorkspace
unmarshallW (forall i l a. Workspace i l a -> i
W.tag WindowSpace
ws) }