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]
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)
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
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
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]
getWsCompareByTag :: X WorkspaceCompare
getWsCompareByTag :: X WorkspaceCompare
getWsCompareByTag = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> a -> Ordering
compare
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
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)
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))
getSortByIndex :: X WorkspaceSort
getSortByIndex :: X WorkspaceSort
getSortByIndex = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getWsCompare
getSortByTag :: X WorkspaceSort
getSortByTag :: X WorkspaceSort
getSortByTag = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getWsCompareByTag
getSortByXineramaRule :: X WorkspaceSort
getSortByXineramaRule :: X WorkspaceSort
getSortByXineramaRule = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getXineramaWsCompare
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