    -----------------------------------------------------------------------------
    -- |
    -- 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 = (WindowSpace -> 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 a. a -> X a
    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 WorkspaceCompare
    getWsCompare = do
        WorkspaceId -> Maybe Int
    wsIndex <- X (WorkspaceId -> Maybe Int)
    getWsIndex
        WorkspaceCompare -> X WorkspaceCompare
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WorkspaceCompare -> X WorkspaceCompare)
    -> WorkspaceCompare -> X WorkspaceCompare
    forall a b. (a -> b) -> a -> b
    $ [WorkspaceCompare] -> WorkspaceCompare
    forall a. Monoid a => [a] -> a
    mconcat [Maybe Int -> Maybe Int -> Ordering
    indexCompare (Maybe Int -> Maybe Int -> Ordering)
    -> (WorkspaceId -> Maybe Int) -> WorkspaceCompare
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` WorkspaceId -> Maybe Int
    wsIndex, WorkspaceCompare
    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 = WorkspaceCompare -> X WorkspaceCompare
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return WorkspaceCompare
    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 (ScreenComparator -> X WorkspaceCompare)
    -> ScreenComparator -> X WorkspaceCompare
    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 WorkspaceCompare
    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
        WorkspaceCompare -> X WorkspaceCompare
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WorkspaceCompare -> X WorkspaceCompare)
    -> WorkspaceCompare -> X WorkspaceCompare
    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 -> WorkspaceCompare
    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) -> WorkspaceCompare
    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 a. Eq 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 i l a ScreenId ScreenDetail -> i -> i -> Ordering
    compareUsingScreen StackSet i l a ScreenId ScreenDetail
    w = (ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering
    sc ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
    -> (i -> (ScreenId, Rectangle)) -> i -> i -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
    forall i l a.
    Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
    getScreenIdAndRectangle (Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle))
    -> (i -> Screen i l a ScreenId ScreenDetail)
    -> i
    -> (ScreenId, Rectangle)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Screen i l a ScreenId ScreenDetail]
    -> i -> Screen i 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 i l a ScreenId ScreenDetail
    -> [Screen i l a ScreenId ScreenDetail]
    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
      WorkspaceSort -> X WorkspaceSort
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WorkspaceSort -> X WorkspaceSort)
    -> WorkspaceSort -> X WorkspaceSort
    forall a b. (a -> b) -> a -> b
    $ (WindowSpace -> WindowSpace -> Ordering) -> WorkspaceSort
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (\WindowSpace
    a WindowSpace
    b -> WorkspaceCompare
    cmp (WindowSpace -> WorkspaceId
    forall i l a. Workspace i l a -> i
    S.tag WindowSpace
    a) (WindowSpace -> WorkspaceId
    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 (X WorkspaceCompare -> X WorkspaceSort)
    -> X WorkspaceCompare -> X WorkspaceSort
    forall a b. (a -> b) -> a -> b
    $ ScreenComparator -> X WorkspaceCompare
    getXineramaPhysicalWsCompare ScreenComparator
    sc