{-# LANGUAGE NamedFieldPuns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.TopicSpace
-- Description :  Turns your workspaces into a more topic oriented system.
-- Copyright   :  (c) Nicolas Pouillard
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Nicolas Pouillard <nicolas.pouillard@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Turns your workspaces into a more topic oriented system.
-----------------------------------------------------------------------------

module XMonad.Actions.TopicSpace
  (
  -- * Overview
  -- $overview

  -- * Usage
  -- $usage

  -- * Types for Building Topics
    Topic
  , Dir
  , TopicConfig(..)
  , TopicItem(..)

    -- * Managing 'TopicItem's
  , topicNames
  , tiActions
  , tiDirs
  , noAction
  , inHome

    -- * Switching and Shifting Topics
  , switchTopic
  , switchNthLastFocused
  , switchNthLastFocusedByScreen
  , switchNthLastFocusedExclude
  , shiftNthLastFocused

    -- * Topic Actions
  , topicActionWithPrompt
  , topicAction
  , currentTopicAction

    -- * Getting the Topic History
  , getLastFocusedTopics
  , workspaceHistory
  , workspaceHistoryByScreen

    -- * Modifying the Topic History
  , setLastFocusedTopic
  , reverseLastFocusedTopics

    -- * History hooks
  , workspaceHistoryHook
  , workspaceHistoryHookExclude

    -- * Pretty Printing
  , pprWindowSet

    -- * Utility
  , 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
    )

-- $overview
-- This module allows to organize your workspaces on a precise topic basis.  So
-- instead of having a workspace called `work' you can setup one workspace per
-- task.  Here we call these workspaces, topics. The great thing with
-- topics is that one can attach a directory that makes sense to each
-- particular topic.  One can also attach an action which will be triggered
-- when switching to a topic that does not have any windows in it.  So you can
-- attach your mail client to the mail topic, some terminals in the right
-- directory to the xmonad topic... This package also provides a nice way to
-- display your topics in an historical way using a custom `pprWindowSet'
-- function. You can also easily switch to recent topics using this history
-- of last focused topics.
--
-- A blog post highlighting some features of this module can be found
-- <https://tony-zorman.com/posts/topic-space/2022-09-11-topic-spaces.html here>.

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import qualified Data.Map.Strict as M
-- > import qualified XMonad.StackSet as W
-- >
-- > import XMonad.Actions.TopicSpace
-- > import XMonad.Util.EZConfig    -- for the keybindings
-- > import XMonad.Prompt.Workspace -- if you want to use the prompt
--
-- You will then have to
--
--   * Define a new 'TopicConfig' via 'TopicItem's
--
--   * Add the appropriate keybindings
--
--   * Replace the @workspaces@ field in your 'XConfig' with a list of
--     your topics names
--
--   * Optionally, if you want to use the history features, add
--     'workspaceHistoryHook' from "XMonad.Hooks.WorkspaceHistory"
--     (re-exported by this module) or an equivalent function to your
--     @logHook@.  See the documentation of
--     "XMonad.Hooks.WorkspaceHistory" for further details
--
-- Let us go through a full example together.
--
-- A 'TopicItem' consists of three things: the name of the topic, its
-- root directory, and the action associated to it—to be executed if the
-- topic is empty or the action is forced via a keybinding.
--
-- We start by specifying our chosen topics as a list of such
-- 'TopicItem's:
--
-- > topicItems :: [TopicItem]
-- > topicItems =
-- >   [ inHome   "1:WEB"              (spawn "firefox")
-- >   , noAction "2"      "."
-- >   , noAction "3:VID"  "videos"
-- >   , TI       "4:VPN"  "openvpn"   (spawn "urxvt -e randomVPN.sh")
-- >   , inHome   "5:IM"               (spawn "signal" *> spawn "telegram")
-- >   , inHome   "6:IRC"              (spawn "urxvt -e weechat")
-- >   , TI       "dts"    ".dotfiles" spawnShell
-- >   , TI       "xm-con" "hs/xm-con" (spawnShell *> spawnShellIn "hs/xm")
-- >   ]
--
-- Then we just need to put together our topic config:
--
-- > myTopicConfig :: TopicConfig
-- > myTopicConfig = def
-- >   { topicDirs          = tiDirs    topicItems
-- >   , topicActions       = tiActions topicItems
-- >   , defaultTopicAction = const (pure ()) -- by default, do nothing
-- >   , defaultTopic       = "1:WEB"         -- fallback
-- >   }
--
-- Above, we have used the `spawnShell` and `spawnShellIn` helper
-- functions; here they are:
--
-- > spawnShell :: X ()
-- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
-- >
-- > spawnShellIn :: Dir -> X ()
-- > spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
--
-- Next, we define some other other useful helper functions.  It is
-- rather common to have a lot of topics—much more than available keys!
-- In a situation like that, it's very convenient to switch topics with
-- a prompt; the following use of 'workspacePrompt' does exactly that.
--
-- > goto :: Topic -> X ()
-- > goto = switchTopic myTopicConfig
-- >
-- > promptedGoto :: X ()
-- > promptedGoto = workspacePrompt def goto
-- >
-- > promptedShift :: X ()
-- > promptedShift = workspacePrompt def $ windows . W.shift
-- >
-- > -- Toggle between the two most recently used topics, but keep
-- > -- screens separate.  This needs @workspaceHistoryHook@.
-- > toggleTopic :: X ()
-- > toggleTopic = switchNthLastFocusedByScreen myTopicConfig 1
--
-- Hopefully you've gotten a general feeling of how to define these kind of
-- small helper functions using what's provided in this module.
--
-- Adding the appropriate keybindings works as it normally would.  Here,
-- we'll use "XMonad.Util.EZConfig" syntax:
--
-- > myKeys :: [(String, X ())]
-- > myKeys =
-- >   [ ("M-n"        , spawnShell)
-- >   , ("M-a"        , currentTopicAction myTopicConfig)
-- >   , ("M-g"        , promptedGoto)
-- >   , ("M-S-g"      , promptedShift)
-- >   , ("M-S-<Space>", toggleTopic)
-- >   ]
-- >   ++
-- >   -- The following does two things:
-- >   --   1. Switch topics (no modifier)
-- >   --   2. Move focused window to topic N (shift modifier)
-- >   [ ("M-" ++ m ++ k, f i)
-- >   | (i, k) <- zip (topicNames topicItems) (map show [1 .. 9 :: Int])
-- >   , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
-- >   ]
--
-- This makes @M-1@ to @M-9@ switch to the first nine topics that we
-- have specified in @topicItems@.
--
-- You can also switch to the nine last-used topics instead:
--
-- >   [ ("M-" ++ show i, switchNthLastFocused myTopicConfig i)
-- >   | i <- [1 .. 9]
-- >   ]
--
-- We can now put the whole configuration together with the following:
--
-- > main :: IO ()
-- > main = xmonad $ def
-- >   { workspaces = topicNames topicItems
-- >   }
-- >  `additionalKeysP` myKeys

-- | An alias for @flip replicateM_@
(>*>) :: 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 >*>

-- | 'Topic' is just an alias for 'WorkspaceId'
type Topic = WorkspaceId

-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
type Dir = FilePath

-- | Here is the topic space configuration area.
data TopicConfig = TopicConfig { TopicConfig -> Map Topic Topic
topicDirs          :: Map Topic Dir
                                 -- ^ This mapping associates a directory to each topic.
                               , TopicConfig -> Map Topic (X ())
topicActions       :: Map Topic (X ())
                                 -- ^ This mapping associates an action to trigger when
                                 -- switching to a given topic which workspace is empty.
                               , TopicConfig -> Topic -> X ()
defaultTopicAction :: Topic -> X ()
                                 -- ^ This is the default topic action.
                               , TopicConfig -> Topic
defaultTopic       :: Topic
                                 -- ^ This is the default (= fallback) topic.
                               , TopicConfig -> Int
maxTopicHistory    :: Int
                                 -- ^ This specifies the maximum depth of the topic history;
                                 -- usually 10 is a good default since we can bind all of
                                 -- them using numeric keypad.
                               }
{-# 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
                               }

-- | Return the (possibly empty) list of last focused topics.
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics :: X [Topic]
getLastFocusedTopics = X [Topic]
workspaceHistory
{-# DEPRECATED getLastFocusedTopics "Use XMonad.Hooks.WorkspaceHistory.workspaceHistory (re-exported by this module) instead" #-}

-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
-- wants to keep, this function will cons the topic in front of the list of
-- last focused topics and filter it according to the predicate.  Note that we
-- prune the list in case that its length exceeds 'maxTopicHistory'.
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" #-}

-- | Reverse the list of "last focused topics"
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics :: X ()
reverseLastFocusedTopics = ([(ScreenId, Topic)] -> [(ScreenId, Topic)]) -> X ()
workspaceHistoryModify forall a. [a] -> [a]
reverse

-- | This function is a variant of 'SBPP.pprWindowSet' which takes a topic
-- configuration and a pretty-printing record 'PP'. It will show the list of
-- topics sorted historically and highlight topics with urgent windows.
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

-- | Given a prompt configuration and a topic configuration, trigger the action associated with
-- the topic given in prompt.
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))

-- | Given a configuration and a topic, trigger the action associated with the given topic.
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

-- | Trigger the action associated with the current topic.
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)

-- | Switch to the given topic.
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic :: TopicConfig -> Topic -> X ()
switchTopic TopicConfig
tc Topic
topic = do
  -- Switch to topic and add it to the last seen topics
  (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

  -- If applicable, execute the topic action
  [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

-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused :: TopicConfig -> Int -> X ()
switchNthLastFocused = [Topic] -> TopicConfig -> Int -> X ()
switchNthLastFocusedExclude []

-- | Like 'switchNthLastFocused', but also filter out certain topics.
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

-- | Like 'switchNthLastFocused', but only consider topics that used to
-- be on the current screen.
--
-- For example, the following function allows one to toggle between the
-- currently focused and the last used topic, while treating different
-- screens completely independently from one another.
--
-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
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

-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
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

-- | Return the directory associated with the current topic, or return the empty
-- string if the topic could not be found.
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

-- | Check the given topic configuration for duplicate or undefined topics.
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
checkTopicConfig [Topic]
tags TopicConfig
tg = do
  -- tags <- gets $ map W.tag . workspaces . windowset

  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"

-- | Convenience type for specifying topics.
data TopicItem = TI
  { TopicItem -> Topic
tiName   :: !Topic  -- ^ 'Topic' ≡ 'String'
  , TopicItem -> Topic
tiDir    :: !Dir    -- ^ Directory associated with topic; 'Dir' ≡ 'String'
  , TopicItem -> X ()
tiAction :: !(X ()) -- ^ Startup hook when topic is empty
  }

-- | Extract the names from a given list of 'TopicItem's.
topicNames :: [TopicItem] -> [Topic]
topicNames :: [TopicItem] -> [Topic]
topicNames = forall a b. (a -> b) -> [a] -> [b]
map TopicItem -> Topic
tiName

-- | From a list of 'TopicItem's, build a map that can be supplied as
-- the 'topicDirs'.
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))

-- | From a list of 'TopicItem's, build a map that can be supplied as
-- the 'topicActions'.
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))

-- | Associate a directory with the topic, but don't spawn anything.
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 ())

-- | Topic with @tiDir = ~/@.
inHome :: Topic -> X () -> TopicItem
inHome :: Topic -> X () -> TopicItem
inHome Topic
n = Topic -> Topic -> X () -> TopicItem
TI Topic
n Topic
"."