module XMonad.Actions.DynamicWorkspaceOrder
(
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)
newtype WSOrderStorage = WSO { WSOrderStorage -> Maybe (Map WorkspaceId Int)
unWSO :: Maybe (M.Map WorkspaceId Int) }
deriving (ReadPrec [WSOrderStorage]
ReadPrec WSOrderStorage
Int -> ReadS WSOrderStorage
ReadS [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
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 forall a. Maybe a
Nothing
extensionType :: WSOrderStorage -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map WorkspaceId Int -> Map WorkspaceId Int
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. WSOrderStorage -> Maybe (Map WorkspaceId Int)
unWSO
updateOrder :: X ()
updateOrder :: X ()
updateOrder = do
WSO Maybe (Map WorkspaceId Int)
mm <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
case Maybe (Map WorkspaceId Int)
mm of
Maybe (Map WorkspaceId Int)
Nothing -> do
[WorkspaceId]
ws <- 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 a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map WorkspaceId Int) -> WSOrderStorage
WSO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [WorkspaceId]
ws [Int
0..]
Just Map WorkspaceId Int
m -> do
Set WorkspaceId
curWs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
let mappedWs :: Set WorkspaceId
mappedWs = forall k a. Map k a -> Set k
M.keysSet Map WorkspaceId Int
m
newWs :: Set WorkspaceId
newWs = Set WorkspaceId
curWs forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set WorkspaceId
mappedWs
nextIndex :: Int
nextIndex = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (-Int
1 forall a. a -> [a] -> [a]
: forall k a. Map k a -> [a]
M.elems Map WorkspaceId Int
m)
newWsIxs :: [(WorkspaceId, Int)]
newWsIxs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Set a -> [a]
S.toAscList Set WorkspaceId
newWs) [Int
nextIndex..]
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [(WorkspaceId, Int)]
newWsIxs
getWsCompareByOrder :: X WorkspaceCompare
getWsCompareByOrder :: X WorkspaceCompare
getWsCompareByOrder = do
X ()
updateOrder
WSO (Just Map WorkspaceId Int
m) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. a -> Maybe a -> a
fromMaybe Int
1000 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map WorkspaceId Int
m)
getSortByOrder :: X WorkspaceSort
getSortByOrder :: X WorkspaceSort
getSortByOrder = X WorkspaceCompare -> X WorkspaceSort
mkWsSort X WorkspaceCompare
getWsCompareByOrder
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
swapWithCurrent
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent :: WorkspaceId -> X ()
swapWithCurrent WorkspaceId
w = do
WorkspaceId
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
WorkspaceId -> WorkspaceId -> X ()
swapOrder WorkspaceId
w WorkspaceId
cur
swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder :: WorkspaceId -> WorkspaceId -> X ()
swapOrder WorkspaceId
w1 WorkspaceId
w2 = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> IO ()
print (WorkspaceId
w1,WorkspaceId
w2)
WSO (Just Map WorkspaceId Int
m) <- forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
let i1 :: Int
i1 = forall a. HasCallStack => Maybe a -> a
fromJust (WorkspaceId
w1 forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map WorkspaceId Int
m)
let i2 :: Int
i2 = forall a. HasCallStack => Maybe a -> a
fromJust (WorkspaceId
w2 forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map WorkspaceId Int
m)
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO (forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w1 Int
i2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
w2 Int
i1))
(WindowSet -> WindowSet) -> X ()
windows forall a. a -> a
id
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName :: WorkspaceId -> WorkspaceId -> X ()
updateName WorkspaceId
oldId WorkspaceId
newId = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> k -> Map k a -> Map k a
changeKey WorkspaceId
oldId WorkspaceId
newId
removeName :: WorkspaceId -> X ()
removeName :: WorkspaceId -> X ()
removeName = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map WorkspaceId Int -> Map WorkspaceId Int)
-> WSOrderStorage -> WSOrderStorage
withWSO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Map k a
M.delete
changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
changeKey :: forall k a. Ord k => k -> k -> Map k a -> Map k a
changeKey k
oldKey k
newKey Map k a
oldMap =
case forall k a.
Ord k =>
(k -> a -> Maybe a) -> k -> Map k a -> (Maybe a, Map k a)
M.updateLookupWithKey (\k
_ 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) -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert k
newKey a
val Map k a
newMap
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 ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
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 ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
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 ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId])
-> (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace' [WorkspaceId] -> [WorkspaceId]
tr WorkspaceId -> WindowSet -> WindowSet
job Int
wnum = do
WorkspaceSort
sort <- X WorkspaceSort
getSortByOrder
[WorkspaceId]
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([WorkspaceId] -> [WorkspaceId]
tr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceSort
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)
case forall a. Int -> [a] -> [a]
drop Int
wnum [WorkspaceId]
ws of
(WorkspaceId
w:[WorkspaceId]
_) -> (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ WorkspaceId -> WindowSet -> WindowSet
job WorkspaceId
w
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace :: (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace = ([WorkspaceId] -> [WorkspaceId])
-> (WorkspaceId -> WindowSet -> WindowSet) -> Int -> X ()
withNthWorkspace' forall a. a -> a
id