    {-# LANGUAGE DeriveDataTypeable #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Actions.TopicSpace
    -- 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
       Topic
      , Dir
      , TopicConfig(..)
      , def
      , defaultTopicConfig
      , getLastFocusedTopics
      , setLastFocusedTopic
      , reverseLastFocusedTopics
      , pprWindowSet
      , topicActionWithPrompt
      , topicAction
      , currentTopicAction
      , switchTopic
      , switchNthLastFocused
      , shiftNthLastFocused
      , currentTopicDir
      , checkTopicConfig
      , (>*>)
      )
    where

    import XMonad

    import Data.List
    import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
    import Data.Ord
    import qualified Data.Map as M
    import Control.Monad (liftM2,when,unless,replicateM_)
    import System.IO

    import qualified XMonad.StackSet as W

    import XMonad.Prompt
    import XMonad.Prompt.Workspace

    import XMonad.Hooks.UrgencyHook
    import XMonad.Hooks.DynamicLog (PP(..))
    import qualified XMonad.Hooks.DynamicLog as DL

    import XMonad.Util.Run (spawnPipe)
    import qualified XMonad.Util.ExtensibleState as XS

    -- $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.

    -- $usage
    -- Here is an example of configuration using TopicSpace:
    --
    -- > -- The list of all topics/workspaces of your xmonad configuration.
    -- > -- The order is important, new topics must be inserted
    -- > -- at the end of the list if you want hot-restarting
    -- > -- to work.
    -- > myTopics :: [Topic]
    -- > myTopics =
    -- >   [ "dashboard" -- the first one
    -- >   , "admin", "build", "cleaning", "conf", "darcs", "haskell", "irc"
    -- >   , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
    -- >   , "yi", "documents", "twitter", "pdf"
    -- >   ]
    -- >
    -- > myTopicConfig :: TopicConfig
    -- > myTopicConfig = def
    -- >   { topicDirs = M.fromList $
    -- >       [ ("conf", "w/conf")
    -- >       , ("dashboard", "Desktop")
    -- >       , ("yi", "w/dev-haskell/yi")
    -- >       , ("darcs", "w/dev-haskell/darcs")
    -- >       , ("haskell", "w/dev-haskell")
    -- >       , ("xmonad", "w/dev-haskell/xmonad")
    -- >       , ("tools", "w/tools")
    -- >       , ("movie", "Movies")
    -- >       , ("talk", "w/talks")
    -- >       , ("music", "Music")
    -- >       , ("documents", "w/documents")
    -- >       , ("pdf", "w/documents")
    -- >       ]
    -- >   , defaultTopicAction = const $ spawnShell >*> 3
    -- >   , defaultTopic = "dashboard"
    -- >   , topicActions = M.fromList $
    -- >       [ ("conf",       spawnShell >> spawnShellIn "wd/ertai/private")
    -- >       , ("darcs",      spawnShell >*> 3)
    -- >       , ("yi",         spawnShell >*> 3)
    -- >       , ("haskell",    spawnShell >*> 2 >>
    -- >                        spawnShellIn "wd/dev-haskell/ghc")
    -- >       , ("xmonad",     spawnShellIn "wd/x11-wm/xmonad" >>
    -- >                        spawnShellIn "wd/x11-wm/xmonad/contrib" >>
    -- >                        spawnShellIn "wd/x11-wm/xmonad/utils" >>
    -- >                        spawnShellIn ".xmonad" >>
    -- >                        spawnShellIn ".xmonad")
    -- >       , ("mail",       mailAction)
    -- >       , ("irc",        ssh somewhere)
    -- >       , ("admin",      ssh somewhere >>
    -- >                        ssh nowhere)
    -- >       , ("dashboard",  spawnShell)
    -- >       , ("twitter",    spawnShell)
    -- >       , ("web",        spawn browserCmd)
    -- >       , ("movie",      spawnShell)
    -- >       , ("documents",  spawnShell >*> 2 >>
    -- >                        spawnShellIn "Documents" >*> 2)
    -- >       , ("pdf",        spawn pdfViewerCmd)
    -- >       ]
    -- >   }
    -- >
    -- > -- extend your keybindings
    -- > myKeys conf@XConfig{modMask=modm} =
    -- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
    -- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
    -- >   , ((modm              , xK_g     ), promptedGoto)
    -- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)
    -- >   {- more  keys ... -}
    -- >   ]
    -- >   ++
    -- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)
    -- >   | (i, k) <- zip [1..] workspaceKeys]
    -- >
    -- > spawnShell :: X ()
    -- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
    -- >
    -- > spawnShellIn :: Dir -> X ()
    -- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
    -- >
    -- > goto :: Topic -> X ()
    -- > goto = switchTopic myTopicConfig
    -- >
    -- > promptedGoto :: X ()
    -- > promptedGoto = workspacePrompt myXPConfig goto
    -- >
    -- > promptedShift :: X ()
    -- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
    -- >
    -- > myConfig = do
    -- >     checkTopicConfig myTopics myTopicConfig
    -- >     myLogHook <- makeMyLogHook
    -- >     return $ def
    -- >          { borderWidth = 1 -- Width of the window border in pixels.
    -- >          , workspaces = myTopics
    -- >          , layoutHook = myModifiers myLayout
    -- >          , manageHook = myManageHook
    -- >          , logHook = myLogHook
    -- >          , handleEventHook = myHandleEventHook
    -- >          , terminal = myTerminal -- The preferred terminal program.
    -- >          , normalBorderColor = "#3f3c6d"
    -- >          , focusedBorderColor = "#4f66ff"
    -- >          , XMonad.modMask = mod1Mask
    -- >          , keys = myKeys
    -- >          , mouseBindings = myMouseBindings
    -- >          }
    -- >
    -- > main :: IO ()
    -- > main = xmonad =<< myConfig

    -- | An alias for @flip replicateM_@
    (>*>) :: Monad m => m a -> Int -> m ()
    >*> :: m a -> Int -> m ()
    (>*>) = (Int -> m a -> m ()) -> m a -> Int -> m ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Int -> m a -> m ()
    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 points to a directory.
    type Dir = FilePath

    -- | Here is the topic space configuration area.
    data TopicConfig = TopicConfig { TopicConfig -> Map Topic Topic
    topicDirs          :: M.Map Topic Dir
                                     -- ^ This mapping associate a directory to each topic.
                                   , TopicConfig -> Map Topic (X ())
    topicActions       :: M.Map Topic (X ())
                                     -- ^ This mapping associate 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 topic.
                                   , TopicConfig -> Int
    maxTopicHistory    :: Int
                                     -- ^ This setups the maximum depth of topic history, usually
                                     -- 10 is a good default since we can bind all of them using
                                     -- numeric keypad.
                                   }

    instance Default TopicConfig where
        def :: TopicConfig
    def            = TopicConfig :: Map Topic Topic
    -> Map Topic (X ())
    -> (Topic -> X ())
    -> Topic
    -> Int
    -> TopicConfig
    TopicConfig { topicDirs :: Map Topic Topic
    topicDirs = Map Topic Topic
    forall k a. Map k a
    M.empty
                                     , topicActions :: Map Topic (X ())
    topicActions = Map Topic (X ())
    forall k a. Map k a
    M.empty
                                     , defaultTopicAction :: Topic -> X ()
    defaultTopicAction = X () -> Topic -> X ()
    forall a b. a -> b -> a
    const (X XConf
    forall r (m :: * -> *). MonadReader r m => m r
    ask X XConf -> (XConf -> X ()) -> X ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Topic -> X ()
    forall (m :: * -> *). MonadIO m => Topic -> m ()
    spawn (Topic -> X ()) -> (XConf -> Topic) -> XConf -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConfig Layout -> Topic
    forall (l :: * -> *). XConfig l -> Topic
    terminal (XConfig Layout -> Topic)
    -> (XConf -> XConfig Layout) -> XConf -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XConf -> XConfig Layout
    config)
                                     , defaultTopic :: Topic
    defaultTopic = "1"
                                     , maxTopicHistory :: Int
    maxTopicHistory = 10
                                     }

    {-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
    defaultTopicConfig :: TopicConfig
    defaultTopicConfig :: TopicConfig
    defaultTopicConfig = TopicConfig
    forall a. Default a => a
    def

    newtype PrevTopics = PrevTopics { PrevTopics -> [Topic]
    getPrevTopics :: [String] } deriving (ReadPrec [PrevTopics]
    ReadPrec PrevTopics
    Int -> ReadS PrevTopics
    ReadS [PrevTopics]
    (Int -> ReadS PrevTopics)
    -> ReadS [PrevTopics]
    -> ReadPrec PrevTopics
    -> ReadPrec [PrevTopics]
    -> Read PrevTopics
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    readListPrec :: ReadPrec [PrevTopics]
    $creadListPrec :: ReadPrec [PrevTopics]
    readPrec :: ReadPrec PrevTopics
    $creadPrec :: ReadPrec PrevTopics
    readList :: ReadS [PrevTopics]
    $creadList :: ReadS [PrevTopics]
    readsPrec :: Int -> ReadS PrevTopics
    $creadsPrec :: Int -> ReadS PrevTopics
    Read,Int -> PrevTopics -> ShowS
    [PrevTopics] -> ShowS
    PrevTopics -> Topic
    (Int -> PrevTopics -> ShowS)
    -> (PrevTopics -> Topic)
    -> ([PrevTopics] -> ShowS)
    -> Show PrevTopics
    forall a.
    (Int -> a -> ShowS) -> (a -> Topic) -> ([a] -> ShowS) -> Show a
    showList :: [PrevTopics] -> ShowS
    $cshowList :: [PrevTopics] -> ShowS
    show :: PrevTopics -> Topic
    $cshow :: PrevTopics -> Topic
    showsPrec :: Int -> PrevTopics -> ShowS
    $cshowsPrec :: Int -> PrevTopics -> ShowS
    Show,Typeable)
    instance ExtensionClass PrevTopics where
        initialValue :: PrevTopics
    initialValue = [Topic] -> PrevTopics
    PrevTopics []
        extensionType :: PrevTopics -> StateExtension
    extensionType = PrevTopics -> StateExtension
    forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
    PersistentExtension

    -- | Returns the list of last focused workspaces the empty list otherwise.
    getLastFocusedTopics :: X [String]
    getLastFocusedTopics :: X [Topic]
    getLastFocusedTopics = (PrevTopics -> [Topic]) -> X [Topic]
    forall a (m :: * -> *) b.
    (ExtensionClass a, XLike m) =>
    (a -> b) -> m b
    XS.gets PrevTopics -> [Topic]
    getPrevTopics

    -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
    -- select topics that one want to keep, this function will set the property
    -- of last focused topics.
    setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
    setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
    setLastFocusedTopic w :: Topic
    w predicate :: Topic -> Bool
    predicate =
      (PrevTopics -> PrevTopics) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ((PrevTopics -> PrevTopics) -> X ())
    -> (PrevTopics -> PrevTopics) -> X ()
    forall a b. (a -> b) -> a -> b
    $ [Topic] -> PrevTopics
    PrevTopics
        ([Topic] -> PrevTopics)
    -> (PrevTopics -> [Topic]) -> PrevTopics -> PrevTopics
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Topic] -> [Topic]
    forall (t :: * -> *) a. Foldable t => t a -> t a
    seqList ([Topic] -> [Topic])
    -> (PrevTopics -> [Topic]) -> PrevTopics -> [Topic]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Topic] -> [Topic]
    forall a. Eq a => [a] -> [a]
    nub ([Topic] -> [Topic])
    -> (PrevTopics -> [Topic]) -> PrevTopics -> [Topic]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Topic
    wTopic -> [Topic] -> [Topic]
    forall a. a -> [a] -> [a]
    :) ([Topic] -> [Topic])
    -> (PrevTopics -> [Topic]) -> PrevTopics -> [Topic]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Topic -> Bool) -> [Topic] -> [Topic]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Topic -> Bool
    predicate
        ([Topic] -> [Topic])
    -> (PrevTopics -> [Topic]) -> PrevTopics -> [Topic]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrevTopics -> [Topic]
    getPrevTopics
      where seqList :: t a -> t a
    seqList xs :: t a
    xs = t a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length t a
    xs Int -> t a -> t a
    forall a b. a -> b -> b
    `seq` t a
    xs

    -- | Reverse the list of "last focused topics"
    reverseLastFocusedTopics :: X ()
    reverseLastFocusedTopics :: X ()
    reverseLastFocusedTopics =
      (PrevTopics -> PrevTopics) -> X ()
    forall a (m :: * -> *).
    (ExtensionClass a, XLike m) =>
    (a -> a) -> m ()
    XS.modify ((PrevTopics -> PrevTopics) -> X ())
    -> (PrevTopics -> PrevTopics) -> X ()
    forall a b. (a -> b) -> a -> b
    $ [Topic] -> PrevTopics
    PrevTopics ([Topic] -> PrevTopics)
    -> (PrevTopics -> [Topic]) -> PrevTopics -> PrevTopics
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Topic] -> [Topic]
    forall a. [a] -> [a]
    reverse ([Topic] -> [Topic])
    -> (PrevTopics -> [Topic]) -> PrevTopics -> [Topic]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PrevTopics -> [Topic]
    getPrevTopics

    -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
    -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
    -- and highlighting topics with urgent windows.
    pprWindowSet :: TopicConfig -> PP -> X String
    pprWindowSet :: TopicConfig -> PP -> X Topic
    pprWindowSet tg :: TopicConfig
    tg pp :: PP
    pp = do
        WindowSet
    winset <- (XState -> WindowSet) -> X WindowSet
    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 = (Workspace Topic (Layout Window) Window -> Topic)
    -> [Workspace Topic (Layout Window) Window] -> [Topic]
    forall a b. (a -> b) -> [a] -> [b]
    map Workspace Topic (Layout Window) Window -> Topic
    forall i l a. Workspace i l a -> i
    W.tag ([Workspace Topic (Layout Window) Window] -> [Topic])
    -> [Workspace Topic (Layout Window) Window] -> [Topic]
    forall a b. (a -> b) -> a -> b
    $ (Workspace Topic (Layout Window) Window -> Bool)
    -> [Workspace Topic (Layout Window) Window]
    -> [Workspace Topic (Layout Window) Window]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Maybe (Stack Window) -> Bool
    forall a. Maybe a -> Bool
    isNothing (Maybe (Stack Window) -> Bool)
    -> (Workspace Topic (Layout Window) Window -> Maybe (Stack Window))
    -> Workspace Topic (Layout Window) Window
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace Topic (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack) ([Workspace Topic (Layout Window) Window]
     -> [Workspace Topic (Layout Window) Window])
    -> [Workspace Topic (Layout Window) Window]
    -> [Workspace Topic (Layout Window) Window]
    forall a b. (a -> b) -> a -> b
    $ WindowSet -> [Workspace Topic (Layout Window) Window]
    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
        Topic -> (Topic -> Bool) -> X ()
    setLastFocusedTopic (Workspace Topic (Layout Window) Window -> Topic
    forall i l a. Workspace i l a -> i
    W.tag (Workspace Topic (Layout Window) Window -> Topic)
    -> (WindowSet -> Workspace Topic (Layout Window) Window)
    -> WindowSet
    -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen Topic (Layout Window) Window ScreenId ScreenDetail
    -> Workspace Topic (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen Topic (Layout Window) Window ScreenId ScreenDetail
     -> Workspace Topic (Layout Window) Window)
    -> (WindowSet
        -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> WindowSet
    -> Workspace Topic (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (WindowSet -> Topic) -> WindowSet -> Topic
    forall a b. (a -> b) -> a -> b
    $ WindowSet
    winset)
                            (Topic -> [Topic] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [Topic]
    empty_workspaces)
        [Topic]
    lastWs <- X [Topic]
    getLastFocusedTopics
        let depth :: Topic -> Int
    depth topic :: Topic
    topic = Maybe Int -> Int
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Topic -> [Topic] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Topic
    topic ([Topic]
    lastWs [Topic] -> [Topic] -> [Topic]
    forall a. [a] -> [a] -> [a]
    ++ [Topic
    topic])
            add_depth :: (PP -> Topic -> c) -> Topic -> c
    add_depth proj :: PP -> Topic -> c
    proj topic :: Topic
    topic = PP -> Topic -> c
    proj PP
    pp (Topic -> c) -> ShowS -> Topic -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (((Topic
    topicTopic -> ShowS
    forall a. [a] -> [a] -> [a]
    ++":")Topic -> ShowS
    forall a. [a] -> [a] -> [a]
    ++) ShowS -> (Int -> Topic) -> Int -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Topic
    forall a. Show a => a -> Topic
    show) (Int -> Topic) -> (Topic -> Int) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Topic -> Int
    depth (Topic -> c) -> Topic -> c
    forall a b. (a -> b) -> a -> b
    $ Topic
    topic
            pp' :: PP
    pp' = PP
    pp { ppHidden :: ShowS
    ppHidden = (PP -> ShowS) -> ShowS
    forall c. (PP -> Topic -> c) -> Topic -> c
    add_depth PP -> ShowS
    ppHidden, ppVisible :: ShowS
    ppVisible = (PP -> ShowS) -> ShowS
    forall c. (PP -> Topic -> c) -> Topic -> c
    add_depth PP -> ShowS
    ppVisible }
            sortWindows :: [Workspace Topic l a] -> [Workspace Topic l a]
    sortWindows = Int -> [Workspace Topic l a] -> [Workspace Topic l a]
    forall a. Int -> [a] -> [a]
    take Int
    maxDepth ([Workspace Topic l a] -> [Workspace Topic l a])
    -> ([Workspace Topic l a] -> [Workspace Topic l a])
    -> [Workspace Topic l a]
    -> [Workspace Topic l a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Workspace Topic l a -> Workspace Topic l a -> Ordering)
    -> [Workspace Topic l a] -> [Workspace Topic l a]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((Workspace Topic l a -> Int)
    -> Workspace Topic l a -> Workspace Topic l a -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ((Workspace Topic l a -> Int)
     -> Workspace Topic l a -> Workspace Topic l a -> Ordering)
    -> (Workspace Topic l a -> Int)
    -> Workspace Topic l a
    -> Workspace Topic l a
    -> Ordering
    forall a b. (a -> b) -> a -> b
    $ Topic -> Int
    depth (Topic -> Int)
    -> (Workspace Topic l a -> Topic) -> Workspace Topic l a -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace Topic l a -> Topic
    forall i l a. Workspace i l a -> i
    W.tag)
        Topic -> X Topic
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Topic -> X Topic) -> Topic -> X Topic
    forall a b. (a -> b) -> a -> b
    $ ([Workspace Topic (Layout Window) Window]
     -> [Workspace Topic (Layout Window) Window])
    -> [Window] -> PP -> WindowSet -> Topic
    DL.pprWindowSet [Workspace Topic (Layout Window) Window]
    -> [Workspace Topic (Layout Window) Window]
    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, triggers the action associated with
    -- the topic given in prompt.
    topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
    topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
    topicActionWithPrompt xp :: XPConfig
    xp tg :: TopicConfig
    tg = XPConfig -> (Topic -> X ()) -> X ()
    workspacePrompt XPConfig
    xp ((X () -> X () -> X ())
    -> (Topic -> X ()) -> (Topic -> X ()) -> Topic -> X ()
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 X () -> X () -> X ()
    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, triggers the action associated with the given topic.
    topicAction :: TopicConfig -> Topic -> X ()
    topicAction :: TopicConfig -> Topic -> X ()
    topicAction tg :: TopicConfig
    tg topic :: Topic
    topic = X () -> Maybe (X ()) -> X ()
    forall a. a -> Maybe a -> a
    fromMaybe (TopicConfig -> Topic -> X ()
    defaultTopicAction TopicConfig
    tg Topic
    topic) (Maybe (X ()) -> X ()) -> Maybe (X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Topic -> Map Topic (X ()) -> Maybe (X ())
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Topic
    topic (Map Topic (X ()) -> Maybe (X ()))
    -> Map Topic (X ()) -> Maybe (X ())
    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 tg :: TopicConfig
    tg = TopicConfig -> Topic -> X ()
    topicAction TopicConfig
    tg (Topic -> X ()) -> X Topic -> X ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (XState -> Topic) -> X Topic
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Workspace Topic (Layout Window) Window -> Topic
    forall i l a. Workspace i l a -> i
    W.tag (Workspace Topic (Layout Window) Window -> Topic)
    -> (XState -> Workspace Topic (Layout Window) Window)
    -> XState
    -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen Topic (Layout Window) Window ScreenId ScreenDetail
    -> Workspace Topic (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen Topic (Layout Window) Window ScreenId ScreenDetail
     -> Workspace Topic (Layout Window) Window)
    -> (XState
        -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace Topic (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (WindowSet
     -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> (XState -> WindowSet)
    -> XState
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    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 tg :: TopicConfig
    tg topic :: Topic
    topic = do
      (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (WindowSet -> WindowSet) -> X ()
    forall a b. (a -> b) -> a -> b
    $ Topic -> WindowSet -> WindowSet
    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 <- (XState -> [Window]) -> X [Window]
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Maybe (Stack Window) -> [Window]
    forall a. Maybe (Stack a) -> [a]
    W.integrate' (Maybe (Stack Window) -> [Window])
    -> (XState -> Maybe (Stack Window)) -> XState -> [Window]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Workspace Topic (Layout Window) Window -> Maybe (Stack Window)
    forall i l a. Workspace i l a -> Maybe (Stack a)
    W.stack (Workspace Topic (Layout Window) Window -> Maybe (Stack Window))
    -> (XState -> Workspace Topic (Layout Window) Window)
    -> XState
    -> Maybe (Stack Window)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen Topic (Layout Window) Window ScreenId ScreenDetail
    -> Workspace Topic (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen Topic (Layout Window) Window ScreenId ScreenDetail
     -> Workspace Topic (Layout Window) Window)
    -> (XState
        -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace Topic (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (WindowSet
     -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> (XState -> WindowSet)
    -> XState
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> WindowSet
    windowset)
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Window] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Window]
    wins) (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ TopicConfig -> Topic -> X ()
    topicAction TopicConfig
    tg Topic
    topic

    -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
    switchNthLastFocused :: TopicConfig -> Int -> X ()
    switchNthLastFocused :: TopicConfig -> Int -> X ()
    switchNthLastFocused tg :: TopicConfig
    tg depth :: Int
    depth = do
      [Topic]
    lastWs <- X [Topic]
    getLastFocusedTopics
      TopicConfig -> Topic -> X ()
    switchTopic TopicConfig
    tg (Topic -> X ()) -> Topic -> X ()
    forall a b. (a -> b) -> a -> b
    $ ([Topic]
    lastWs [Topic] -> [Topic] -> [Topic]
    forall a. [a] -> [a] -> [a]
    ++ Topic -> [Topic]
    forall a. a -> [a]
    repeat (TopicConfig -> Topic
    defaultTopic TopicConfig
    tg)) [Topic] -> Int -> Topic
    forall a. [a] -> Int -> a
    !! Int
    depth

    -- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
    shiftNthLastFocused :: Int -> X ()
    shiftNthLastFocused :: Int -> X ()
    shiftNthLastFocused n :: Int
    n = do
      Maybe Topic
    ws <- ([Topic] -> Maybe Topic) -> X [Topic] -> X (Maybe Topic)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Topic] -> Maybe Topic
    forall a. [a] -> Maybe a
    listToMaybe ([Topic] -> Maybe Topic)
    -> ([Topic] -> [Topic]) -> [Topic] -> Maybe Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [Topic] -> [Topic]
    forall a. Int -> [a] -> [a]
    drop Int
    n) X [Topic]
    getLastFocusedTopics
      Maybe Topic -> (Topic -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust Maybe Topic
    ws ((Topic -> X ()) -> X ()) -> (Topic -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ (WindowSet -> WindowSet) -> X ()
    windows ((WindowSet -> WindowSet) -> X ())
    -> (Topic -> WindowSet -> WindowSet) -> Topic -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Topic -> WindowSet -> WindowSet
    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

    -- | Returns the directory associated with current topic returns the empty string otherwise.
    currentTopicDir :: TopicConfig -> X String
    currentTopicDir :: TopicConfig -> X Topic
    currentTopicDir tg :: TopicConfig
    tg = do
      Topic
    topic <- (XState -> Topic) -> X Topic
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Workspace Topic (Layout Window) Window -> Topic
    forall i l a. Workspace i l a -> i
    W.tag (Workspace Topic (Layout Window) Window -> Topic)
    -> (XState -> Workspace Topic (Layout Window) Window)
    -> XState
    -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Screen Topic (Layout Window) Window ScreenId ScreenDetail
    -> Workspace Topic (Layout Window) Window
    forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
    W.workspace (Screen Topic (Layout Window) Window ScreenId ScreenDetail
     -> Workspace Topic (Layout Window) Window)
    -> (XState
        -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> XState
    -> Workspace Topic (Layout Window) Window
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WindowSet
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
    W.current (WindowSet
     -> Screen Topic (Layout Window) Window ScreenId ScreenDetail)
    -> (XState -> WindowSet)
    -> XState
    -> Screen Topic (Layout Window) Window ScreenId ScreenDetail
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XState -> WindowSet
    windowset)
      Topic -> X Topic
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Topic -> X Topic)
    -> (Map Topic Topic -> Topic) -> Map Topic Topic -> X Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Topic -> Maybe Topic -> Topic
    forall a. a -> Maybe a -> a
    fromMaybe "" (Maybe Topic -> Topic)
    -> (Map Topic Topic -> Maybe Topic) -> Map Topic Topic -> Topic
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Topic -> Map Topic Topic -> Maybe Topic
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup Topic
    topic (Map Topic Topic -> X Topic) -> Map Topic Topic -> X Topic
    forall a b. (a -> b) -> a -> b
    $ TopicConfig -> Map Topic Topic
    topicDirs TopicConfig
    tg

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

        let
          seenTopics :: [Topic]
    seenTopics = [Topic] -> [Topic]
    forall a. Eq a => [a] -> [a]
    nub ([Topic] -> [Topic]) -> [Topic] -> [Topic]
    forall a b. (a -> b) -> a -> b
    $ [Topic] -> [Topic]
    forall a. Ord a => [a] -> [a]
    sort ([Topic] -> [Topic]) -> [Topic] -> [Topic]
    forall a b. (a -> b) -> a -> b
    $ Map Topic Topic -> [Topic]
    forall k a. Map k a -> [k]
    M.keys (TopicConfig -> Map Topic Topic
    topicDirs TopicConfig
    tg) [Topic] -> [Topic] -> [Topic]
    forall a. [a] -> [a] -> [a]
    ++ Map Topic (X ()) -> [Topic]
    forall k a. Map k a -> [k]
    M.keys (TopicConfig -> Map Topic (X ())
    topicActions TopicConfig
    tg)
          dups :: [Topic]
    dups       = [Topic]
    tags [Topic] -> [Topic] -> [Topic]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [Topic] -> [Topic]
    forall a. Eq a => [a] -> [a]
    nub [Topic]
    tags
          diffTopic :: [Topic]
    diffTopic  = [Topic]
    seenTopics [Topic] -> [Topic] -> [Topic]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [Topic] -> [Topic]
    forall a. Ord a => [a] -> [a]
    sort [Topic]
    tags
          check :: t a -> Topic -> IO ()
    check lst :: t a
    lst msg :: Topic
    msg = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (t a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null t a
    lst) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Topic -> IO ()
    xmessage (Topic -> IO ()) -> Topic -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Topic
    msg Topic -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " (tags): " Topic -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ t a -> Topic
    forall a. Show a => a -> Topic
    show t a
    lst

        [Topic] -> Topic -> IO ()
    forall (t :: * -> *) a.
    (Foldable t, Show (t a)) =>
    t a -> Topic -> IO ()
    check [Topic]
    diffTopic "Seen but missing topics/workspaces"
        [Topic] -> Topic -> IO ()
    forall (t :: * -> *) a.
    (Foldable t, Show (t a)) =>
    t a -> Topic -> IO ()
    check [Topic]
    dups      "Duplicate topics/workspaces"

    -- | Display the given message using the @xmessage@ program.
    xmessage :: String -> IO ()
    xmessage :: Topic -> IO ()
    xmessage s :: Topic
    s = do
      Handle
    h <- Topic -> IO Handle
    forall (m :: * -> *). MonadIO m => Topic -> m Handle
    spawnPipe "xmessage -file -"
      Handle -> Topic -> IO ()
    hPutStr Handle
    h Topic
    s
      Handle -> IO ()
    hClose Handle
    h