{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DerivingVia #-}
module XMonad.Actions.Profiles
(
ProfileId
, Profile(..)
, ProfileConfig(..)
, addProfiles
, addProfilesWithHistory
, switchToProfile
, wsFilter
, bindOn
, excludeWSPP
, profileLogger
, switchProfilePrompt
, addWSToProfilePrompt
, removeWSFromProfilePrompt
, switchProfileWSPrompt
, shiftProfileWSPrompt
, currentProfile
, profileIds
, previousProfile
, profileHistory
, allProfileWindows
, profileWorkspaces
)where
import Data.Map.Strict (Map)
import Data.List
import qualified Data.Map.Strict as Map
import Control.DeepSeq
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import XMonad.Actions.CycleWS
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Loggers (Logger)
import XMonad.Prompt.Window (XWindowMap)
import XMonad.Actions.WindowBringer (WindowBringerConfig(..))
import XMonad.Actions.OnScreen (greedyViewOnScreen)
import XMonad.Hooks.Rescreen (addAfterRescreenHook)
import XMonad.Hooks.DynamicLog (PP(ppRename))
import XMonad.Prompt
type ProfileId = String
type ProfileMap = Map ProfileId Profile
data Profile = Profile
{ Profile -> WorkspaceId
profileId :: !ProfileId
, Profile -> [WorkspaceId]
profileWS :: ![WorkspaceId]
}
data ProfileState = ProfileState
{ ProfileState -> ProfileMap
profilesMap :: !ProfileMap
, ProfileState -> Maybe Profile
current :: !(Maybe Profile)
, ProfileState -> Maybe WorkspaceId
previous :: !(Maybe ProfileId)
}
data ProfileConfig = ProfileConfig
{ ProfileConfig -> [WorkspaceId]
workspaceExcludes :: ![WorkspaceId]
, ProfileConfig -> [Profile]
profiles :: ![Profile]
, ProfileConfig -> WorkspaceId
startingProfile :: !ProfileId
}
instance Default ProfileConfig where
def :: ProfileConfig
def = ProfileConfig { workspaceExcludes :: [WorkspaceId]
workspaceExcludes = []
, profiles :: [Profile]
profiles = []
, startingProfile :: WorkspaceId
startingProfile = WorkspaceId
""
}
instance ExtensionClass ProfileState where
initialValue :: ProfileState
initialValue = ProfileMap -> Maybe Profile -> Maybe WorkspaceId -> ProfileState
ProfileState forall k a. Map k a
Map.empty forall a. Maybe a
Nothing forall a. Maybe a
Nothing
newtype ProfileHistory = ProfileHistory
{ ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history :: Map ProfileId [(ScreenId, WorkspaceId)]
}
deriving (ReadPrec [ProfileHistory]
ReadPrec ProfileHistory
Int -> ReadS ProfileHistory
ReadS [ProfileHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProfileHistory]
$creadListPrec :: ReadPrec [ProfileHistory]
readPrec :: ReadPrec ProfileHistory
$creadPrec :: ReadPrec ProfileHistory
readList :: ReadS [ProfileHistory]
$creadList :: ReadS [ProfileHistory]
readsPrec :: Int -> ReadS ProfileHistory
$creadsPrec :: Int -> ReadS ProfileHistory
Read, Int -> ProfileHistory -> ShowS
[ProfileHistory] -> ShowS
ProfileHistory -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [ProfileHistory] -> ShowS
$cshowList :: [ProfileHistory] -> ShowS
show :: ProfileHistory -> WorkspaceId
$cshow :: ProfileHistory -> WorkspaceId
showsPrec :: Int -> ProfileHistory -> ShowS
$cshowsPrec :: Int -> ProfileHistory -> ShowS
Show)
deriving ProfileHistory -> ()
forall a. (a -> ()) -> NFData a
rnf :: ProfileHistory -> ()
$crnf :: ProfileHistory -> ()
NFData via Map ProfileId [(Int, WorkspaceId)]
instance ExtensionClass ProfileHistory where
extensionType :: ProfileHistory -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension
initialValue :: ProfileHistory
initialValue = Map WorkspaceId [(ScreenId, WorkspaceId)] -> ProfileHistory
ProfileHistory forall k a. Map k a
Map.empty
newtype ProfilePrompt = ProfilePrompt String
instance XPrompt ProfilePrompt where
showXPrompt :: ProfilePrompt -> WorkspaceId
showXPrompt (ProfilePrompt WorkspaceId
x) = WorkspaceId
x
defaultProfile :: Profile
defaultProfile :: Profile
defaultProfile = Profile
defaultProfile
currentProfile :: X ProfileId
currentProfile :: X WorkspaceId
currentProfile = Profile -> WorkspaceId
profileId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
previousProfile :: X (Maybe ProfileId)
previousProfile :: X (Maybe WorkspaceId)
previousProfile = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe WorkspaceId
previous
profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
profileHistory :: X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history
profileMap :: X ProfileMap
profileMap :: X ProfileMap
profileMap = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> ProfileMap
profilesMap
profileIds :: X [ProfileId]
profileIds :: X [WorkspaceId]
profileIds = forall k a. Map k a -> [k]
Map.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> ProfileMap
profilesMap
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces :: X [WorkspaceId]
currentProfileWorkspaces = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile
addProfiles :: ProfileConfig -> XConfig a -> XConfig a
addProfiles :: forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfiles ProfileConfig
profConf XConfig a
conf = forall (l :: * -> *). X () -> XConfig l -> XConfig l
addAfterRescreenHook X ()
hook forall a b. (a -> b) -> a -> b
$ XConfig a
conf
{ startupHook :: X ()
startupHook = X ()
profileStartupHook' forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
startupHook XConfig a
conf
}
where
profileStartupHook' :: X()
profileStartupHook' :: X ()
profileStartupHook' = [Profile] -> WorkspaceId -> X ()
profilesStartupHook (ProfileConfig -> [Profile]
profiles ProfileConfig
profConf) (ProfileConfig -> WorkspaceId
startingProfile ProfileConfig
profConf)
hook :: X ()
hook = X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
switchWSOnScreens
addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
addProfilesWithHistory :: forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfilesWithHistory ProfileConfig
profConf XConfig a
conf = XConfig a
conf'
{ logHook :: X ()
logHook = [WorkspaceId] -> X ()
profileHistoryHookExclude (ProfileConfig -> [WorkspaceId]
workspaceExcludes ProfileConfig
profConf) forall a. Semigroup a => a -> a -> a
<> forall (l :: * -> *). XConfig l -> X ()
logHook XConfig a
conf
}
where
conf' :: XConfig a
conf' = forall (a :: * -> *). ProfileConfig -> XConfig a -> XConfig a
addProfiles ProfileConfig
profConf XConfig a
conf
profileHistoryHookExclude :: [WorkspaceId] -> X()
profileHistoryHookExclude :: [WorkspaceId] -> X ()
profileHistoryHookExclude [WorkspaceId]
ews = do
Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[WorkspaceId]
pws <- X [WorkspaceId]
currentProfileWorkspaces
WorkspaceId
p <- X WorkspaceId
currentProfile
WorkspaceId -> [(ScreenId, WorkspaceId)] -> X ()
updateHist WorkspaceId
p forall a b. (a -> b) -> a -> b
$ forall {b} {l} {a} {sid} {sd}. [Screen b l a sid sd] -> [(sid, b)]
workspaceScreenPairs forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *} {l} {a} {sid} {sd}.
Foldable t =>
t WorkspaceId
-> [Screen WorkspaceId l a sid sd]
-> [Screen WorkspaceId l a sid sd]
filterWS [WorkspaceId]
pws forall a b. (a -> b) -> a -> b
$ Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis
where
workspaceScreenPairs :: [Screen b l a sid sd] -> [(sid, b)]
workspaceScreenPairs [Screen b l a sid sd]
wins = forall a b. [a] -> [b] -> [(a, b)]
zip (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen b l a sid sd]
wins) (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 sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen b l a sid sd]
wins)
filterWS :: t WorkspaceId
-> [Screen WorkspaceId l a sid sd]
-> [Screen WorkspaceId l a sid sd]
filterWS t WorkspaceId
pws = forall a. (a -> Bool) -> [a] -> [a]
filter ((\WorkspaceId
wid -> (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t WorkspaceId
pws) Bool -> Bool -> Bool
&& (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
ews)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace)
updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
updateHist :: WorkspaceId -> [(ScreenId, WorkspaceId)] -> X ()
updateHist WorkspaceId
pid [(ScreenId, WorkspaceId)]
xs = WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
pid forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> ProfileHistory -> ProfileHistory
update
where
update :: [WorkspaceId] -> ProfileHistory -> ProfileHistory
update [WorkspaceId]
pws ProfileHistory
hs = forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ ProfileHistory
hs { history :: Map WorkspaceId [(ScreenId, WorkspaceId)]
history = [WorkspaceId]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
doUpdate [WorkspaceId]
pws forall a b. (a -> b) -> a -> b
$ ProfileHistory -> Map WorkspaceId [(ScreenId, WorkspaceId)]
history ProfileHistory
hs }
doUpdate :: [WorkspaceId]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
-> Map WorkspaceId [(ScreenId, WorkspaceId)]
doUpdate [WorkspaceId]
pws Map WorkspaceId [(ScreenId, WorkspaceId)]
hist = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map WorkspaceId [(ScreenId, WorkspaceId)]
acc (ScreenId
sid, WorkspaceId
wid) -> forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall {f :: * -> *}.
Applicative f =>
[WorkspaceId]
-> ScreenId
-> WorkspaceId
-> Maybe [(ScreenId, WorkspaceId)]
-> f [(ScreenId, WorkspaceId)]
f [WorkspaceId]
pws ScreenId
sid WorkspaceId
wid) WorkspaceId
pid Map WorkspaceId [(ScreenId, WorkspaceId)]
acc) Map WorkspaceId [(ScreenId, WorkspaceId)]
hist [(ScreenId, WorkspaceId)]
xs
f :: [WorkspaceId]
-> ScreenId
-> WorkspaceId
-> Maybe [(ScreenId, WorkspaceId)]
-> f [(ScreenId, WorkspaceId)]
f [WorkspaceId]
pws ScreenId
sid WorkspaceId
wid Maybe [(ScreenId, WorkspaceId)]
val = case Maybe [(ScreenId, WorkspaceId)]
val of
Maybe [(ScreenId, WorkspaceId)]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ScreenId
sid, WorkspaceId
wid)]
Just [(ScreenId, WorkspaceId)]
hs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ let new :: (ScreenId, WorkspaceId)
new = (ScreenId
sid, WorkspaceId
wid) in (ScreenId, WorkspaceId)
newforall a. a -> [a] -> [a]
:[WorkspaceId]
-> (ScreenId, WorkspaceId)
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
filterWS [WorkspaceId]
pws (ScreenId, WorkspaceId)
new [(ScreenId, WorkspaceId)]
hs
filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
filterWS :: [WorkspaceId]
-> (ScreenId, WorkspaceId)
-> [(ScreenId, WorkspaceId)]
-> [(ScreenId, WorkspaceId)]
filterWS [WorkspaceId]
pws (ScreenId, WorkspaceId)
new = forall a. (a -> Bool) -> [a] -> [a]
filter (\(ScreenId, WorkspaceId)
x -> forall a b. (a, b) -> b
snd (ScreenId, WorkspaceId)
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws Bool -> Bool -> Bool
&& (ScreenId, WorkspaceId)
x forall a. Eq a => a -> a -> Bool
/= (ScreenId, WorkspaceId)
new)
profilesStartupHook :: [Profile] -> ProfileId -> X ()
profilesStartupHook :: [Profile] -> WorkspaceId -> X ()
profilesStartupHook [Profile]
ps WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid
where
go :: ProfileState -> ProfileState
go :: ProfileState -> ProfileState
go ProfileState
s = ProfileState
s {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
s, current :: Maybe Profile
current = ProfileMap -> Maybe Profile
setCurrentProfile forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Profile -> (WorkspaceId, Profile)
entry [Profile]
ps}
update :: ProfileMap -> ProfileMap
update :: ProfileMap -> ProfileMap
update = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Profile -> (WorkspaceId, Profile)
entry [Profile]
ps)
entry :: Profile -> (ProfileId, Profile)
entry :: Profile -> (WorkspaceId, Profile)
entry Profile
p = (Profile -> WorkspaceId
profileId Profile
p, Profile
p)
setCurrentProfile :: ProfileMap -> Maybe Profile
setCurrentProfile :: ProfileMap -> Maybe Profile
setCurrentProfile ProfileMap
s = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
s of
Maybe Profile
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []
Just Profile
pn -> forall a. a -> Maybe a
Just Profile
pn
setPrevious :: ProfileId -> X()
setPrevious :: WorkspaceId -> X ()
setPrevious WorkspaceId
name = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
update
where
update :: ProfileState -> ProfileState
update ProfileState
ps = ProfileState
ps { previous :: Maybe WorkspaceId
previous = ProfileState -> Maybe WorkspaceId
doUpdate ProfileState
ps }
doUpdate :: ProfileState -> Maybe WorkspaceId
doUpdate ProfileState
ps = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps of
Maybe Profile
Nothing -> ProfileState -> Maybe WorkspaceId
previous ProfileState
ps
Just Profile
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Profile -> WorkspaceId
profileId Profile
p
setProfile :: ProfileId -> X ()
setProfile :: WorkspaceId -> X ()
setProfile WorkspaceId
p = X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
setPrevious forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
setProfile' WorkspaceId
p
setProfile' :: ProfileId -> X ()
setProfile' :: WorkspaceId -> X ()
setProfile' WorkspaceId
name = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
update
where
update :: ProfileState -> ProfileState
update ProfileState
ps = ProfileState
ps { current :: Maybe Profile
current = ProfileState -> Maybe Profile
doUpdate ProfileState
ps }
doUpdate :: ProfileState -> Maybe Profile
doUpdate ProfileState
ps = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
name forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps of
Maybe Profile
Nothing -> ProfileState -> Maybe Profile
current ProfileState
ps
Just Profile
p -> forall a. a -> Maybe a
Just Profile
p
switchToProfile :: ProfileId -> X()
switchToProfile :: WorkspaceId -> X ()
switchToProfile WorkspaceId
pid = WorkspaceId -> X ()
setProfile WorkspaceId
pid forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid
profileWorkspaces :: ProfileId -> X [WorkspaceId]
profileWorkspaces :: WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
pid = X ProfileMap
profileMap forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. Monad m => ProfileMap -> m [WorkspaceId]
findPWs
where
findPWs :: ProfileMap -> m [WorkspaceId]
findPWs ProfileMap
pm = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
pm
addWSToProfilePrompt :: XPConfig -> X()
addWSToProfilePrompt :: XPConfig -> X ()
addWSToProfilePrompt XPConfig
c = do
[WorkspaceId]
ps <- X [WorkspaceId]
profileIds
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Add ws to profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
f
where
f :: String -> X()
f :: WorkspaceId -> X ()
f WorkspaceId
p = do
[WorkspaceId]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
WorkspaceId
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ 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 sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[WorkspaceId]
hid <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
let
arr :: [WorkspaceId]
arr = WorkspaceId
curforall a. a -> [a] -> [a]
:([WorkspaceId]
vis forall a. Semigroup a => a -> a -> a
<> [WorkspaceId]
hid)
in forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Ws to add to profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
arr) (WorkspaceId -> WorkspaceId -> X ()
`addWSToProfile` WorkspaceId
p)
switchProfilePrompt :: XPConfig -> X()
switchProfilePrompt :: XPConfig -> X ()
switchProfilePrompt XPConfig
c = do
[WorkspaceId]
ps <- X [WorkspaceId]
profileIds
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Profile: ") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
switchToProfile
switchProfileWSPrompt :: XPConfig -> X ()
switchProfileWSPrompt :: XPConfig -> X ()
switchProfileWSPrompt XPConfig
c = [WorkspaceId] -> X ()
mkPrompt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
where
mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Switch to workspace:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
pws) WorkspaceId -> X ()
mbygoto
mbygoto :: WorkspaceId -> X ()
mbygoto WorkspaceId
wid = do
[WorkspaceId]
pw <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((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 forall a b. (a -> b) -> a -> b
$ WorkspaceId
wid)
shiftProfileWSPrompt :: XPConfig -> X ()
shiftProfileWSPrompt :: XPConfig -> X ()
shiftProfileWSPrompt XPConfig
c = [WorkspaceId] -> X ()
mkPrompt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X [WorkspaceId]
currentProfileWorkspaces
where
mkPrompt :: [WorkspaceId] -> X ()
mkPrompt [WorkspaceId]
pws = forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Send window to workspace:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
pws) WorkspaceId -> X ()
mbyshift
mbyshift :: WorkspaceId -> X ()
mbyshift WorkspaceId
wid = do
[WorkspaceId]
pw <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X WorkspaceId
currentProfile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [WorkspaceId]
pw) ((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 forall a b. (a -> b) -> a -> b
$ WorkspaceId
wid)
addWSToProfile :: WorkspaceId -> ProfileId -> X()
addWSToProfile :: WorkspaceId -> WorkspaceId -> X ()
addWSToProfile WorkspaceId
wid WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go
where
go :: ProfileState -> ProfileState
go :: ProfileState -> ProfileState
go ProfileState
ps = ProfileState
ps {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps, current :: Maybe Profile
current = Profile -> Maybe Profile
update' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ ProfileState -> Maybe Profile
current ProfileState
ps}
update :: ProfileMap -> ProfileMap
update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
mp of
Maybe Profile
Nothing -> ProfileMap
mp
Just Profile
p -> if WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then ProfileMap
mp else forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Profile -> Profile
f WorkspaceId
pid ProfileMap
mp
f :: Profile -> Profile
f :: Profile -> Profile
f Profile
p = WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid (WorkspaceId
wid forall a. a -> [a] -> [a]
: Profile -> [WorkspaceId]
profileWS Profile
p)
update' :: Profile -> Maybe Profile
update' :: Profile -> Maybe Profile
update' Profile
cp = if Profile -> WorkspaceId
profileId Profile
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Profile -> [WorkspaceId]
profileWS Profile
cp then forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid forall a b. (a -> b) -> a -> b
$ WorkspaceId
widforall a. a -> [a] -> [a]
:Profile -> [WorkspaceId]
profileWS Profile
cp) else forall a. a -> Maybe a
Just Profile
cp
removeWSFromProfilePrompt :: XPConfig -> X()
removeWSFromProfilePrompt :: XPConfig -> X ()
removeWSFromProfilePrompt XPConfig
c = do
[WorkspaceId]
ps <- X [WorkspaceId]
profileIds
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Remove ws from profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
ps) WorkspaceId -> X ()
f
where
f :: String -> X()
f :: WorkspaceId -> X ()
f WorkspaceId
p = do
[WorkspaceId]
arr <- WorkspaceId -> X [WorkspaceId]
profileWorkspaces WorkspaceId
p
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (WorkspaceId -> X ()) -> X ()
mkXPrompt (WorkspaceId -> ProfilePrompt
ProfilePrompt WorkspaceId
"Ws to remove from profile:") XPConfig
c (XPConfig -> [WorkspaceId] -> ComplFunction
mkComplFunFromList' XPConfig
c [WorkspaceId]
arr) forall a b. (a -> b) -> a -> b
$
\WorkspaceId
ws -> do
WorkspaceId
cp <- X WorkspaceId
currentProfile
WorkspaceId
ws WorkspaceId -> WorkspaceId -> X ()
`removeWSFromProfile` WorkspaceId
p
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkspaceId
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
p) forall a b. (a -> b) -> a -> b
$ X WorkspaceId
currentProfile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
switchWSOnScreens
removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
removeWSFromProfile :: WorkspaceId -> WorkspaceId -> X ()
removeWSFromProfile WorkspaceId
wid WorkspaceId
pid = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ProfileState -> ProfileState
go
where
go :: ProfileState -> ProfileState
go :: ProfileState -> ProfileState
go ProfileState
ps = ProfileState
ps {profilesMap :: ProfileMap
profilesMap = ProfileMap -> ProfileMap
update forall a b. (a -> b) -> a -> b
$ ProfileState -> ProfileMap
profilesMap ProfileState
ps, current :: Maybe Profile
current = Profile -> Maybe Profile
update' forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile forall a b. (a -> b) -> a -> b
$ ProfileState -> Maybe Profile
current ProfileState
ps}
update :: ProfileMap -> ProfileMap
update :: ProfileMap -> ProfileMap
update ProfileMap
mp = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid ProfileMap
mp of
Maybe Profile
Nothing -> ProfileMap
mp
Just Profile
p -> if WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
p then forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust Profile -> Profile
f WorkspaceId
pid ProfileMap
mp else ProfileMap
mp
f :: Profile -> Profile
f :: Profile -> Profile
f Profile
p = WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid (forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid forall a b. (a -> b) -> a -> b
$ Profile -> [WorkspaceId]
profileWS Profile
p)
update' :: Profile -> Maybe Profile
update' :: Profile -> Maybe Profile
update' Profile
cp = if Profile -> WorkspaceId
profileId Profile
cp forall a. Eq a => a -> a -> Bool
== WorkspaceId
pid Bool -> Bool -> Bool
&& WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Profile -> [WorkspaceId]
profileWS Profile
cp then forall a. a -> Maybe a
Just (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete WorkspaceId
wid forall a b. (a -> b) -> a -> b
$ Profile -> [WorkspaceId]
profileWS Profile
cp) else forall a. a -> Maybe a
Just Profile
cp
excludeWSPP :: PP -> X PP
excludeWSPP :: PP -> X PP
excludeWSPP PP
pp = forall {t :: * -> *}. Foldable t => t WorkspaceId -> PP
modifyPP forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [WorkspaceId]
currentProfileWorkspaces
where
modifyPP :: t WorkspaceId -> PP
modifyPP t WorkspaceId
pws = PP
pp { ppRename :: WorkspaceId
-> Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
ppRename = PP
-> WorkspaceId
-> Workspace WorkspaceId (Layout Window) Window
-> WorkspaceId
ppRename PP
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => t WorkspaceId -> ShowS
printTag t WorkspaceId
pws }
printTag :: t WorkspaceId -> ShowS
printTag t WorkspaceId
pws WorkspaceId
tag = if WorkspaceId
tag forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t WorkspaceId
pws then WorkspaceId
tag else WorkspaceId
""
wsFilter :: WSType
wsFilter :: WSType
wsFilter = X (Workspace WorkspaceId (Layout Window) Window -> Bool) -> WSType
WSIs forall a b. (a -> b) -> a -> b
$ X [WorkspaceId]
currentProfileWorkspaces forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\[WorkspaceId]
ws -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag)
switchWSOnScreens :: ProfileId -> X()
switchWSOnScreens :: WorkspaceId -> X ()
switchWSOnScreens WorkspaceId
pid = do
Map WorkspaceId [(ScreenId, WorkspaceId)]
hist <- X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory
[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
[WorkspaceId]
pws <- X ProfileMap
profileMap forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> [WorkspaceId]
profileWS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe (WorkspaceId -> [WorkspaceId] -> Profile
Profile WorkspaceId
pid []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid)
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup WorkspaceId
pid Map WorkspaceId [(ScreenId, WorkspaceId)]
hist of
Maybe [(ScreenId, WorkspaceId)]
Nothing -> [(ScreenId, WorkspaceId)] -> X ()
switchScreens forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis)) [WorkspaceId]
pws
Just [(ScreenId, WorkspaceId)]
xs -> forall {i} {l} {a} {sd}.
[(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd] -> [WorkspaceId] -> X ()
compareAndSwitch ([ScreenId]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis) [(ScreenId, WorkspaceId)]
xs) (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
curforall a. a -> [a] -> [a]
:[Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis) [WorkspaceId]
pws
where
f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f :: [ScreenId]
-> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
f [ScreenId]
sids = forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ScreenId]
sids) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
reorderUniq :: forall k v. (Ord k, Ord v) => [(k, v)] -> [(v, k)]
reorderUniq = forall a b. (a -> b) -> [a] -> [b]
map (\(k
x,v
y) -> (v
y,k
x)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Ord k, Ord v) => [(k, v)] -> [(k, v)]
uniq
uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
uniq :: forall k v. (Ord k, Ord v) => [(k, v)] -> [(k, v)]
uniq = forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
viewWS :: (t -> t -> WindowSet -> WindowSet) -> t -> t -> X ()
viewWS t -> t -> WindowSet -> WindowSet
fview t
sid t
wid = (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ t -> t -> WindowSet -> WindowSet
fview t
sid t
wid
switchScreens :: [(ScreenId, WorkspaceId)] -> X ()
switchScreens = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
$ forall {t} {t}.
(t -> t -> WindowSet -> WindowSet) -> t -> t -> X ()
viewWS ScreenId -> WorkspaceId -> WindowSet -> WindowSet
greedyViewOnScreen)
compareAndSwitch :: [(ScreenId, WorkspaceId)]
-> [Screen i l a ScreenId sd] -> [WorkspaceId] -> X ()
compareAndSwitch [(ScreenId, WorkspaceId)]
hist [Screen i l a ScreenId sd]
wins [WorkspaceId]
pws | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ScreenId, WorkspaceId)]
hist forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Screen i l a ScreenId sd]
wins = [(ScreenId, WorkspaceId)] -> X ()
switchScreens forall a b. (a -> b) -> a -> b
$ [(ScreenId, WorkspaceId)]
hist forall a. Semigroup a => a -> a -> a
<> forall {a} {b} {i} {l} {a} {sd}.
(Eq a, Eq b) =>
[(a, b)] -> [Screen i l a a sd] -> [b] -> [(a, b)]
populateScreens [(ScreenId, WorkspaceId)]
hist [Screen i l a ScreenId sd]
wins [WorkspaceId]
pws
| Bool
otherwise = [(ScreenId, WorkspaceId)] -> X ()
switchScreens [(ScreenId, WorkspaceId)]
hist
populateScreens :: [(a, b)] -> [Screen i l a a sd] -> [b] -> [(a, b)]
populateScreens [(a, b)]
hist [Screen i l a a sd]
wins [b]
pws = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(a, b)]
hist) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. Screen i l a sid sd -> sid
W.screen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Screen i l a a sd]
wins) (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, b)]
hist) [b]
pws)
chooseAction :: (String -> X ()) -> X ()
chooseAction :: (WorkspaceId -> X ()) -> X ()
chooseAction WorkspaceId -> X ()
f = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets ProfileState -> Maybe Profile
current forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Profile -> WorkspaceId
profileId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Profile
defaultProfile) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WorkspaceId -> X ()
f
bindOn :: [(String, X ())] -> X ()
bindOn :: [(WorkspaceId, X ())] -> X ()
bindOn [(WorkspaceId, X ())]
bindings = (WorkspaceId -> X ()) -> X ()
chooseAction WorkspaceId -> X ()
chooser
where
chooser :: WorkspaceId -> X ()
chooser WorkspaceId
profile = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
profile [(WorkspaceId, X ())]
bindings of
Just X ()
action -> X ()
action
Maybe (X ())
Nothing -> case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup WorkspaceId
"" [(WorkspaceId, X ())]
bindings of
Just X ()
action -> X ()
action
Maybe (X ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
profileLogger :: (String -> String) -> (String -> String) -> Logger
profileLogger :: ShowS -> ShowS -> X (Maybe WorkspaceId)
profileLogger ShowS
formatFocused ShowS
formatUnfocused = do
[Workspace WorkspaceId (Layout Window) Window]
hws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.hidden forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
WorkspaceId
p <- X WorkspaceId
currentProfile
[WorkspaceId]
hm <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\(WorkspaceId
p', [(ScreenId, WorkspaceId)]
xs) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall {b} {l} {a}. [Workspace b l a] -> [b]
htags [Workspace WorkspaceId (Layout Window) Window]
hws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ScreenId, WorkspaceId)]
xs Bool -> Bool -> Bool
|| WorkspaceId
p' forall a. Eq a => a -> a -> Bool
== WorkspaceId
p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X (Map WorkspaceId [(ScreenId, WorkspaceId)])
profileHistory
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\WorkspaceId
a WorkspaceId
b -> WorkspaceId
a forall a. [a] -> [a] -> [a]
++ WorkspaceId
" " forall a. [a] -> [a] -> [a]
++ WorkspaceId
b) WorkspaceId
"" forall a b. (a -> b) -> a -> b
$ WorkspaceId -> ShowS
format WorkspaceId
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WorkspaceId]
hm
where
format :: WorkspaceId -> ShowS
format WorkspaceId
p WorkspaceId
a = if WorkspaceId
a forall a. Eq a => a -> a -> Bool
== WorkspaceId
p then ShowS
formatFocused WorkspaceId
a else ShowS
formatUnfocused WorkspaceId
a
htags :: [Workspace b l a] -> [b]
htags [Workspace b l a]
wins = forall i l a. Workspace i l a -> i
W.tag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) [Workspace b l a]
wins
allProfileWindows :: XWindowMap
allProfileWindows :: XWindowMap
allProfileWindows = WindowBringerConfig -> XWindowMap
allProfileWindows' forall a. Default a => a
def
allProfileWindows' :: WindowBringerConfig -> XWindowMap
allProfileWindows' :: WindowBringerConfig -> XWindowMap
allProfileWindows' WindowBringerConfig{ windowTitler :: WindowBringerConfig
-> Workspace WorkspaceId (Layout Window) Window
-> Window
-> X WorkspaceId
windowTitler = Workspace WorkspaceId (Layout Window) Window
-> Window -> X WorkspaceId
titler, windowFilter :: WindowBringerConfig -> Window -> X Bool
windowFilter = Window -> X Bool
include } = do
[WorkspaceId]
pws <- X [WorkspaceId]
currentProfileWorkspaces
WindowSet
windowSet <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
pws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag) forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
W.workspaces WindowSet
windowSet)
where keyValuePairs :: Workspace WorkspaceId (Layout Window) Window
-> X [(WorkspaceId, Window)]
keyValuePairs Workspace WorkspaceId (Layout Window) Window
ws = let wins :: [Window]
wins = forall a. Maybe (Stack a) -> [a]
W.integrate' (forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace WorkspaceId (Layout Window) Window
ws)
in forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Workspace WorkspaceId (Layout Window) Window
-> Window -> X (WorkspaceId, Window)
keyValuePair Workspace WorkspaceId (Layout Window) Window
ws) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Window -> X Bool
include [Window]
wins
keyValuePair :: Workspace WorkspaceId (Layout Window) Window
-> Window -> X (WorkspaceId, Window)
keyValuePair Workspace WorkspaceId (Layout Window) Window
ws Window
w = (, Window
w) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace WorkspaceId (Layout Window) Window
-> Window -> X WorkspaceId
titler Workspace WorkspaceId (Layout Window) Window
ws Window
w