{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}

{- |
 Module      :  XMonad.Hooks.StatusBar.WorkspaceScreen
 Description :  Combine workspace names with screen information
 Copyright   :  (c) Yecine Megdiche <yecine.megdiche@gmail.com>
 License     :  BSD3-style (see LICENSE)

 Maintainer  :  Yecine Megdiche <yecine.megdiche@gmail.com>
 Stability   :  unstable
 Portability :  unportable

 In multi-head setup, it might be useful to have screen information of the
 visible workspaces combined with the workspace name, for example in a status
 bar. This module provides utility functions to do just that.
-}
module XMonad.Hooks.StatusBar.WorkspaceScreen
    (
    -- * Usage
    -- $usage
      combineWithScreen
    , combineWithScreenName
    , combineWithScreenNumber
    , WorkspaceScreenCombiner
    -- * Limitations
    -- $limitations
    ) where

import           Graphics.X11.Xrandr
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
 > import XMonad.Hooks.StatusBar
 > import XMonad.Hooks.StatusBar.PP
 > import XMonad.Hooks.StatusBar.WorkspaceScreen

 For example, to add the screen number in parentheses to each visible
 workspace number, you can use 'combineWithScreenNumber':

 > myWorkspaceScreenCombiner :: WorkspaceId -> String -> String
 > myWorkspaceScreenCombiner w sc = w <> wrap "(" ")" sc
 >
 > mySB = statusBarProp "xmobar" (combineWithScreenNumber myWorkspaceScreenCombiner xmobarPP)
 > main = xmonad $ withEasySB mySB defToggleStrutsKey def

 This will annotate the workspace names as following:

 > [1(0)] 2 3 4 <5(1)> 6 7 8 9

 To use the screen's name instead, checkout 'combineWithScreenName':

 > [1(eDP-1)] 2 3 4 <5(HDMI-1)> 6 7 8 9

 For advanced cases, use 'combineWithScreen'.
-}

{- $limitations
 For simplicity, this module assumes xmonad screen ids match screen/monitor
 numbers as managed by the X server (for example, as given by @xrandr
 --listactivemonitors@). Thus, it may not work well when screens show an
 overlapping range of the framebuffer, e.g. when using a projector. This also
 means that it doesn't work with "XMonad.Layout.LayoutScreens".
 (This isn't difficult to fix, PRs welcome.)
-}

-- | Type synonym for a function that combines a workspace name with a screen.
type WorkspaceScreenCombiner = WorkspaceId -> WindowScreen -> String

-- | A helper function that returns a list of screen names.
screenNames :: X [Maybe String]
screenNames :: X [Maybe WorkspaceId]
screenNames = do
    XConf { Display
display :: XConf -> Display
display :: Display
display, Window
theRoot :: XConf -> Window
theRoot :: Window
theRoot } <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
    let getName :: XRRMonitorInfo -> IO (Maybe WorkspaceId)
getName XRRMonitorInfo
mi = Display -> Window -> IO (Maybe WorkspaceId)
getAtomName Display
display (XRRMonitorInfo -> Window
xrr_moninf_name XRRMonitorInfo
mi)
    IO [Maybe WorkspaceId] -> X [Maybe WorkspaceId]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io
        (IO [Maybe WorkspaceId] -> X [Maybe WorkspaceId])
-> IO [Maybe WorkspaceId] -> X [Maybe WorkspaceId]
forall a b. (a -> b) -> a -> b
$   IO [Maybe WorkspaceId]
-> ([XRRMonitorInfo] -> IO [Maybe WorkspaceId])
-> Maybe [XRRMonitorInfo]
-> IO [Maybe WorkspaceId]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Maybe WorkspaceId] -> IO [Maybe WorkspaceId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ((XRRMonitorInfo -> IO (Maybe WorkspaceId))
-> [XRRMonitorInfo] -> IO [Maybe WorkspaceId]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse XRRMonitorInfo -> IO (Maybe WorkspaceId)
getName)
        (Maybe [XRRMonitorInfo] -> IO [Maybe WorkspaceId])
-> IO (Maybe [XRRMonitorInfo]) -> IO [Maybe WorkspaceId]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Display -> Window -> Bool -> IO (Maybe [XRRMonitorInfo])
xrrGetMonitors Display
display Window
theRoot Bool
True

-- | Combine a workspace name with the screen name it's visible on.
combineWithScreenName :: (WorkspaceId -> String -> String) -> PP -> X PP
combineWithScreenName :: (WorkspaceId -> WorkspaceId -> WorkspaceId) -> PP -> X PP
combineWithScreenName WorkspaceId -> WorkspaceId -> WorkspaceId
c = X WorkspaceScreenCombiner -> PP -> X PP
combineWithScreen (X WorkspaceScreenCombiner -> PP -> X PP)
-> X WorkspaceScreenCombiner -> PP -> X PP
forall a b. (a -> b) -> a -> b
$ do
    [Maybe WorkspaceId]
screens <- X [Maybe WorkspaceId]
screenNames
    WorkspaceScreenCombiner -> X WorkspaceScreenCombiner
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceScreenCombiner -> X WorkspaceScreenCombiner)
-> WorkspaceScreenCombiner -> X WorkspaceScreenCombiner
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc -> WorkspaceId
-> (WorkspaceId -> WorkspaceId) -> Maybe WorkspaceId -> WorkspaceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkspaceId
w (WorkspaceId -> WorkspaceId -> WorkspaceId
c WorkspaceId
w) (Maybe WorkspaceId -> WorkspaceId)
-> Maybe WorkspaceId -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ Maybe (Maybe WorkspaceId) -> Maybe WorkspaceId
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([Maybe WorkspaceId]
screens [Maybe WorkspaceId] -> Int -> Maybe (Maybe WorkspaceId)
forall a. [a] -> Int -> Maybe a
!? ScreenId -> Int
forall a b. (Integral a, Num b) => a -> b
fi (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
sc))

-- | Combine a workspace name with the screen number it's visible on.
combineWithScreenNumber :: (WorkspaceId -> String -> String) -> PP -> X PP
combineWithScreenNumber :: (WorkspaceId -> WorkspaceId -> WorkspaceId) -> PP -> X PP
combineWithScreenNumber WorkspaceId -> WorkspaceId -> WorkspaceId
c =
    X WorkspaceScreenCombiner -> PP -> X PP
combineWithScreen (X WorkspaceScreenCombiner -> PP -> X PP)
-> (WorkspaceScreenCombiner -> X WorkspaceScreenCombiner)
-> WorkspaceScreenCombiner
-> PP
-> X PP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceScreenCombiner -> X WorkspaceScreenCombiner
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceScreenCombiner -> PP -> X PP)
-> WorkspaceScreenCombiner -> PP -> X PP
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
w Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc -> WorkspaceId -> WorkspaceId -> WorkspaceId
c WorkspaceId
w (forall a. Show a => a -> WorkspaceId
show @Int (Int -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Int)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenId -> Int
forall a b. (Integral a, Num b) => a -> b
fi (ScreenId -> Int)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> ScreenId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
 -> WorkspaceId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
sc)

-- | Combine a workspace name with a screen according to the given
-- 'WorkspaceScreenCombiner'.
combineWithScreen :: X WorkspaceScreenCombiner -> PP -> X PP
combineWithScreen :: X WorkspaceScreenCombiner -> PP -> X PP
combineWithScreen X WorkspaceScreenCombiner
xCombiner PP
pp = do
    WorkspaceScreenCombiner
combiner <- X WorkspaceScreenCombiner
xCombiner
    [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
ss       <- (WindowSet
 -> X [Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. (WindowSet -> X a) -> X a
withWindowSet ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
 -> X [Screen
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> (WindowSet
    -> [Screen
          WorkspaceId (Layout Window) Window ScreenId ScreenDetail])
-> WindowSet
-> X [Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall i l a s sd. StackSet i l a s sd -> [Screen i l a s sd]
W.screens)
    PP -> X PP
forall (m :: * -> *) a. Monad m => a -> m a
return (PP -> X PP) -> PP -> X PP
forall a b. (a -> b) -> a -> b
$ PP
pp
        { ppRename :: WorkspaceId -> WindowSpace -> WorkspaceId
ppRename = PP -> WorkspaceId -> WindowSpace -> WorkspaceId
ppRename PP
pp (WorkspaceId -> WindowSpace -> WorkspaceId)
-> (WorkspaceId -> WindowSpace -> WorkspaceId)
-> WorkspaceId
-> WindowSpace
-> WorkspaceId
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< \WorkspaceId
s WindowSpace
w ->
            WorkspaceId
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WorkspaceId)
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WorkspaceId
s (WorkspaceScreenCombiner
combiner WorkspaceId
s) ((Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Bool)
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> Maybe
     (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag WindowSpace
w) (WorkspaceId -> Bool)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WorkspaceId)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (WindowSpace -> WorkspaceId)
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WindowSpace)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
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]
ss)
        }