{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.RefocusLast
-- Description :  Hooks and actions to refocus the previous window.
-- Copyright   :  (c) 2018  L. S. Leary
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  L. S. Leary
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides hooks and actions that keep track of recently focused windows on a
-- per workspace basis and automatically refocus the last window on loss of the
-- current (if appropriate as determined by user specified criteria).
--------------------------------------------------------------------------------

-- --< Imports & Exports >-- {{{

module XMonad.Hooks.RefocusLast (
  -- * Usage
  -- $Usage
  -- * Hooks
  refocusLastLogHook,
  refocusLastLayoutHook,
  refocusLastWhen,
  -- ** Predicates
  -- $Predicates
  refocusingIsActive,
  isFloat,
  -- * Actions
  toggleRefocusing,
  toggleFocus,
  swapWithLast,
  refocusWhen,
  shiftRLWhen,
  updateRecentsOn,
  -- * Types
  -- $Types
  RecentWins(..),
  RecentsMap(..),
  RefocusLastLayoutHook(..),
  RefocusLastToggle(..),
  -- * Library functions
  withRecentsIn,
) where

import XMonad
import XMonad.Prelude (All (..), asum, fromMaybe, when)
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Stack (findS, mapZ_)
import XMonad.Layout.LayoutModifier

import qualified Data.Map.Strict as M

-- }}}

-- --< Usage >-- {{{

-- $Usage
-- To use this module, you must either include 'refocusLastLogHook' in your log
-- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both.
-- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will
-- not refocus automatically upon loss of the current window; for that you must
-- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@.
--
-- The event hooks that trigger refocusing only fire when a window is lost
-- completely, not when it's simply e.g. moved to another workspace. Hence you
-- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate
-- if you want the same behaviour in such cases.
--
-- Example configuration:
--
-- > import XMonad
-- > import XMonad.Hooks.RefocusLast
-- > import qualified Data.Map.Strict as M
-- >
-- > main :: IO ()
-- > main = xmonad def
-- >     { handleEventHook = refocusLastWhen myPred <> handleEventHook def
-- >     , logHook         = refocusLastLogHook     <> logHook         def
-- > --  , layoutHook      = refocusLastLayoutHook   $  layoutHook      def
-- >     , keys            = refocusLastKeys        <> keys            def
-- >     } where
-- >         myPred = refocusingIsActive <||> isFloat
-- >         refocusLastKeys cnf
-- >           = M.fromList
-- >           $ ((modMask cnf              , xK_a), toggleFocus)
-- >           : ((modMask cnf .|. shiftMask, xK_a), swapWithLast)
-- >           : ((modMask cnf              , xK_b), toggleRefocusing)
-- >           : [ ( (modMask cnf .|. shiftMask, n)
-- >               , windows =<< shiftRLWhen myPred wksp
-- >               )
-- >             | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf)
-- >             ]
--

-- }}}

-- --< Types >-- {{{

-- $Types
-- The types and constructors used in this module are exported principally to
-- aid extensibility; typical users will have nothing to gain from this section.

-- | Data type holding onto the previous and current @Window@.
data RecentWins = Recent { RecentWins -> Window
previous :: !Window, RecentWins -> Window
current :: !Window }
  deriving (Int -> RecentWins -> ShowS
[RecentWins] -> ShowS
RecentWins -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RecentWins] -> ShowS
$cshowList :: [RecentWins] -> ShowS
show :: RecentWins -> WorkspaceId
$cshow :: RecentWins -> WorkspaceId
showsPrec :: Int -> RecentWins -> ShowS
$cshowsPrec :: Int -> RecentWins -> ShowS
Show, ReadPrec [RecentWins]
ReadPrec RecentWins
Int -> ReadS RecentWins
ReadS [RecentWins]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecentWins]
$creadListPrec :: ReadPrec [RecentWins]
readPrec :: ReadPrec RecentWins
$creadPrec :: ReadPrec RecentWins
readList :: ReadS [RecentWins]
$creadList :: ReadS [RecentWins]
readsPrec :: Int -> ReadS RecentWins
$creadsPrec :: Int -> ReadS RecentWins
Read, RecentWins -> RecentWins -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecentWins -> RecentWins -> Bool
$c/= :: RecentWins -> RecentWins -> Bool
== :: RecentWins -> RecentWins -> Bool
$c== :: RecentWins -> RecentWins -> Bool
Eq)

-- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace.
--   Is an instance of @ExtensionClass@ with persistence of state.
newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)
  deriving (Int -> RecentsMap -> ShowS
[RecentsMap] -> ShowS
RecentsMap -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RecentsMap] -> ShowS
$cshowList :: [RecentsMap] -> ShowS
show :: RecentsMap -> WorkspaceId
$cshow :: RecentsMap -> WorkspaceId
showsPrec :: Int -> RecentsMap -> ShowS
$cshowsPrec :: Int -> RecentsMap -> ShowS
Show, ReadPrec [RecentsMap]
ReadPrec RecentsMap
Int -> ReadS RecentsMap
ReadS [RecentsMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecentsMap]
$creadListPrec :: ReadPrec [RecentsMap]
readPrec :: ReadPrec RecentsMap
$creadPrec :: ReadPrec RecentsMap
readList :: ReadS [RecentsMap]
$creadList :: ReadS [RecentsMap]
readsPrec :: Int -> ReadS RecentsMap
$creadsPrec :: Int -> ReadS RecentsMap
Read, RecentsMap -> RecentsMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecentsMap -> RecentsMap -> Bool
$c/= :: RecentsMap -> RecentsMap -> Bool
== :: RecentsMap -> RecentsMap -> Bool
$c== :: RecentsMap -> RecentsMap -> Bool
Eq)

instance ExtensionClass RecentsMap where
  initialValue :: RecentsMap
initialValue = Map WorkspaceId RecentWins -> RecentsMap
RecentsMap forall k a. Map k a
M.empty
  extensionType :: RecentsMap -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon
--   relayout.
data RefocusLastLayoutHook a = RefocusLastLayoutHook
  deriving (Int -> RefocusLastLayoutHook a -> ShowS
forall a. Int -> RefocusLastLayoutHook a -> ShowS
forall a. [RefocusLastLayoutHook a] -> ShowS
forall a. RefocusLastLayoutHook a -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastLayoutHook a] -> ShowS
$cshowList :: forall a. [RefocusLastLayoutHook a] -> ShowS
show :: RefocusLastLayoutHook a -> WorkspaceId
$cshow :: forall a. RefocusLastLayoutHook a -> WorkspaceId
showsPrec :: Int -> RefocusLastLayoutHook a -> ShowS
$cshowsPrec :: forall a. Int -> RefocusLastLayoutHook a -> ShowS
Show, ReadPrec [RefocusLastLayoutHook a]
ReadPrec (RefocusLastLayoutHook a)
ReadS [RefocusLastLayoutHook a]
forall a. ReadPrec [RefocusLastLayoutHook a]
forall a. ReadPrec (RefocusLastLayoutHook a)
forall a. Int -> ReadS (RefocusLastLayoutHook a)
forall a. ReadS [RefocusLastLayoutHook a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefocusLastLayoutHook a]
$creadListPrec :: forall a. ReadPrec [RefocusLastLayoutHook a]
readPrec :: ReadPrec (RefocusLastLayoutHook a)
$creadPrec :: forall a. ReadPrec (RefocusLastLayoutHook a)
readList :: ReadS [RefocusLastLayoutHook a]
$creadList :: forall a. ReadS [RefocusLastLayoutHook a]
readsPrec :: Int -> ReadS (RefocusLastLayoutHook a)
$creadsPrec :: forall a. Int -> ReadS (RefocusLastLayoutHook a)
Read)

instance LayoutModifier RefocusLastLayoutHook a where
  modifyLayout :: forall (l :: * -> *).
LayoutClass l a =>
RefocusLastLayoutHook a
-> Workspace WorkspaceId (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout RefocusLastLayoutHook a
_ w :: Workspace WorkspaceId (l a) a
w@(W.Workspace WorkspaceId
tg l a
_ Maybe (Stack a)
_) Rectangle
r = WorkspaceId -> X ()
updateRecentsOn WorkspaceId
tg forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (l a) a
w Rectangle
r

-- | A newtype on @Bool@ to act as a universal toggle for refocusing.
newtype RefocusLastToggle = RefocusLastToggle { RefocusLastToggle -> Bool
refocusing :: Bool }
  deriving (Int -> RefocusLastToggle -> ShowS
[RefocusLastToggle] -> ShowS
RefocusLastToggle -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastToggle] -> ShowS
$cshowList :: [RefocusLastToggle] -> ShowS
show :: RefocusLastToggle -> WorkspaceId
$cshow :: RefocusLastToggle -> WorkspaceId
showsPrec :: Int -> RefocusLastToggle -> ShowS
$cshowsPrec :: Int -> RefocusLastToggle -> ShowS
Show, ReadPrec [RefocusLastToggle]
ReadPrec RefocusLastToggle
Int -> ReadS RefocusLastToggle
ReadS [RefocusLastToggle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RefocusLastToggle]
$creadListPrec :: ReadPrec [RefocusLastToggle]
readPrec :: ReadPrec RefocusLastToggle
$creadPrec :: ReadPrec RefocusLastToggle
readList :: ReadS [RefocusLastToggle]
$creadList :: ReadS [RefocusLastToggle]
readsPrec :: Int -> ReadS RefocusLastToggle
$creadsPrec :: Int -> ReadS RefocusLastToggle
Read, RefocusLastToggle -> RefocusLastToggle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RefocusLastToggle -> RefocusLastToggle -> Bool
$c/= :: RefocusLastToggle -> RefocusLastToggle -> Bool
== :: RefocusLastToggle -> RefocusLastToggle -> Bool
$c== :: RefocusLastToggle -> RefocusLastToggle -> Bool
Eq)

instance ExtensionClass RefocusLastToggle where
  initialValue :: RefocusLastToggle
initialValue  = RefocusLastToggle { refocusing :: Bool
refocusing = Bool
True }
  extensionType :: RefocusLastToggle -> StateExtension
extensionType = forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- }}}

-- --< Public Hooks >-- {{{

-- | A log hook recording the current workspace's most recently focused windows
--   into extensible state.
refocusLastLogHook :: X ()
refocusLastLogHook :: X ()
refocusLastLogHook = forall a. (WindowSet -> X a) -> X a
withWindowSet (WorkspaceId -> X ()
updateRecentsOn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag)

-- | Records a workspace's recently focused windows into extensible state upon
--   relayout. Potentially a less wasteful alternative to @refocusLastLogHook@,
--   as it does not run on @WM_NAME@ @propertyNotify@ events.
refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook :: forall (l :: * -> *) a.
l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall a. RefocusLastLayoutHook a
RefocusLastLayoutHook

-- | Given a predicate on the event window determining whether or not to act,
--   construct an event hook that runs iff the core xmonad event handler will
--   unmanage the window, and which shifts focus to the last focused window on
--   the appropriate workspace if desired.
refocusLastWhen :: Query Bool -> Event -> X All
refocusLastWhen :: Query Bool -> Event -> X All
refocusLastWhen Query Bool
p Event
event = Bool -> All
All Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case Event
event of
  UnmapEvent { ev_send_event :: Event -> Bool
ev_send_event = Bool
synth, ev_window :: Event -> Window
ev_window = Window
w } -> do
    Int
e <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map Window Int
waitingUnmap)
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
synth Bool -> Bool -> Bool
|| Int
e forall a. Eq a => a -> a -> Bool
== Int
0) (Window -> X ()
refocusLast Window
w)
  DestroyWindowEvent {                ev_window :: Event -> Window
ev_window = Window
w } -> Window -> X ()
refocusLast Window
w
  Event
_                                                   -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    refocusLast :: Window -> X ()
refocusLast Window
w = X Bool -> X () -> X ()
whenX (forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
w) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
      forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w WindowSet
ws) forall a b. (a -> b) -> a -> b
$ \WorkspaceId
tag ->
        forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag () forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w forall a. Eq a => a -> a -> Bool
== Window
cw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
xs ->
            XState
xs { windowset :: WindowSet
windowset = WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window
lw] WindowSet
ws }

-- }}}

-- --< Predicates >-- {{{

-- $Predicates
-- Impure @Query Bool@ predicates on event windows for use as arguments to
-- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with
-- '<||>' or '<&&>'. Use like e.g.
--
-- > , handleEventHook = refocusLastWhen refocusingIsActive
--
-- or in a keybinding:
--
-- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3"
--
-- It's also valid to use a property lookup like @className =? "someProgram"@ as
-- a predicate, and it should function as expected with e.g. @shiftRLWhen@.
-- In the event hook on the other hand, the window in question has already been
-- unmapped or destroyed, so external lookups to X properties don't work:
-- only the information fossilised in xmonad's state is available.

-- | Holds iff refocusing is toggled active.
refocusingIsActive :: Query Bool
refocusingIsActive :: Query Bool
refocusingIsActive = (forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) b.
(ExtensionClass a, XLike m) =>
(a -> b) -> m b
XS.gets) RefocusLastToggle -> Bool
refocusing

-- | Holds iff the event window is a float.
isFloat :: Query Bool
isFloat :: Query Bool
isFloat = forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets) (forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset)

-- }}}

-- --< Public Actions >-- {{{

-- | Toggle automatic refocusing at runtime. Has no effect unless the
--   @refocusingIsActive@ predicate has been used.
toggleRefocusing :: X ()
toggleRefocusing :: X ()
toggleRefocusing = forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Bool -> RefocusLastToggle
RefocusLastToggle forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RefocusLastToggle -> Bool
refocusing)

-- | Refocuses the previously focused window; acts as a toggle.
--   Is not affected by @toggleRefocusing@.
toggleFocus :: X ()
toggleFocus :: X ()
toggleFocus = (Window -> Window -> X ()) -> X ()
withRecents forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
lw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ [Window] -> WindowSet -> WindowSet
tryFocus [Window
lw]

-- | Swaps the current and previous windows of the current workspace.
--   Is not affected by @toggleRefocusing@.
swapWithLast :: X ()
swapWithLast :: X ()
swapWithLast = (Window -> Window -> X ()) -> X ()
withRecents forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
lw) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {i} {l} {s} {sd}.
(Maybe (Stack a) -> Maybe (Stack a))
-> StackSet i l a s sd -> StackSet i l a s sd
modify''forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ forall a b. (a -> b) -> a -> b
$ \Window
w ->
    if | (Window
w forall a. Eq a => a -> a -> Bool
== Window
lw) -> Window
cw
       | (Window
w forall a. Eq a => a -> a -> Bool
== Window
cw) -> Window
lw
       | Bool
otherwise ->  Window
w
  where modify'' :: (Maybe (Stack a) -> Maybe (Stack a))
-> StackSet i l a s sd -> StackSet i l a s sd
modify'' Maybe (Stack a) -> Maybe (Stack a)
f = forall a i l s sd.
Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
W.modify (Maybe (Stack a) -> Maybe (Stack a)
f forall a. Maybe a
Nothing) (Maybe (Stack a) -> Maybe (Stack a)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)

-- | Given a target workspace and a predicate on its current window, produce a
--   'windows' suitable function that will refocus that workspace appropriately.
--   Allows you to hook refocusing into any action you can run through
--   @windows@. See the implementation of @shiftRLWhen@ for a straight-forward
--   usage example.
refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p WorkspaceId
tag = forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw -> do
  Bool
b <- forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
cw
  forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
b then WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window
cw, Window
lw] else forall a. a -> a
id)

-- | Sends the focused window to the specified workspace, refocusing the last
--   focused window if the predicate holds on the current window. Note that the
--   native version of this, @windows . W.shift@, has a nice property that this
--   does not: shifting a window to another workspace then shifting it back
--   preserves its place in the stack. Can be used in a keybinding like e.g.
--
-- > windows =<< shiftRLWhen refocusingIsActive "3"
--
--   or
--
-- > (windows <=< shiftRLWhen refocusingIsActive) "3"
--
--   where '<=<' is imported from "Control.Monad".
shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
shiftRLWhen Query Bool
p WorkspaceId
to = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
  WindowSet -> WindowSet
refocus <- Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws)
  let shift :: StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
shift = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
to) (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws)
  forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet -> WindowSet
refocus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {l} {sd}.
StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
shift)

-- | Perform an update to the 'RecentWins' for the specified workspace.
--   The RefocusLast log and layout hooks are both implemented trivially in
--   terms of this function. Only exported to aid extensibility.
updateRecentsOn :: WorkspaceId -> X ()
updateRecentsOn :: WorkspaceId -> X ()
updateRecentsOn WorkspaceId
tag = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
  forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek 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.view WorkspaceId
tag WindowSet
ws) forall a b. (a -> b) -> a -> b
$ \Window
fw -> do
    Map WorkspaceId RecentWins
m <- X (Map WorkspaceId RecentWins)
getRecentsMap
    let insertRecent :: Window -> Window -> m ()
insertRecent Window
l Window
c = forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map WorkspaceId RecentWins -> RecentsMap
RecentsMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert WorkspaceId
tag (Window -> Window -> RecentWins
Recent Window
l Window
c) Map WorkspaceId RecentWins
m
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
tag Map WorkspaceId RecentWins
m of
      Just (Recent Window
_ Window
cw) -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw forall a. Eq a => a -> a -> Bool
/= Window
fw) (forall {m :: * -> *}. XLike m => Window -> Window -> m ()
insertRecent Window
cw Window
fw)
      Maybe RecentWins
Nothing            ->                  forall {m :: * -> *}. XLike m => Window -> Window -> m ()
insertRecent Window
fw Window
fw

-- }}}

-- --< Utilities >-- {{{

-- | Focuses the first window in the list it can find on the current workspace.
tryFocus :: [Window] -> WindowSet -> WindowSet
tryFocus :: [Window] -> WindowSet -> WindowSet
tryFocus [Window]
wins = forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' forall a b. (a -> b) -> a -> b
$ \Stack Window
s ->
  forall a. a -> Maybe a -> a
fromMaybe Stack Window
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum forall a b. (a -> b) -> a -> b
$ (\Window
w -> forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
findS (forall a. Eq a => a -> a -> Bool
== Window
w) Stack Window
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Window]
wins

-- | Operate the above on a specified workspace.
tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
tryFocusIn WorkspaceId
tag [Window]
wins WindowSet
ws =
  forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> WindowSet -> WindowSet
tryFocus [Window]
wins 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.view WorkspaceId
tag forall a b. (a -> b) -> a -> b
$ WindowSet
ws

-- | Get the RecentsMap out of extensible state and remove its newtype wrapper.
getRecentsMap :: X (M.Map WorkspaceId RecentWins)
getRecentsMap :: X (Map WorkspaceId RecentWins)
getRecentsMap = forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(RecentsMap Map WorkspaceId RecentWins
m) -> forall (m :: * -> *) a. Monad m => a -> m a
return Map WorkspaceId RecentWins
m

-- | Perform an X action dependent on successful lookup of the RecentWins for
--   the specified workspace, or return a default value.
withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn :: forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn WorkspaceId
tag a
dflt Window -> Window -> X a
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return a
dflt) (\(Recent Window
lw Window
cw) -> Window -> Window -> X a
f Window
lw Window
cw)
                         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup WorkspaceId
tag
                       forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Map WorkspaceId RecentWins)
getRecentsMap

-- | The above specialised to the current workspace and unit.
withRecents :: (Window -> Window -> X ()) -> X ()
withRecents :: (Window -> Window -> X ()) -> X ()
withRecents Window -> Window -> X ()
f = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> forall a. WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn (forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) () Window -> Window -> X ()
f

-- }}}