-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.WorkspaceCompare
-- Description :  Functions for examining, comparing, and sorting workspaces.
-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-----------------------------------------------------------------------------

module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort
                                    , filterOutWs
                                    , getWsIndex
                                    , getWsCompare
                                    , getWsCompareByTag
                                    , getXineramaPhysicalWsCompare
                                    , getXineramaWsCompare
                                    , mkWsSort
                                    , getSortByIndex
                                    , getSortByTag
                                    , getSortByXineramaPhysicalRule
                                    , getSortByXineramaRule ) where

import XMonad
import qualified XMonad.StackSet as S
import XMonad.Prelude
import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById)

type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering
type WorkspaceSort = [WindowSpace] -> [WindowSpace]

-- | Transforms a workspace list by filtering out the workspaces that
-- correspond to the given 'tag's.  Intended for use with 'logHook's (see
-- 'XMonad.Hooks.StatusBar.PP.filterOutWsPP') and "XMonad.Hooks.EwmhDesktops"
-- (see 'XMonad.Hooks.EwmhDesktops.addEwmhWorkspaceSort').
filterOutWs :: [WorkspaceId] -> WorkspaceSort
filterOutWs :: [WorkspaceId] -> WorkspaceSort
filterOutWs [WorkspaceId]
ws = (Workspace WorkspaceId (Layout Window) Window -> Bool)
-> WorkspaceSort
forall a. (a -> Bool) -> [a] -> [a]
filter (\S.Workspace{ tag :: forall i l a. Workspace i l a -> i
S.tag = WorkspaceId
tag } -> WorkspaceId
tag WorkspaceId -> [WorkspaceId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
ws)

-- | Lookup the index of a workspace id in the user's config, return Nothing
-- if that workspace does not exist in the config.
getWsIndex :: X (WorkspaceId -> Maybe Int)
getWsIndex :: X (WorkspaceId -> Maybe Int)
getWsIndex = do
    [WorkspaceId]
spaces <- (XConf -> [WorkspaceId]) -> X [WorkspaceId]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (XConfig Layout -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces (XConfig Layout -> [WorkspaceId])
-> (XConf -> XConfig Layout) -> XConf -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    (WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return ((WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int))
-> (WorkspaceId -> Maybe Int) -> X (WorkspaceId -> Maybe Int)
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> [WorkspaceId] -> Maybe Int)
-> [WorkspaceId] -> WorkspaceId -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> [WorkspaceId] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex [WorkspaceId]
spaces

-- | Compare Maybe's differently, so Nothing (i.e. workspaces without indexes)
-- come last in the order
indexCompare :: Maybe Int -> Maybe Int -> Ordering
indexCompare :: Maybe Int -> Maybe Int -> Ordering
indexCompare Maybe Int
Nothing Maybe Int
Nothing = Ordering
EQ
indexCompare Maybe Int
Nothing (Just Int
_) = Ordering
GT
indexCompare (Just Int
_) Maybe Int
Nothing = Ordering
LT
indexCompare Maybe Int
a Maybe Int
b = Maybe Int -> Maybe Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe Int
a Maybe Int
b

-- | A comparison function for WorkspaceId, based on the index of the
--   tags in the user's config.
getWsCompare :: X WorkspaceCompare
getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering)
getWsCompare = do
    WorkspaceId -> Maybe Int
wsIndex <- X (WorkspaceId -> Maybe Int)
getWsIndex
    (WorkspaceId -> WorkspaceId -> Ordering)
-> X (WorkspaceId -> WorkspaceId -> Ordering)
forall (m :: * -> *) a. Monad m => a -> m a
return ((WorkspaceId -> WorkspaceId -> Ordering)
 -> X (WorkspaceId -> WorkspaceId -> Ordering))
-> (WorkspaceId -> WorkspaceId -> Ordering)
-> X (WorkspaceId -> WorkspaceId -> Ordering)
forall a b. (a -> b) -> a -> b
$ [WorkspaceId -> WorkspaceId -> Ordering]
-> WorkspaceId -> WorkspaceId -> Ordering
forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Maybe Int -> Ordering
indexCompare (Maybe Int -> Maybe Int -> Ordering)
-> (WorkspaceId -> Maybe Int)
-> WorkspaceId
-> WorkspaceId
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WorkspaceId -> Maybe Int
wsIndex, WorkspaceId -> WorkspaceId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare]

-- | A simple comparison function that orders workspaces
--   lexicographically by tag.
getWsCompareByTag :: X WorkspaceCompare
getWsCompareByTag :: X (WorkspaceId -> WorkspaceId -> Ordering)
getWsCompareByTag = (WorkspaceId -> WorkspaceId -> Ordering)
-> X (WorkspaceId -> WorkspaceId -> Ordering)
forall (m :: * -> *) a. Monad m => a -> m a
return WorkspaceId -> WorkspaceId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | A comparison function for Xinerama based on visibility, workspace
--   and screen id. It produces the same ordering as
--   'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama'.
getXineramaWsCompare :: X WorkspaceCompare
getXineramaWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering)
getXineramaWsCompare = ScreenComparator -> X (WorkspaceId -> WorkspaceId -> Ordering)
getXineramaPhysicalWsCompare (ScreenComparator -> X (WorkspaceId -> WorkspaceId -> Ordering))
-> ScreenComparator -> X (WorkspaceId -> WorkspaceId -> Ordering)
forall a b. (a -> b) -> a -> b
$ (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById ScreenId -> ScreenId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

-- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens.
getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare
getXineramaPhysicalWsCompare :: ScreenComparator -> X (WorkspaceId -> WorkspaceId -> Ordering)
getXineramaPhysicalWsCompare (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
sc) = do
    WindowSet
w <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    (WorkspaceId -> WorkspaceId -> Ordering)
-> X (WorkspaceId -> WorkspaceId -> Ordering)
forall (m :: * -> *) a. Monad m => a -> m a
return ((WorkspaceId -> WorkspaceId -> Ordering)
 -> X (WorkspaceId -> WorkspaceId -> Ordering))
-> (WorkspaceId -> WorkspaceId -> Ordering)
-> X (WorkspaceId -> WorkspaceId -> Ordering)
forall a b. (a -> b) -> a -> b
$ \ WorkspaceId
a WorkspaceId
b -> case (WorkspaceId -> WindowSet -> Bool
forall {a} {l} {a} {sid} {sd}.
Eq a =>
a -> StackSet a l a sid sd -> Bool
isOnScreen WorkspaceId
a WindowSet
w, WorkspaceId -> WindowSet -> Bool
forall {a} {l} {a} {sid} {sd}.
Eq a =>
a -> StackSet a l a sid sd -> Bool
isOnScreen WorkspaceId
b WindowSet
w) of
        (Bool
True, Bool
True)   -> WindowSet -> WorkspaceId -> WorkspaceId -> Ordering
forall {a} {l} {a}.
Eq a =>
StackSet a l a ScreenId ScreenDetail -> a -> a -> Ordering
compareUsingScreen WindowSet
w WorkspaceId
a WorkspaceId
b
        (Bool
False, Bool
False) -> WorkspaceId -> WorkspaceId -> Ordering
forall a. Ord a => a -> a -> Ordering
compare WorkspaceId
a WorkspaceId
b
        (Bool
True, Bool
False)  -> Ordering
LT
        (Bool
False, Bool
True)  -> Ordering
GT
  where
    onScreen :: StackSet i l a sid sd -> [Screen i l a sid sd]
onScreen StackSet i l a sid sd
w =  StackSet i l a sid sd -> Screen i l a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
S.current StackSet i l a sid sd
w Screen i l a sid sd
-> [Screen i l a sid sd] -> [Screen i l a sid sd]
forall a. a -> [a] -> [a]
: StackSet i l a sid sd -> [Screen i l a sid sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
S.visible StackSet i l a sid sd
w
    isOnScreen :: a -> StackSet a l a sid sd -> Bool
isOnScreen a
a StackSet a l a sid sd
w  = a
a a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Screen a l a sid sd -> a) -> [Screen a l a sid sd] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Workspace a l a -> a
forall i l a. Workspace i l a -> i
S.tag (Workspace a l a -> a)
-> (Screen a l a sid sd -> Workspace a l a)
-> Screen a l a sid sd
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen a l a sid sd -> Workspace a l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) (StackSet a l a sid sd -> [Screen a l a sid sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
onScreen StackSet a l a sid sd
w)
    tagToScreen :: t (Screen b l a sid sd) -> b -> Screen b l a sid sd
tagToScreen t (Screen b l a sid sd)
s b
x = Maybe (Screen b l a sid sd) -> Screen b l a sid sd
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Screen b l a sid sd) -> Screen b l a sid sd)
-> Maybe (Screen b l a sid sd) -> Screen b l a sid sd
forall a b. (a -> b) -> a -> b
$ (Screen b l a sid sd -> Bool)
-> t (Screen b l a sid sd) -> Maybe (Screen b l a sid sd)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x) (b -> Bool)
-> (Screen b l a sid sd -> b) -> Screen b l a sid sd -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace b l a -> b
forall i l a. Workspace i l a -> i
S.tag (Workspace b l a -> b)
-> (Screen b l a sid sd -> Workspace b l a)
-> Screen b l a sid sd
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen b l a sid sd -> Workspace b l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
S.workspace) t (Screen b l a sid sd)
s
    compareUsingScreen :: StackSet a l a ScreenId ScreenDetail -> a -> a -> Ordering
compareUsingScreen StackSet a l a ScreenId ScreenDetail
w = (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
sc ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-> (a -> (ScreenId, Rectangle)) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Screen a l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
forall i l a.
Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle (Screen a l a ScreenId ScreenDetail -> (ScreenId, Rectangle))
-> (a -> Screen a l a ScreenId ScreenDetail)
-> a
-> (ScreenId, Rectangle)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Screen a l a ScreenId ScreenDetail]
-> a -> Screen a l a ScreenId ScreenDetail
forall {t :: * -> *} {b} {l} {a} {sid} {sd}.
(Foldable t, Eq b) =>
t (Screen b l a sid sd) -> b -> Screen b l a sid sd
tagToScreen (StackSet a l a ScreenId ScreenDetail
-> [Screen a l a ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
onScreen StackSet a l a ScreenId ScreenDetail
w)

-- | Create a workspace sorting function from a workspace comparison
--   function.
mkWsSort :: X WorkspaceCompare -> X WorkspaceSort
mkWsSort :: X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
mkWsSort X (WorkspaceId -> WorkspaceId -> Ordering)
cmpX = do
  WorkspaceId -> WorkspaceId -> Ordering
cmp <- X (WorkspaceId -> WorkspaceId -> Ordering)
cmpX
  WorkspaceSort -> X WorkspaceSort
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceSort -> X WorkspaceSort)
-> WorkspaceSort -> X WorkspaceSort
forall a b. (a -> b) -> a -> b
$ (Workspace WorkspaceId (Layout Window) Window
 -> Workspace WorkspaceId (Layout Window) Window -> Ordering)
-> WorkspaceSort
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\Workspace WorkspaceId (Layout Window) Window
a Workspace WorkspaceId (Layout Window) Window
b -> WorkspaceId -> WorkspaceId -> Ordering
cmp (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag Workspace WorkspaceId (Layout Window) Window
a) (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
S.tag Workspace WorkspaceId (Layout Window) Window
b))

-- | Sort several workspaces according to their tags' indices in the
--   user's config.
getSortByIndex :: X WorkspaceSort
getSortByIndex :: X WorkspaceSort
getSortByIndex = X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
mkWsSort X (WorkspaceId -> WorkspaceId -> Ordering)
getWsCompare

-- | Sort workspaces lexicographically by tag.
getSortByTag :: X WorkspaceSort
getSortByTag :: X WorkspaceSort
getSortByTag = X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
mkWsSort X (WorkspaceId -> WorkspaceId -> Ordering)
getWsCompareByTag

-- | Sort serveral workspaces for xinerama displays, in the same order
--   produced by 'XMonad.Hooks.StatusBar.PP.pprWindowSetXinerama': first
--   visible workspaces, sorted by screen, then hidden workspaces,
--   sorted by tag.
getSortByXineramaRule :: X WorkspaceSort
getSortByXineramaRule :: X WorkspaceSort
getSortByXineramaRule = X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
mkWsSort X (WorkspaceId -> WorkspaceId -> Ordering)
getXineramaWsCompare
-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.
getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
getSortByXineramaPhysicalRule ScreenComparator
sc = X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
mkWsSort (X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort)
-> X (WorkspaceId -> WorkspaceId -> Ordering) -> X WorkspaceSort
forall a b. (a -> b) -> a -> b
$ ScreenComparator -> X (WorkspaceId -> WorkspaceId -> Ordering)
getXineramaPhysicalWsCompare ScreenComparator
sc