{-# LANGUAGE DerivingVia #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.WorkspaceHistory
-- Description :  Keep track of workspace viewing order.
-- Copyright   :  (c) 2013 Dmitri Iouchtchenko
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Dmitri Iouchtchenko <johnnyspoon@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Keeps track of workspace viewing order.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.WorkspaceHistory (
      -- * Usage
      -- $usage
      -- * Hooking
    workspaceHistoryHook
  , workspaceHistoryHookExclude
      -- * Querying
  , workspaceHistory
  , workspaceHistoryByScreen
  , workspaceHistoryWithScreen
    -- * Handling edits
  , workspaceHistoryTransaction
  , workspaceHistoryModify
  ) where

import Control.Applicative
import Control.DeepSeq
import Prelude
import XMonad
import XMonad.StackSet hiding (delete, filter, new)
import XMonad.Prelude (delete, find, foldl', groupBy, nub, sortBy)
import qualified XMonad.Util.ExtensibleState as XS

-- $usage
-- To record the order in which you view workspaces, you can use this
-- module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook)
--
-- Then add the hook to your 'logHook':
--
-- >  main = xmonad $ def
-- >      { ...
-- >      , logHook = ... >> workspaceHistoryHook >> ...
-- >      , ...
-- >      }
--
-- If you want to completely exclude certain workspaces from entering
-- the history, you can use 'workspaceHistoryHookExclude' instead.  For
-- example, to ignore the named scratchpad workspace:
--
-- > import XMonad.Util.NamedScratchpad (scratchpadWorkspaceTag)
-- > ...
-- > , logHook = ... >> workspaceHistoryHookExclude [scratchpadWorkspaceTag] >> ...
--
-- To make use of the collected data, a query function is provided.

newtype WorkspaceHistory = WorkspaceHistory
  { WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in
                                         -- reverse-chronological order.
  }
  deriving (ReadPrec [WorkspaceHistory]
ReadPrec WorkspaceHistory
Int -> ReadS WorkspaceHistory
ReadS [WorkspaceHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceHistory]
$creadListPrec :: ReadPrec [WorkspaceHistory]
readPrec :: ReadPrec WorkspaceHistory
$creadPrec :: ReadPrec WorkspaceHistory
readList :: ReadS [WorkspaceHistory]
$creadList :: ReadS [WorkspaceHistory]
readsPrec :: Int -> ReadS WorkspaceHistory
$creadsPrec :: Int -> ReadS WorkspaceHistory
Read, Int -> WorkspaceHistory -> ShowS
[WorkspaceHistory] -> ShowS
WorkspaceHistory -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceHistory] -> ShowS
$cshowList :: [WorkspaceHistory] -> ShowS
show :: WorkspaceHistory -> WorkspaceId
$cshow :: WorkspaceHistory -> WorkspaceId
showsPrec :: Int -> WorkspaceHistory -> ShowS
$cshowsPrec :: Int -> WorkspaceHistory -> ShowS
Show)
  deriving WorkspaceHistory -> ()
forall a. (a -> ()) -> NFData a
rnf :: WorkspaceHistory -> ()
$crnf :: WorkspaceHistory -> ()
NFData via [(Int, WorkspaceId)]

instance ExtensionClass WorkspaceHistory where
    initialValue :: WorkspaceHistory
initialValue = [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory []
    extensionType :: WorkspaceHistory -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | A 'logHook' that keeps track of the order in which workspaces have
-- been viewed.
workspaceHistoryHook :: X ()
workspaceHistoryHook :: X ()
workspaceHistoryHook = [WorkspaceId] -> X ()
workspaceHistoryHookExclude []

-- | Like 'workspaceHistoryHook', but with the ability to exclude
-- certain workspaces.
workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude :: [WorkspaceId] -> X ()
workspaceHistoryHookExclude [WorkspaceId]
ws = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WorkspaceHistory -> WorkspaceHistory
update 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 XState -> WindowSet
windowset
  where
    update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
    update :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
update WindowSet
s = forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude [WorkspaceId]
ws WindowSet
s

workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen = forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history

workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
workspaceHistoryByScreen =
  forall a b. (a -> b) -> [a] -> [b]
map (\[(ScreenId, WorkspaceId)]
wss -> (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(ScreenId, WorkspaceId)]
wss, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(ScreenId, WorkspaceId)]
wss)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a forall a. Eq a => a -> a -> Bool
== forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(ScreenId, WorkspaceId)
a (ScreenId, WorkspaceId)
b -> forall a. Ord a => a -> a -> Ordering
compare (forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
a) forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (ScreenId, WorkspaceId)
b)forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  X [(ScreenId, WorkspaceId)]
workspaceHistoryWithScreen

-- | A list of workspace tags in the order they have been viewed, with the
-- most recent first. No duplicates are present, but not all workspaces are
-- guaranteed to appear, and there may be workspaces that no longer exist.
workspaceHistory :: X [WorkspaceId]
workspaceHistory :: X [WorkspaceId]
workspaceHistory = forall a. Eq a => [a] -> [a]
nub 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 (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 WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history

workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction :: X () -> X ()
workspaceHistoryTransaction X ()
action = do
  [(ScreenId, WorkspaceId)]
startingHistory <- forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history
  X ()
action
  WorkspaceHistory
new <- forall a b c. (a -> b -> c) -> b -> a -> c
flip WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen ([(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory [(ScreenId, WorkspaceId)]
startingHistory) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall a b. (a -> b) -> a -> b
$! forall a. NFData a => a -> a
force WorkspaceHistory
new

-- | Update the last visible workspace on each monitor if needed
-- already there, or move it to the front if it is.
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreen = [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude []

-- | Like 'updateLastActiveOnEachScreen', but with the ability to
-- exclude certain workspaces.
updateLastActiveOnEachScreenExclude :: [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude :: [WorkspaceId] -> WindowSet -> WorkspaceHistory -> WorkspaceHistory
updateLastActiveOnEachScreenExclude [WorkspaceId]
ws StackSet {current :: forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur, visible :: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible = [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis} WorkspaceHistory
wh =
  WorkspaceHistory { history :: [(ScreenId, WorkspaceId)]
history = forall {sid} {l} {a} {sd}.
Eq sid =>
Screen WorkspaceId l a sid sd
-> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
doUpdate Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {sid} {l} {a} {sd}.
Eq sid =>
[(sid, WorkspaceId)]
-> Screen WorkspaceId l a sid sd -> [(sid, WorkspaceId)]
updateLastForScreen (WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history WorkspaceHistory
wh) forall a b. (a -> b) -> a -> b
$ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
vis forall a. [a] -> [a] -> [a]
++ [Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cur] }
  where
    firstOnScreen :: b -> t (b, b) -> Maybe (b, b)
firstOnScreen b
sid = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
== b
sid) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    doUpdate :: Screen WorkspaceId l a sid sd
-> [(sid, WorkspaceId)] -> [(sid, WorkspaceId)]
doUpdate Screen {workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace { tag :: forall i l a. Workspace i l a -> i
tag = WorkspaceId
wid }, screen :: forall i l a sid sd. Screen i l a sid sd -> sid
screen = sid
sid} [(sid, WorkspaceId)]
curr =
      let newEntry :: (sid, WorkspaceId)
newEntry = (sid
sid, WorkspaceId
wid)
       in if WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete (sid, WorkspaceId)
newEntry [(sid, WorkspaceId)]
curr
    updateLastForScreen :: [(sid, WorkspaceId)]
-> Screen WorkspaceId l a sid sd -> [(sid, WorkspaceId)]
updateLastForScreen [(sid, WorkspaceId)]
curr Screen {workspace :: forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace = Workspace { tag :: forall i l a. Workspace i l a -> i
tag = WorkspaceId
wid }, screen :: forall i l a sid sd. Screen i l a sid sd -> sid
screen = sid
sid} =
      let newEntry :: (sid, WorkspaceId)
newEntry = (sid
sid, WorkspaceId
wid)
          alreadyCurrent :: Bool
alreadyCurrent = forall a. a -> Maybe a
Just (sid, WorkspaceId)
newEntry forall a. Eq a => a -> a -> Bool
== forall {t :: * -> *} {b} {b}.
(Foldable t, Eq b) =>
b -> t (b, b) -> Maybe (b, b)
firstOnScreen sid
sid [(sid, WorkspaceId)]
curr
      in if Bool
alreadyCurrent Bool -> Bool -> Bool
|| WorkspaceId
wid forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [WorkspaceId]
ws then [(sid, WorkspaceId)]
curr else (sid, WorkspaceId)
newEntry forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete (sid, WorkspaceId)
newEntry [(sid, WorkspaceId)]
curr

-- | Modify a the workspace history with a given pure function.
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
workspaceHistoryModify [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
action = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify' forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> WorkspaceHistory
WorkspaceHistory forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceHistory -> [(ScreenId, WorkspaceId)]
history