-----------------------------------------------------------------------------
-- |
-- 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 = 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 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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = 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 WorkspaceCompare
getWsCompare = do
    WorkspaceId -> Maybe Int
wsIndex <- X (WorkspaceId -> Maybe Int)
getWsIndex
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Maybe Int -> Maybe Int -> Ordering
indexCompare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WorkspaceId -> Maybe Int
wsIndex, forall a. Ord a => a -> a -> Ordering
compare]

-- | A simple comparison function that orders workspaces
--   lexicographically by tag.
getWsCompareByTag :: X WorkspaceCompare
getWsCompareByTag :: X WorkspaceCompare
getWsCompareByTag = forall (m :: * -> *) a. Monad m => a -> m a
return 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 WorkspaceCompare
getXineramaWsCompare = ScreenComparator -> X WorkspaceCompare
getXineramaPhysicalWsCompare forall a b. (a -> b) -> a -> b
$ (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
screenComparatorById 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 WorkspaceCompare
getXineramaPhysicalWsCompare (ScreenComparator (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
sc) = do
    WindowSet
w <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ WorkspaceId
a WorkspaceId
b -> case (forall {a} {l} {a} {sid} {sd}.
Eq a =>
a -> StackSet a l a sid sd -> Bool
isOnScreen WorkspaceId
a WindowSet
w, 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)   -> forall {i} {l} {a}.
Eq i =>
StackSet i l a ScreenId ScreenDetail -> i -> i -> Ordering
compareUsingScreen WindowSet
w WorkspaceId
a WorkspaceId
b
        (Bool
False, Bool
False) -> 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 =  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 forall a. a -> [a] -> [a]
: 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map (forall i l a. Workspace i l a -> i
S.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
S.workspace) (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 = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== b
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
S.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
S.workspace) t (Screen b l a sid sd)
s
    compareUsingScreen :: StackSet i l a ScreenId ScreenDetail -> i -> i -> Ordering
compareUsingScreen StackSet i l a ScreenId ScreenDetail
w = (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
sc 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 {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 (forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
onScreen StackSet i l a ScreenId ScreenDetail
w)

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

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

-- | Sort workspaces lexicographically by tag.
getSortByTag :: X WorkspaceSort
getSortByTag :: X WorkspaceSort
getSortByTag = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
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 WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getXineramaWsCompare
-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.
getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
getSortByXineramaPhysicalRule ScreenComparator
sc = X WorkspaceCompare -> X WorkspaceSort
mkWsSort forall a b. (a -> b) -> a -> b
$ ScreenComparator -> X WorkspaceCompare
getXineramaPhysicalWsCompare ScreenComparator
sc