{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.IndependentScreens
-- Description :  Simulate independent sets of workspaces on each screen (dwm-like).
-- Copyright   :  (c) 2009 Daniel Wagner
-- License     :  BSD3
--
-- Maintainer  :  <daniel@wagner-home.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Utility functions for simulating independent sets of workspaces on
-- each screen (like dwm's workspace model), using internal tags to
-- distinguish workspaces associated with each screen.
-----------------------------------------------------------------------------

module XMonad.Layout.IndependentScreens (
    -- * Usage
    -- $usage
    VirtualWorkspace, PhysicalWorkspace,
    VirtualWindowSpace, PhysicalWindowSpace,
    workspaces',
    withScreen, withScreens,
    onCurrentScreen,
    marshallPP,
    whenCurrentOn,
    countScreens,
    workspacesOn,
    workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen,
    -- * Converting between virtual and physical workspaces
    -- $converting
    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

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.IndependentScreens
--
-- You can define your workspaces by calling @withScreens@:
--
-- > myConfig = def { workspaces = withScreens 2 ["web", "email", "irc"] }
--
-- This will create \"physical\" workspaces with distinct internal names for
-- each (screen, virtual workspace) pair.
--
-- Then edit any keybindings that use the list of workspaces or refer
-- to specific workspace names.  In the default configuration, only
-- the keybindings for changing workspace do this:
--
-- > keyBindings conf = let modm = modMask conf in fromList $
-- >     {- lots of other keybindings -}
-- >     [((m .|. modm, k), windows $ f i)
-- >         | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
--
-- This should change to
--
-- > keyBindings conf = let modm = modMask conf in fromList $
-- >     {- lots of other keybindings -}
-- >     [((m .|. modm, k), windows $ onCurrentScreen f i)
-- >         | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
--
-- In particular, the analogue of @XMonad.workspaces@ is
-- @workspaces'@, and you can use @onCurrentScreen@ to convert functions
-- of virtual workspaces to functions of physical workspaces, which work
-- by marshalling the virtual workspace name and the currently focused
-- screen into a physical workspace name.
--
-- A complete example abusing many of the functions below is available in the
-- <https://xmonad.org/configurations.html XMonad.Config.Dmwit> configuration.

type VirtualWorkspace  = WorkspaceId
type PhysicalWorkspace = WorkspaceId

-- | A 'WindowSpace' whose tags are 'PhysicalWorkspace's.
type PhysicalWindowSpace = WindowSpace
-- | A 'WindowSpace' whose tags are 'VirtualWorkspace's.
type VirtualWindowSpace = WindowSpace

-- $converting
-- You shouldn't need to use the functions below very much. They are used
-- internally. However, in some cases, they may be useful, and so are exported
-- just in case. In general, the \"marshall\" functions convert the convenient
-- form (like \"web\") you would like to use in your configuration file to the
-- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly,
-- the \"unmarshall\" functions convert in the other direction.

marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace
marshall :: ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall (S Int
sc) PhysicalWorkspace
vws = Int -> PhysicalWorkspace
forall a. Show a => a -> PhysicalWorkspace
show Int
sc PhysicalWorkspace -> PhysicalWorkspace -> PhysicalWorkspace
forall a. [a] -> [a] -> [a]
++ Char
'_'Char -> PhysicalWorkspace -> PhysicalWorkspace
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 (Int -> ScreenId)
-> (PhysicalWorkspace -> Int) -> PhysicalWorkspace -> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> Int
forall a. Read a => PhysicalWorkspace -> a
read) (PhysicalWorkspace -> ScreenId)
-> (PhysicalWorkspace -> PhysicalWorkspace)
-> (PhysicalWorkspace, PhysicalWorkspace)
-> (ScreenId, PhysicalWorkspace)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int -> PhysicalWorkspace -> PhysicalWorkspace
forall a. Int -> [a] -> [a]
drop Int
1) ((PhysicalWorkspace, PhysicalWorkspace)
 -> (ScreenId, PhysicalWorkspace))
-> (PhysicalWorkspace -> (PhysicalWorkspace, PhysicalWorkspace))
-> PhysicalWorkspace
-> (ScreenId, PhysicalWorkspace)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> PhysicalWorkspace -> (PhysicalWorkspace, PhysicalWorkspace)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'_')
unmarshallS :: PhysicalWorkspace -> ScreenId
unmarshallS = (ScreenId, PhysicalWorkspace) -> ScreenId
forall a b. (a, b) -> a
fst ((ScreenId, PhysicalWorkspace) -> ScreenId)
-> (PhysicalWorkspace -> (ScreenId, PhysicalWorkspace))
-> PhysicalWorkspace
-> ScreenId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> (ScreenId, PhysicalWorkspace)
unmarshall
unmarshallW :: PhysicalWorkspace -> PhysicalWorkspace
unmarshallW = (ScreenId, PhysicalWorkspace) -> PhysicalWorkspace
forall a b. (a, b) -> b
snd ((ScreenId, PhysicalWorkspace) -> PhysicalWorkspace)
-> (PhysicalWorkspace -> (ScreenId, PhysicalWorkspace))
-> PhysicalWorkspace
-> PhysicalWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> (ScreenId, PhysicalWorkspace)
unmarshall

-- | Get a list of all the virtual workspace names.
workspaces' :: XConfig l -> [VirtualWorkspace]
workspaces' :: forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces' = [PhysicalWorkspace] -> [PhysicalWorkspace]
forall a. Eq a => [a] -> [a]
nub ([PhysicalWorkspace] -> [PhysicalWorkspace])
-> (XConfig l -> [PhysicalWorkspace])
-> XConfig l
-> [PhysicalWorkspace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PhysicalWorkspace -> PhysicalWorkspace)
-> [PhysicalWorkspace] -> [PhysicalWorkspace]
forall a b. (a -> b) -> [a] -> [b]
map PhysicalWorkspace -> PhysicalWorkspace
unmarshallW ([PhysicalWorkspace] -> [PhysicalWorkspace])
-> (XConfig l -> [PhysicalWorkspace])
-> XConfig l
-> [PhysicalWorkspace]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig l -> [PhysicalWorkspace]
forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces

-- | Specify workspace names for each screen
withScreen :: ScreenId            -- ^ The screen to make workspaces for
           -> [VirtualWorkspace]  -- ^ The desired virtual workspace names
           -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names
withScreen :: ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
withScreen ScreenId
n = (PhysicalWorkspace -> PhysicalWorkspace)
-> [PhysicalWorkspace] -> [PhysicalWorkspace]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
n)

-- | Make all workspaces across the monitors bear the same names
withScreens :: ScreenId            -- ^ The number of screens to make workspaces for
            -> [VirtualWorkspace]  -- ^ The desired virtual workspace names
            -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names
withScreens :: ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
withScreens ScreenId
n [PhysicalWorkspace]
vws = (ScreenId -> [PhysicalWorkspace])
-> [ScreenId] -> [PhysicalWorkspace]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ScreenId -> [PhysicalWorkspace] -> [PhysicalWorkspace]
`withScreen` [PhysicalWorkspace]
vws) [ScreenId
0..ScreenId
nScreenId -> ScreenId -> ScreenId
forall a. Num a => a -> a -> a
-ScreenId
1]

-- | Transform a function over physical workspaces into a function over virtual workspaces.
-- This is useful as it allows you to write code without caring about the current screen, i.e. to say "switch to workspace 3"
-- rather than saying "switch to workspace 3 on monitor 3".
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 = Screen
  PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (Screen
   PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
 -> ScreenId)
-> Screen
     PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen
     PhysicalWorkspace (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
   in PhysicalWorkspace -> WindowSet -> a
f (ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
currentScreenId PhysicalWorkspace
vws) WindowSet
ws

-- | Get the workspace currently active on a given screen
workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace
workspaceOnScreen :: ScreenId -> WindowSet -> Maybe PhysicalWorkspace
workspaceOnScreen ScreenId
screenId WindowSet
ws = Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall i l a. Workspace i l a -> i
W.tag (Workspace PhysicalWorkspace (Layout Window) Window
 -> PhysicalWorkspace)
-> (Screen
      PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
    -> Workspace PhysicalWorkspace (Layout Window) Window)
-> Screen
     PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> PhysicalWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen
  PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> Workspace PhysicalWorkspace (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen
   PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
 -> PhysicalWorkspace)
-> Maybe
     (Screen
        PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail)
-> Maybe PhysicalWorkspace
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

-- | Generate WindowSet transformation by providing a given function with the workspace active on a given screen.
-- This may for example be used to shift a window to another screen as follows:
--
-- > windows $ withWspOnScreen 1 W.shift
--
withWspOnScreen :: ScreenId                               -- ^ The screen to run on
         -> (PhysicalWorkspace -> WindowSet -> WindowSet) -- ^ The transformation that will be passed the workspace currently active on there
         -> 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

-- | Get the workspace that is active on a given screen.
screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen
screenOnMonitor :: ScreenId
-> WindowSet
-> Maybe
     (Screen
        PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail)
screenOnMonitor ScreenId
screenId WindowSet
ws = (Screen
   PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen
      PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen
        PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((ScreenId
screenId ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
==) (ScreenId -> Bool)
-> (Screen
      PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen
     PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen
  PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen) (WindowSet
-> Screen
     PhysicalWorkspace (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
  PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      PhysicalWorkspace (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen
      PhysicalWorkspace (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)

-- | Focus a window, switching workspace on the correct Xinerama screen if neccessary.
focusWindow' :: Window -> WindowSet -> WindowSet
focusWindow' :: Window -> WindowSet -> WindowSet
focusWindow' Window
window WindowSet
ws
  | Window -> Maybe Window
forall a. a -> Maybe a
Just Window
window Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws = WindowSet
ws
  | Bool
otherwise = case Window -> WindowSet -> Maybe PhysicalWorkspace
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 -> Window -> 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 Window
window (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ ScreenId -> WindowSet -> WindowSet
focusScreen (PhysicalWorkspace -> ScreenId
unmarshallS PhysicalWorkspace
tag) WindowSet
ws
      Maybe PhysicalWorkspace
Nothing -> WindowSet
ws

-- | Focus a given screen.
focusScreen :: ScreenId -> WindowSet -> WindowSet
focusScreen :: ScreenId -> WindowSet -> WindowSet
focusScreen ScreenId
screenId = ScreenId
-> (PhysicalWorkspace -> WindowSet -> WindowSet)
-> WindowSet
-> WindowSet
withWspOnScreen ScreenId
screenId PhysicalWorkspace -> WindowSet -> WindowSet
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

-- | Get the nth virtual workspace
nthWorkspace :: Int -> X (Maybe VirtualWorkspace)
nthWorkspace :: Int -> X (Maybe PhysicalWorkspace)
nthWorkspace Int
n = ([PhysicalWorkspace] -> Int -> Maybe PhysicalWorkspace
forall a. [a] -> Int -> Maybe a
!? Int
n) ([PhysicalWorkspace] -> Maybe PhysicalWorkspace)
-> (XConfig Layout -> [PhysicalWorkspace])
-> XConfig Layout
-> Maybe PhysicalWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig Layout -> [PhysicalWorkspace]
forall (l :: * -> *). XConfig l -> [PhysicalWorkspace]
workspaces' (XConfig Layout -> Maybe PhysicalWorkspace)
-> X (XConfig Layout) -> X (Maybe PhysicalWorkspace)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XConf -> XConfig Layout) -> X (XConfig Layout)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> XConfig Layout
config

-- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad.  For example, part of my config reads
--
-- > main = do
-- >   nScreens <- countScreens
-- >   xmonad $ def {
-- >     ...
-- >     workspaces = withScreens nScreens (workspaces def),
-- >     ...
-- >     }
--
countScreens :: (MonadIO m, Integral i) => m i
countScreens :: forall (m :: * -> *) i. (MonadIO m, Integral i) => m i
countScreens = ([Rectangle] -> i) -> m [Rectangle] -> m i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Rectangle] -> i
forall i a. Num i => [a] -> i
genericLength (m [Rectangle] -> m i)
-> (IO [Rectangle] -> m [Rectangle]) -> IO [Rectangle] -> m i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Rectangle] -> m [Rectangle]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Rectangle] -> m i) -> IO [Rectangle] -> m i
forall a b. (a -> b) -> a -> b
$ PhysicalWorkspace -> IO Display
openDisplay PhysicalWorkspace
"" IO Display -> (Display -> IO [Rectangle]) -> IO [Rectangle]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO [Rectangle] -> IO () -> IO [Rectangle])
-> (Display -> IO [Rectangle])
-> (Display -> IO ())
-> Display
-> IO [Rectangle]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 IO [Rectangle] -> IO () -> IO [Rectangle]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) Display -> IO [Rectangle]
getScreenInfo Display -> IO ()
closeDisplay

-- | This turns a pretty-printer into one that is aware of the independent screens. The
-- converted pretty-printer first filters out physical workspaces on other screens, then
-- converts all the physical workspaces on this screen to their virtual names.
-- Note that 'ppSort' still operates on physical (marshalled) workspace names,
-- otherwise functions from "XMonad.Util.WorkspaceCompare" wouldn't work.
-- If you need to sort on virtual names, see 'marshallSort'.
--
-- For example, if you have have two bars on the left and right screens, respectively, and @pp@ is
-- a pretty-printer, you could apply 'marshallPP' when creating a @StatusBarConfig@ from "XMonad.Hooks.StatusBar".
--
-- A sample config looks like this:
--
-- > mySBL = statusBarProp "xmobar" $ pure (marshallPP (S 0) pp)
-- > mySBR = statusBarProp "xmobar" $ pure (marshallPP (S 1) pp)
-- > main = xmonad $ withEasySB (mySBL <> mySBR) defToggleStrutsKey def
--
marshallPP :: ScreenId -> PP -> PP
marshallPP :: ScreenId -> PP -> PP
marshallPP ScreenId
s PP
pp = PP
pp { ppRename :: PhysicalWorkspace
-> Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
ppRename = PP
-> PhysicalWorkspace
-> Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
ppRename PP
pp (PhysicalWorkspace
 -> Workspace PhysicalWorkspace (Layout Window) Window
 -> PhysicalWorkspace)
-> (PhysicalWorkspace -> PhysicalWorkspace)
-> PhysicalWorkspace
-> Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PhysicalWorkspace -> PhysicalWorkspace
unmarshallW
                     , ppSort :: X ([Workspace PhysicalWorkspace (Layout Window) Window]
   -> [Workspace PhysicalWorkspace (Layout Window) Window])
ppSort = (([Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
workspacesOn ScreenId
s) (([Workspace PhysicalWorkspace (Layout Window) Window]
  -> [Workspace PhysicalWorkspace (Layout Window) Window])
 -> [Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PP
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
ppSort PP
pp }

-- | Take a pretty-printer and turn it into one that only runs when the current
-- workspace is one associated with the given screen. The way this works is a
-- bit hacky, so beware: the 'ppOutput' field of the input will not be invoked
-- if either of the following conditions is met:
--
-- 1. The 'ppSort' of the input returns an empty list (when not given one).
--
-- 2. The 'ppOrder' of the input returns the exact string @\"\\0\"@.
--
-- For example, you can use this to create a pipe which tracks the title of the
-- window currently focused on a given screen (even if the screen is not
-- current) by doing something like this:
--
-- > ppFocus s = whenCurrentOn s def
-- >     { ppOrder  = \(_:_:title:_) -> [title]
-- >     , ppOutput = appendFile ("focus" ++ show s) . (++ "\n")
-- >     }
--
-- Sequence a few of these pretty-printers to get a log hook that keeps each
-- screen's title up-to-date.
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn :: ScreenId -> PP -> PP
whenCurrentOn ScreenId
s PP
pp = PP
pp
    { ppSort :: X ([Workspace PhysicalWorkspace (Layout Window) Window]
   -> [Workspace PhysicalWorkspace (Layout Window) Window])
ppSort = do
        [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
sorter <- PP
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
ppSort PP
pp
        ([Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Workspace PhysicalWorkspace (Layout Window) Window]
  -> [Workspace PhysicalWorkspace (Layout Window) Window])
 -> X ([Workspace PhysicalWorkspace (Layout Window) Window]
       -> [Workspace PhysicalWorkspace (Layout Window) Window]))
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> X ([Workspace PhysicalWorkspace (Layout Window) Window]
      -> [Workspace PhysicalWorkspace (Layout Window) Window])
forall a b. (a -> b) -> a -> b
$ \case xs :: [Workspace PhysicalWorkspace (Layout Window) Window]
xs@(Workspace PhysicalWorkspace (Layout Window) Window
x:[Workspace PhysicalWorkspace (Layout Window) Window]
_) | PhysicalWorkspace -> ScreenId
unmarshallS (Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall i l a. Workspace i l a -> i
W.tag Workspace PhysicalWorkspace (Layout Window) Window
x) ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenId
s -> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
sorter [Workspace PhysicalWorkspace (Layout Window) Window]
xs
                     [Workspace PhysicalWorkspace (Layout Window) Window]
_ -> []

    , ppOrder :: [PhysicalWorkspace] -> [PhysicalWorkspace]
ppOrder  = \case (PhysicalWorkspace
"":[PhysicalWorkspace]
_) -> [PhysicalWorkspace
"\0"] -- we got passed no workspaces; this is the signal from ppSort that this is a boring case
                       [PhysicalWorkspace]
list   -> PP -> [PhysicalWorkspace] -> [PhysicalWorkspace]
ppOrder PP
pp [PhysicalWorkspace]
list

    , ppOutput :: PhysicalWorkspace -> IO ()
ppOutput = \case PhysicalWorkspace
"\0"   -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- we got passed the signal from ppOrder that this is a boring case
                       PhysicalWorkspace
output -> PP -> PhysicalWorkspace -> IO ()
ppOutput PP
pp PhysicalWorkspace
output
    }

-- | Filter workspaces that are on a given screen.
workspacesOn :: ScreenId -> [PhysicalWindowSpace] -> [PhysicalWindowSpace]
workspacesOn :: ScreenId
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
workspacesOn ScreenId
s = (Workspace PhysicalWorkspace (Layout Window) Window -> Bool)
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Workspace PhysicalWorkspace (Layout Window) Window
ws -> PhysicalWorkspace -> ScreenId
unmarshallS (Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall i l a. Workspace i l a -> i
W.tag Workspace PhysicalWorkspace (Layout Window) Window
ws) ScreenId -> ScreenId -> Bool
forall a. Eq a => a -> a -> Bool
== ScreenId
s)

-- | @vSort@ is a function that sorts 'VirtualWindowSpace's with virtual names.
-- @marshallSort s vSort@ is a function which sorts 'PhysicalWindowSpace's with virtual names,
-- but keeps only the 'WindowSpace'\'s on screen @s@.
--
-- NOTE: @vSort@ operating on virtual names comes with some caveats, see
-- <https://github.com/xmonad/xmonad-contrib/issues/420 this issue> for
-- more information. You can use 'marshallSort' like in the following example:
--
-- === __Example__
--
-- > pp' :: ScreenId -> PP -> PP
-- > pp' s pp = (marshallPP s pp) { ppSort = fmap (marshallSort s) (ppSort pp) }
-- >
-- > mySBL = statusBarProp "xmobar" $ pure (pp' (S 0) pp)
-- > mySBR = statusBarProp "xmobar" $ pure (pp' (S 1) pp)
-- > main = xmonad $ withEasySB (mySBL <> mySBR) defToggleStrutsKey def
--
-- In this way, you have a custom virtual names sort on top of 'marshallPP'.
marshallSort :: ScreenId -> ([VirtualWindowSpace] -> [VirtualWindowSpace]) -> ([PhysicalWindowSpace] -> [PhysicalWindowSpace])
marshallSort :: ScreenId
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
marshallSort ScreenId
s [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
vSort = [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
pScreens ([Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
vSort ([Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
vScreens where
    vScreens :: [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
vScreens    = (Workspace PhysicalWorkspace (Layout Window) Window
 -> Workspace PhysicalWorkspace (Layout Window) Window)
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map Workspace PhysicalWorkspace (Layout Window) Window
-> Workspace PhysicalWorkspace (Layout Window) Window
unmarshallWindowSpace ([Workspace PhysicalWorkspace (Layout Window) Window]
 -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> ([Workspace PhysicalWorkspace (Layout Window) Window]
    -> [Workspace PhysicalWorkspace (Layout Window) Window])
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
workspacesOn ScreenId
s
    pScreens :: [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
pScreens    = (Workspace PhysicalWorkspace (Layout Window) Window
 -> Workspace PhysicalWorkspace (Layout Window) Window)
-> [Workspace PhysicalWorkspace (Layout Window) Window]
-> [Workspace PhysicalWorkspace (Layout Window) Window]
forall a b. (a -> b) -> [a] -> [b]
map (ScreenId
-> Workspace PhysicalWorkspace (Layout Window) Window
-> Workspace PhysicalWorkspace (Layout Window) Window
marshallWindowSpace ScreenId
s)

-- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'.
marshallWindowSpace   :: ScreenId -> WindowSpace -> WindowSpace
-- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'.
unmarshallWindowSpace :: WindowSpace -> WindowSpace

marshallWindowSpace :: ScreenId
-> Workspace PhysicalWorkspace (Layout Window) Window
-> Workspace PhysicalWorkspace (Layout Window) Window
marshallWindowSpace ScreenId
s Workspace PhysicalWorkspace (Layout Window) Window
ws = Workspace PhysicalWorkspace (Layout Window) Window
ws { tag :: PhysicalWorkspace
W.tag = ScreenId -> PhysicalWorkspace -> PhysicalWorkspace
marshall ScreenId
s  (Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall i l a. Workspace i l a -> i
W.tag Workspace PhysicalWorkspace (Layout Window) Window
ws) }
unmarshallWindowSpace :: Workspace PhysicalWorkspace (Layout Window) Window
-> Workspace PhysicalWorkspace (Layout Window) Window
unmarshallWindowSpace Workspace PhysicalWorkspace (Layout Window) Window
ws = Workspace PhysicalWorkspace (Layout Window) Window
ws { tag :: PhysicalWorkspace
W.tag = PhysicalWorkspace -> PhysicalWorkspace
unmarshallW (Workspace PhysicalWorkspace (Layout Window) Window
-> PhysicalWorkspace
forall i l a. Workspace i l a -> i
W.tag Workspace PhysicalWorkspace (Layout Window) Window
ws) }