-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.DynamicWorkspaceOrder
-- Description :  Remember a dynamically updateable ordering on workspaces.
-- Copyright   :  (c) Brent Yorgey 2009
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  <byorgey@gmail.com>
-- Stability   :  experimental
-- Portability :  unportable
--
-- Remember a dynamically updateable ordering on workspaces, together
-- with tools for using this ordering with "XMonad.Actions.CycleWS"
-- and "XMonad.Hooks.StatusBar.PP".
--
-----------------------------------------------------------------------------

module XMonad.Actions.DynamicWorkspaceOrder
    ( -- * Usage
      -- $usage

      getWsCompareByOrder
    , getSortByOrder
    , swapWith
    , swapWithCurrent
    , swapOrder
    , updateName
    , removeName

    , moveTo
    , moveToGreedy
    , shiftTo

    , withNthWorkspace'
    , withNthWorkspace

    ) where

import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS

import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)

import qualified Data.Map as M
import qualified Data.Set as S
import XMonad.Prelude (fromJust, fromMaybe)
import Data.Ord (comparing)

-- $usage
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
--
-- Then add keybindings to swap the order of workspaces (these
-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
--
-- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)
-- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)
--
-- See "XMonad.Actions.CycleWS" for information on the possible
-- arguments to 'swapWith'.
--
-- However, by itself this will do nothing; 'swapWith' does not change
-- the actual workspaces in any way.  It simply keeps track of an
-- auxiliary ordering on workspaces.  Anything which cares about the
-- order of workspaces must be updated to use the auxiliary ordering.
--
-- To change the order in which workspaces are displayed by
-- "XMonad.Hooks.StatusBar.PP", use 'getSortByOrder' in your
-- 'XMonad.Hooks.StatusBar.PP.ppSort' field, for example:
--
-- >   myPP = ... byorgeyPP {
-- >     ...
-- >     , ppSort = DO.getSortByOrder
-- >     ...
-- >   }
--
-- To use workspace cycling commands like those from
-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
-- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:
--
-- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)
-- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)
-- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)
-- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)
--
-- For slight variations on these, use the source for examples and
-- tweak as desired.

-- | Extensible state storage for the workspace order.
newtype WSOrderStorage = WSO { WSOrderStorage -> Maybe (Map WorkspaceId Int)
unWSO :: Maybe (M.Map WorkspaceId Int) }
  deriving (ReadPrec [WSOrderStorage]
ReadPrec WSOrderStorage
Int -> ReadS WSOrderStorage
ReadS [WSOrderStorage]
(Int -> ReadS WSOrderStorage)
-> ReadS [WSOrderStorage]
-> ReadPrec WSOrderStorage
-> ReadPrec [WSOrderStorage]
-> Read WSOrderStorage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WSOrderStorage]
$creadListPrec :: ReadPrec [WSOrderStorage]
readPrec :: ReadPrec WSOrderStorage
$creadPrec :: ReadPrec WSOrderStorage
readList :: ReadS [WSOrderStorage]
$creadList :: ReadS [WSOrderStorage]
readsPrec :: Int -> ReadS WSOrderStorage
$creadsPrec :: Int -> ReadS WSOrderStorage
Read, Int -> WSOrderStorage -> ShowS
[WSOrderStorage] -> ShowS
WSOrderStorage -> WorkspaceId
(Int -> WSOrderStorage -> ShowS)
-> (WSOrderStorage -> WorkspaceId)
-> ([WSOrderStorage] -> ShowS)
-> Show WSOrderStorage
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WSOrderStorage] -> ShowS
$cshowList :: [WSOrderStorage] -> ShowS
show :: WSOrderStorage -> WorkspaceId
$cshow :: WSOrderStorage -> WorkspaceId
showsPrec :: Int -> WSOrderStorage -> ShowS
$cshowsPrec :: Int -> WSOrderStorage -> ShowS
Show)

instance ExtensionClass WSOrderStorage where
  initialValue :: WSOrderStorage
initialValue = Maybe (Map WorkspaceId Int) -> WSOrderStorage
WSO Maybe (Map WorkspaceId Int)
forall a. Maybe a
Nothing
  extensionType :: WSOrderStorage -> StateExtension
extensionType = WSOrderStorage -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Lift a Map function to a function on WSOrderStorage.
withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
           -> (WSOrderStorage -> WSOrderStorage)
withWSO :: (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO Map WorkspaceId Int -> Map WorkspaceId Int
f = Maybe (Map WorkspaceId Int) -> WSOrderStorage
WSO (Maybe (Map WorkspaceId Int) -> WSOrderStorage)
-> (WSOrderStorage -> Maybe (Map WorkspaceId Int))
-> WSOrderStorage
-> WSOrderStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> Maybe (Map WorkspaceId Int) -> Maybe (Map WorkspaceId Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map WorkspaceId Int -> Map WorkspaceId Int
f (Maybe (Map WorkspaceId Int) -> Maybe (Map WorkspaceId Int))
-> (WSOrderStorage -> Maybe (Map WorkspaceId Int))
-> WSOrderStorage
-> Maybe (Map WorkspaceId Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSOrderStorage -> Maybe (Map WorkspaceId Int)
unWSO

-- | Update the ordering storage: initialize if it doesn't yet exist;
-- add newly created workspaces at the end as necessary.
updateOrder :: X ()
updateOrder :: X ()
updateOrder = do
  WSO Maybe (Map WorkspaceId Int)
mm <- X WSOrderStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  case Maybe (Map WorkspaceId Int)
mm of
    Maybe (Map WorkspaceId Int)
Nothing -> do
      -- initialize using ordering of workspaces from the user's config
      [WorkspaceId]
ws <- (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)
      WSOrderStorage -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (WSOrderStorage -> X ())
-> ([(WorkspaceId, Int)] -> WSOrderStorage)
-> [(WorkspaceId, Int)]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map WorkspaceId Int) -> WSOrderStorage
WSO (Maybe (Map WorkspaceId Int) -> WSOrderStorage)
-> ([(WorkspaceId, Int)] -> Maybe (Map WorkspaceId Int))
-> [(WorkspaceId, Int)]
-> WSOrderStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId Int -> Maybe (Map WorkspaceId Int)
forall a. a -> Maybe a
Just (Map WorkspaceId Int -> Maybe (Map WorkspaceId Int))
-> ([(WorkspaceId, Int)] -> Map WorkspaceId Int)
-> [(WorkspaceId, Int)]
-> Maybe (Map WorkspaceId Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(WorkspaceId, Int)] -> Map WorkspaceId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WorkspaceId, Int)] -> X ()) -> [(WorkspaceId, Int)] -> X ()
forall a b. (a -> b) -> a -> b
$ [WorkspaceId] -> [Int] -> [(WorkspaceId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [WorkspaceId]
ws [Int
0..]
    Just Map WorkspaceId Int
m -> do
      -- check for new workspaces and add them at the end
      Set WorkspaceId
curWs <- (XState -> Set WorkspaceId) -> X (Set WorkspaceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([WorkspaceId] -> Set WorkspaceId
forall a. Ord a => [a] -> Set a
S.fromList ([WorkspaceId] -> Set WorkspaceId)
-> (XState -> [WorkspaceId]) -> XState -> Set WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag ([Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId])
-> (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> XState
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceId (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
      let mappedWs :: Set WorkspaceId
mappedWs  = Map WorkspaceId Int -> Set WorkspaceId
forall k a. Map k a -> Set k
M.keysSet Map WorkspaceId Int
m
          newWs :: Set WorkspaceId
newWs     = Set WorkspaceId
curWs Set WorkspaceId -> Set WorkspaceId -> Set WorkspaceId
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set WorkspaceId
mappedWs
          nextIndex :: Int
nextIndex = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Map WorkspaceId Int -> [Int]
forall k a. Map k a -> [a]
M.elems Map WorkspaceId Int
m)
          newWsIxs :: [(WorkspaceId, Int)]
newWsIxs  = [WorkspaceId] -> [Int] -> [(WorkspaceId, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Set WorkspaceId -> [WorkspaceId]
forall a. Set a -> [a]
S.toAscList Set WorkspaceId
newWs) [Int
nextIndex..]
      (WSOrderStorage -> WSOrderStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSOrderStorage -> WSOrderStorage) -> X ())
-> ([(WorkspaceId, Int)] -> WSOrderStorage -> WSOrderStorage)
-> [(WorkspaceId, Int)]
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO ((Map WorkspaceId Int -> Map WorkspaceId Int)
 -> WSOrderStorage -> WSOrderStorage)
-> ([(WorkspaceId, Int)]
    -> Map WorkspaceId Int -> Map WorkspaceId Int)
-> [(WorkspaceId, Int)]
-> WSOrderStorage
-> WSOrderStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId Int -> Map WorkspaceId Int -> Map WorkspaceId Int
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (Map WorkspaceId Int -> Map WorkspaceId Int -> Map WorkspaceId Int)
-> ([(WorkspaceId, Int)] -> Map WorkspaceId Int)
-> [(WorkspaceId, Int)]
-> Map WorkspaceId Int
-> Map WorkspaceId Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(WorkspaceId, Int)] -> Map WorkspaceId Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(WorkspaceId, Int)] -> X ()) -> [(WorkspaceId, Int)] -> X ()
forall a b. (a -> b) -> a -> b
$ [(WorkspaceId, Int)]
newWsIxs

-- | A comparison function which orders workspaces according to the
-- stored dynamic ordering.
getWsCompareByOrder :: X WorkspaceCompare
getWsCompareByOrder :: X WorkspaceCompare
getWsCompareByOrder = do
  X ()
updateOrder
  -- after the call to updateOrder we are guaranteed that the dynamic
  -- workspace order is initialized and contains all existing
  -- workspaces.
  WSO (Just Map WorkspaceId Int
m) <- X WSOrderStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  WorkspaceCompare -> X WorkspaceCompare
forall (m :: * -> *) a. Monad m => a -> m a
return (WorkspaceCompare -> X WorkspaceCompare)
-> WorkspaceCompare -> X WorkspaceCompare
forall a b. (a -> b) -> a -> b
$ (WorkspaceId -> Int) -> WorkspaceCompare
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1000 (Maybe Int -> Int)
-> (WorkspaceId -> Maybe Int) -> WorkspaceId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Map WorkspaceId Int -> Maybe Int)
-> Map WorkspaceId Int -> WorkspaceId -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> Map WorkspaceId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map WorkspaceId Int
m)

-- | Sort workspaces according to the stored dynamic ordering.
getSortByOrder :: X WorkspaceSort
getSortByOrder :: X WorkspaceSort
getSortByOrder = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getWsCompareByOrder

-- | Swap the current workspace with another workspace in the stored
-- dynamic order.
swapWith :: Direction1D -> WSType -> X ()
swapWith :: Direction1D -> WSType -> X ()
swapWith Direction1D
dir WSType
which = X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
findWorkspace X WorkspaceSort
getSortByOrder Direction1D
dir WSType
which Int
1 X WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
swapWithCurrent

-- | Swap the given workspace with the current one.
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent WorkspaceId
w = do
  WorkspaceId
cur <- (XState -> WorkspaceId) -> X WorkspaceId
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WorkspaceId
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
  WorkspaceId -> WorkspaceId -> X ()
swapOrder WorkspaceId
w WorkspaceId
cur

-- | Swap the two given workspaces in the dynamic order.
swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder WorkspaceId
w1 WorkspaceId
w2 = do
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (WorkspaceId, WorkspaceId) -> IO ()
forall a. Show a => a -> IO ()
print (WorkspaceId
w1,WorkspaceId
w2)
  WSO (Just Map WorkspaceId Int
m) <- X WSOrderStorage
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  let [Int
i1,Int
i2] = (WorkspaceId -> Int) -> [WorkspaceId] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int)
-> (WorkspaceId -> Maybe Int) -> WorkspaceId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId -> Map WorkspaceId Int -> Maybe Int)
-> Map WorkspaceId Int -> WorkspaceId -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip WorkspaceId -> Map WorkspaceId Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map WorkspaceId Int
m) [WorkspaceId
w1,WorkspaceId
w2]
  (WSOrderStorage -> WSOrderStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO (WorkspaceId -> Int -> Map WorkspaceId Int -> Map WorkspaceId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w1 Int
i2 (Map WorkspaceId Int -> Map WorkspaceId Int)
-> (Map WorkspaceId Int -> Map WorkspaceId Int)
-> Map WorkspaceId Int
-> Map WorkspaceId Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Int -> Map WorkspaceId Int -> Map WorkspaceId Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w2 Int
i1))
  (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a. a -> a
id  -- force a status bar update

-- | Update the name of a workspace in the stored order.
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName WorkspaceId
oldId WorkspaceId
newId = (WSOrderStorage -> WSOrderStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSOrderStorage -> WSOrderStorage) -> X ())
-> ((Map WorkspaceId Int -> Map WorkspaceId Int)
    -> WSOrderStorage -> WSOrderStorage)
-> (Map WorkspaceId Int -> Map WorkspaceId Int)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO ((Map WorkspaceId Int -> Map WorkspaceId Int) -> X ())
-> (Map WorkspaceId Int -> Map WorkspaceId Int) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> WorkspaceId -> Map WorkspaceId Int -> Map WorkspaceId Int
forall k a. Ord k => k -> k -> Map k a -> Map k a
changeKey WorkspaceId
oldId WorkspaceId
newId

-- | Remove a workspace from the stored order.
removeName :: WorkspaceId -> X ()
removeName :: WorkspaceId -> X ()
removeName = (WSOrderStorage -> WSOrderStorage) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WSOrderStorage -> WSOrderStorage) -> X ())
-> (WorkspaceId -> WSOrderStorage -> WSOrderStorage)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO ((Map WorkspaceId Int -> Map WorkspaceId Int)
 -> WSOrderStorage -> WSOrderStorage)
-> (WorkspaceId -> Map WorkspaceId Int -> Map WorkspaceId Int)
-> WorkspaceId
-> WSOrderStorage
-> WSOrderStorage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId -> Map WorkspaceId Int -> Map WorkspaceId Int
forall k a. Ord k => k -> Map k a -> Map k a
M.delete

-- | Update a key in a Map.
changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
changeKey :: k -> k -> Map k a -> Map k a
changeKey k
oldKey k
newKey Map k a
oldMap =
  case (k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\k
_ a
_ -> Maybe a
forall a. Maybe a
Nothing) k
oldKey Map k a
oldMap of
    (Maybe a
Nothing, Map k a
_) -> Map k a
oldMap
    (Just a
val, Map k a
newMap) -> k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
newKey a
val Map k a
newMap

-- | View the next workspace of the given type in the given direction,
-- where \"next\" is determined using the dynamic workspace order.
moveTo :: Direction1D -> WSType -> X ()
moveTo :: Direction1D -> WSType -> X ()
moveTo Direction1D
dir WSType
t = Direction1D
-> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
doTo Direction1D
dir WSType
t X WorkspaceSort
getSortByOrder ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view)

-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
moveToGreedy :: Direction1D -> WSType -> X ()
moveToGreedy :: Direction1D -> WSType -> X ()
moveToGreedy Direction1D
dir WSType
t = Direction1D
-> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
doTo Direction1D
dir WSType
t X WorkspaceSort
getSortByOrder ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView)

-- | Shift the currently focused window to the next workspace of the
-- given type in the given direction, using the dynamic workspace order.
shiftTo :: Direction1D -> WSType -> X ()
shiftTo :: Direction1D -> WSType -> X ()
shiftTo Direction1D
dir WSType
t = Direction1D
-> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
doTo Direction1D
dir WSType
t X WorkspaceSort
getSortByOrder ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> WorkspaceId
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift)

-- | Do something with the nth workspace in the dynamic order after
--   transforming it.  The callback is given the workspace's tag as well
--   as the 'WindowSet' of the workspace itself.
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId])
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Int
-> X ()
withNthWorkspace' [WorkspaceId] -> [WorkspaceId]
tr WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
job Int
wnum = do
  WorkspaceSort
sort <- X WorkspaceSort
getSortByOrder
  [WorkspaceId]
ws <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([WorkspaceId] -> [WorkspaceId]
tr ([WorkspaceId] -> [WorkspaceId])
-> (XState -> [WorkspaceId]) -> XState -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> [Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag ([Workspace WorkspaceId (Layout Window) Window] -> [WorkspaceId])
-> (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> XState
-> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort WorkspaceSort
-> (XState -> [Workspace WorkspaceId (Layout Window) Window])
-> XState
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Workspace WorkspaceId (Layout Window) Window]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Workspace WorkspaceId (Layout Window) Window])
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> [Workspace WorkspaceId (Layout Window) Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
  case Int -> [WorkspaceId] -> [WorkspaceId]
forall a. Int -> [a] -> [a]
drop Int
wnum [WorkspaceId]
ws of
    (WorkspaceId
w:[WorkspaceId]
_) -> (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
windows ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> X ())
-> (StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
job WorkspaceId
w
    []    -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Do something with the nth workspace in the dynamic order.  The
--   callback is given the workspace's tag as well as the 'WindowSet'
--   of the workspace itself.
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace :: (WorkspaceId
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Int -> X ()
withNthWorkspace = ([WorkspaceId] -> [WorkspaceId])
-> (WorkspaceId
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Int
-> X ()
withNthWorkspace' [WorkspaceId] -> [WorkspaceId]
forall a. a -> a
id