{-# LANGUAGE NamedFieldPuns #-}
module XMonad.Actions.TopicSpace
(
Topic
, Dir
, TopicConfig(..)
, TopicItem(..)
, topicNames
, tiActions
, tiDirs
, noAction
, inHome
, switchTopic
, switchNthLastFocused
, switchNthLastFocusedByScreen
, switchNthLastFocusedExclude
, shiftNthLastFocused
, topicActionWithPrompt
, topicAction
, currentTopicAction
, getLastFocusedTopics
, workspaceHistory
, workspaceHistoryByScreen
, setLastFocusedTopic
, reverseLastFocusedTopics
, workspaceHistoryHook
, workspaceHistoryHookExclude
, pprWindowSet
, currentTopicDir
, checkTopicConfig
, (>*>)
)
where
import XMonad
import XMonad.Prelude
import qualified Data.Map.Strict as M
import qualified XMonad.Hooks.StatusBar.PP as SBPP
import qualified XMonad.StackSet as W
import Data.Map (Map)
import XMonad.Prompt (XPConfig)
import XMonad.Prompt.Workspace (workspacePrompt)
import XMonad.Hooks.StatusBar.PP (PP(ppHidden, ppVisible))
import XMonad.Hooks.UrgencyHook (readUrgents)
import XMonad.Hooks.WorkspaceHistory
( workspaceHistory
, workspaceHistoryByScreen
, workspaceHistoryHook
, workspaceHistoryHookExclude
, workspaceHistoryModify
)
(>*>) :: Monad m => m a -> Int -> m ()
>*> :: forall (m :: * -> *) a. Monad m => m a -> Int -> m ()
(>*>) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_
infix >*>
type Topic = WorkspaceId
type Dir = FilePath
data TopicConfig = TopicConfig { TopicConfig -> Map Topic Topic
topicDirs :: Map Topic Dir
, TopicConfig -> Map Topic (X ())
topicActions :: Map Topic (X ())
, TopicConfig -> Topic -> X ()
defaultTopicAction :: Topic -> X ()
, TopicConfig -> Topic
defaultTopic :: Topic
, TopicConfig -> Int
maxTopicHistory :: Int
}
{-# DEPRECATED maxTopicHistory "This field will be removed in the future; history is now handled by XMonad.Hooks.WorkspaceHistory" #-}
instance Default TopicConfig where
def :: TopicConfig
def = TopicConfig { topicDirs :: Map Topic Topic
topicDirs = forall k a. Map k a
M.empty
, topicActions :: Map Topic (X ())
topicActions = forall k a. Map k a
M.empty
, defaultTopicAction :: Topic -> X ()
defaultTopicAction = forall a b. a -> b -> a
const (forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => Topic -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: * -> *). XConfig l -> Topic
terminal forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
, defaultTopic :: Topic
defaultTopic = Topic
"1"
, maxTopicHistory :: Int
maxTopicHistory = Int
10
}
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics = X [Topic]
workspaceHistory
{-# DEPRECATED getLastFocusedTopics "Use XMonad.Hooks.WorkspaceHistory.workspaceHistory (re-exported by this module) instead" #-}
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic TopicConfig
tc Topic
w Topic -> Bool
predicate = do
ScreenId
sid <- 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. Screen i l a sid sd -> sid
W.screen 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
([(ScreenId, Topic)] -> [(ScreenId, Topic)]) -> X ()
workspaceHistoryModify forall a b. (a -> b) -> a -> b
$
forall a. Int -> [a] -> [a]
take (TopicConfig -> Int
maxTopicHistory TopicConfig
tc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Topic -> Bool
predicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ScreenId
sid, Topic
w) forall a. a -> [a] -> [a]
:)
{-# DEPRECATED setLastFocusedTopic "Use XMonad.Hooks.WorkspaceHistory instead" #-}
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics = ([(ScreenId, Topic)] -> [(ScreenId, Topic)]) -> X ()
workspaceHistoryModify forall a. [a] -> [a]
reverse
pprWindowSet :: TopicConfig -> PP -> X String
pprWindowSet :: TopicConfig -> PP -> X Topic
pprWindowSet TopicConfig
tg PP
pp = do
WindowSet
winset <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
[Window]
urgents <- X [Window]
readUrgents
let empty_workspaces :: [Topic]
empty_workspaces = forall a b. (a -> b) -> [a] -> [b]
map forall i l a. Workspace i l a -> i
W.tag forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces WindowSet
winset
maxDepth :: Int
maxDepth = TopicConfig -> Int
maxTopicHistory TopicConfig
tg
TopicConfig -> Topic -> (Topic -> Bool) -> X ()
setLastFocusedTopic TopicConfig
tg
(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 a b. (a -> b) -> a -> b
$ WindowSet
winset)
(forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Topic]
empty_workspaces)
[Topic]
lastWs <- X [Topic]
workspaceHistory
let depth :: Topic -> Int
depth Topic
topic = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex Topic
topic ([Topic]
lastWs forall a. [a] -> [a] -> [a]
++ [Topic
topic])
add_depth :: (PP -> Topic -> c) -> Topic -> c
add_depth PP -> Topic -> c
proj Topic
topic = PP -> Topic -> c
proj PP
pp forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Topic
topicforall a. [a] -> [a] -> [a]
++Topic
":")forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Topic
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Topic -> Int
depth forall a b. (a -> b) -> a -> b
$ Topic
topic
pp' :: PP
pp' = PP
pp { ppHidden :: Topic -> Topic
ppHidden = forall {c}. (PP -> Topic -> c) -> Topic -> c
add_depth PP -> Topic -> Topic
ppHidden, ppVisible :: Topic -> Topic
ppVisible = forall {c}. (PP -> Topic -> c) -> Topic -> c
add_depth PP -> Topic -> Topic
ppVisible }
sortWindows :: [Workspace Topic l a] -> [Workspace Topic l a]
sortWindows = forall a. Int -> [a] -> [a]
take Int
maxDepth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Topic -> Int
depth forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> i
W.tag)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WorkspaceSort -> [Window] -> PP -> WindowSet -> Topic
SBPP.pprWindowSet forall {l} {a}. [Workspace Topic l a] -> [Workspace Topic l a]
sortWindows [Window]
urgents PP
pp' WindowSet
winset
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
topicActionWithPrompt XPConfig
xp TopicConfig
tg = XPConfig -> (Topic -> X ()) -> X ()
workspacePrompt XPConfig
xp (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (TopicConfig -> Topic -> X ()
switchTopic TopicConfig
tg) (TopicConfig -> Topic -> X ()
topicAction TopicConfig
tg))
topicAction :: TopicConfig -> Topic -> X ()
topicAction :: TopicConfig -> Topic -> X ()
topicAction TopicConfig
tg Topic
topic = forall a. a -> Maybe a -> a
fromMaybe (TopicConfig -> Topic -> X ()
defaultTopicAction TopicConfig
tg Topic
topic) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Topic
topic forall a b. (a -> b) -> a -> b
$ TopicConfig -> Map Topic (X ())
topicActions TopicConfig
tg
currentTopicAction :: TopicConfig -> X ()
currentTopicAction :: TopicConfig -> X ()
currentTopicAction TopicConfig
tg = TopicConfig -> Topic -> X ()
topicAction TopicConfig
tg forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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)
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic TopicConfig
tc Topic
topic = do
(WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ 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 Topic
topic
[Window]
wins <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Maybe (Stack a) -> [a]
W.integrate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack 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)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Window]
wins) forall a b. (a -> b) -> a -> b
$ TopicConfig -> Topic -> X ()
topicAction TopicConfig
tc Topic
topic
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused = [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude []
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude [Topic]
excludes TopicConfig
tc Int
depth = do
[Topic]
lastWs <- forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Topic]
excludes) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [Topic]
workspaceHistory
TopicConfig -> Topic -> X ()
switchTopic TopicConfig
tc forall a b. (a -> b) -> a -> b
$ ([Topic]
lastWs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (TopicConfig -> Topic
defaultTopic TopicConfig
tc)) forall a. [a] -> Int -> a
!! Int
depth
switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
switchNthLastFocusedByScreen TopicConfig
tc Int
depth = do
ScreenId
sid <- 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. Screen i l a sid sd -> sid
W.screen 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
[Topic]
sws <- forall a. a -> Maybe a -> a
fromMaybe []
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== ScreenId
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X [(ScreenId, [Topic])]
workspaceHistoryByScreen
TopicConfig -> Topic -> X ()
switchTopic TopicConfig
tc forall a b. (a -> b) -> a -> b
$ ([Topic]
sws forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat (TopicConfig -> Topic
defaultTopic TopicConfig
tc)) forall a. [a] -> Int -> a
!! Int
depth
shiftNthLastFocused :: Int -> X ()
shiftNthLastFocused :: Int -> X ()
shiftNthLastFocused Int
n = do
Maybe Topic
ws <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n) X [Topic]
workspaceHistory
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Topic
ws forall a b. (a -> b) -> a -> b
$ (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
currentTopicDir :: TopicConfig -> X FilePath
currentTopicDir :: TopicConfig -> X Topic
currentTopicDir TopicConfig
tg = do
Topic
topic <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (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)
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe Topic
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Topic
topic forall a b. (a -> b) -> a -> b
$ TopicConfig -> Map Topic Topic
topicDirs TopicConfig
tg
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig [Topic]
tags TopicConfig
tg = do
let
seenTopics :: [Topic]
seenTopics = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys (TopicConfig -> Map Topic Topic
topicDirs TopicConfig
tg) forall a. [a] -> [a] -> [a]
++ forall k a. Map k a -> [k]
M.keys (TopicConfig -> Map Topic (X ())
topicActions TopicConfig
tg)
dups :: [Topic]
dups = [Topic]
tags forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Eq a => [a] -> [a]
nub [Topic]
tags
diffTopic :: [Topic]
diffTopic = [Topic]
seenTopics forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Ord a => [a] -> [a]
sort [Topic]
tags
check :: t a -> Topic -> f ()
check t a
lst Topic
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
lst) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Topic -> m ()
xmessage forall a b. (a -> b) -> a -> b
$ Topic
msg forall a. [a] -> [a] -> [a]
++ Topic
" (tags): " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Topic
show t a
lst
forall {f :: * -> *} {t :: * -> *} {a}.
(Foldable t, MonadIO f, Show (t a)) =>
t a -> Topic -> f ()
check [Topic]
diffTopic Topic
"Seen but missing topics/workspaces"
forall {f :: * -> *} {t :: * -> *} {a}.
(Foldable t, MonadIO f, Show (t a)) =>
t a -> Topic -> f ()
check [Topic]
dups Topic
"Duplicate topics/workspaces"
data TopicItem = TI
{ TopicItem -> Topic
tiName :: !Topic
, TopicItem -> Topic
tiDir :: !Dir
, TopicItem -> X ()
tiAction :: !(X ())
}
topicNames :: [TopicItem] -> [Topic]
topicNames :: [TopicItem] -> [Topic]
topicNames = forall a b. (a -> b) -> [a] -> [b]
map TopicItem -> Topic
tiName
tiDirs :: [TopicItem] -> Map Topic Dir
tiDirs :: [TopicItem] -> Map Topic Topic
tiDirs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\TI{ Topic
tiName :: Topic
tiName :: TopicItem -> Topic
tiName, Topic
tiDir :: Topic
tiDir :: TopicItem -> Topic
tiDir } -> (Topic
tiName, Topic
tiDir))
tiActions :: [TopicItem] -> Map Topic (X ())
tiActions :: [TopicItem] -> Map Topic (X ())
tiActions = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\TI{ Topic
tiName :: Topic
tiName :: TopicItem -> Topic
tiName, X ()
tiAction :: X ()
tiAction :: TopicItem -> X ()
tiAction } -> (Topic
tiName, X ()
tiAction))
noAction :: Topic -> Dir -> TopicItem
noAction :: Topic -> Topic -> TopicItem
noAction Topic
n Topic
d = Topic -> Topic -> X () -> TopicItem
TI Topic
n Topic
d (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
inHome :: Topic -> X () -> TopicItem
inHome :: Topic -> X () -> TopicItem
inHome Topic
n = Topic -> Topic -> X () -> TopicItem
TI Topic
n Topic
"."