{-# 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 -> String
(Int -> RecentWins -> ShowS)
-> (RecentWins -> String)
-> ([RecentWins] -> ShowS)
-> Show RecentWins
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecentWins] -> ShowS
$cshowList :: [RecentWins] -> ShowS
show :: RecentWins -> String
$cshow :: RecentWins -> String
showsPrec :: Int -> RecentWins -> ShowS
$cshowsPrec :: Int -> RecentWins -> ShowS
Show, ReadPrec [RecentWins]
ReadPrec RecentWins
Int -> ReadS RecentWins
ReadS [RecentWins]
(Int -> ReadS RecentWins)
-> ReadS [RecentWins]
-> ReadPrec RecentWins
-> ReadPrec [RecentWins]
-> Read 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
(RecentWins -> RecentWins -> Bool)
-> (RecentWins -> RecentWins -> Bool) -> Eq RecentWins
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 -> String
(Int -> RecentsMap -> ShowS)
-> (RecentsMap -> String)
-> ([RecentsMap] -> ShowS)
-> Show RecentsMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecentsMap] -> ShowS
$cshowList :: [RecentsMap] -> ShowS
show :: RecentsMap -> String
$cshow :: RecentsMap -> String
showsPrec :: Int -> RecentsMap -> ShowS
$cshowsPrec :: Int -> RecentsMap -> ShowS
Show, ReadPrec [RecentsMap]
ReadPrec RecentsMap
Int -> ReadS RecentsMap
ReadS [RecentsMap]
(Int -> ReadS RecentsMap)
-> ReadS [RecentsMap]
-> ReadPrec RecentsMap
-> ReadPrec [RecentsMap]
-> Read 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
(RecentsMap -> RecentsMap -> Bool)
-> (RecentsMap -> RecentsMap -> Bool) -> Eq RecentsMap
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 String RecentWins -> RecentsMap
RecentsMap Map String RecentWins
forall k a. Map k a
M.empty
  extensionType :: RecentsMap -> StateExtension
extensionType = RecentsMap -> StateExtension
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
[RefocusLastLayoutHook a] -> ShowS
RefocusLastLayoutHook a -> String
(Int -> RefocusLastLayoutHook a -> ShowS)
-> (RefocusLastLayoutHook a -> String)
-> ([RefocusLastLayoutHook a] -> ShowS)
-> Show (RefocusLastLayoutHook a)
forall a. Int -> RefocusLastLayoutHook a -> ShowS
forall a. [RefocusLastLayoutHook a] -> ShowS
forall a. RefocusLastLayoutHook a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastLayoutHook a] -> ShowS
$cshowList :: forall a. [RefocusLastLayoutHook a] -> ShowS
show :: RefocusLastLayoutHook a -> String
$cshow :: forall a. RefocusLastLayoutHook a -> String
showsPrec :: Int -> RefocusLastLayoutHook a -> ShowS
$cshowsPrec :: forall a. Int -> RefocusLastLayoutHook a -> ShowS
Show, ReadPrec [RefocusLastLayoutHook a]
ReadPrec (RefocusLastLayoutHook a)
Int -> ReadS (RefocusLastLayoutHook a)
ReadS [RefocusLastLayoutHook a]
(Int -> ReadS (RefocusLastLayoutHook a))
-> ReadS [RefocusLastLayoutHook a]
-> ReadPrec (RefocusLastLayoutHook a)
-> ReadPrec [RefocusLastLayoutHook a]
-> Read (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 :: RefocusLastLayoutHook a
-> Workspace String (l a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (l a))
modifyLayout RefocusLastLayoutHook a
_ w :: Workspace String (l a) a
w@(W.Workspace String
tg l a
_ Maybe (Stack a)
_) Rectangle
r = String -> X ()
updateRecentsOn String
tg X ()
-> X ([(a, Rectangle)], Maybe (l a))
-> X ([(a, Rectangle)], Maybe (l a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Workspace String (l a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (l a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace String (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 -> String
(Int -> RefocusLastToggle -> ShowS)
-> (RefocusLastToggle -> String)
-> ([RefocusLastToggle] -> ShowS)
-> Show RefocusLastToggle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RefocusLastToggle] -> ShowS
$cshowList :: [RefocusLastToggle] -> ShowS
show :: RefocusLastToggle -> String
$cshow :: RefocusLastToggle -> String
showsPrec :: Int -> RefocusLastToggle -> ShowS
$cshowsPrec :: Int -> RefocusLastToggle -> ShowS
Show, ReadPrec [RefocusLastToggle]
ReadPrec RefocusLastToggle
Int -> ReadS RefocusLastToggle
ReadS [RefocusLastToggle]
(Int -> ReadS RefocusLastToggle)
-> ReadS [RefocusLastToggle]
-> ReadPrec RefocusLastToggle
-> ReadPrec [RefocusLastToggle]
-> Read 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
(RefocusLastToggle -> RefocusLastToggle -> Bool)
-> (RefocusLastToggle -> RefocusLastToggle -> Bool)
-> Eq RefocusLastToggle
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 :: Bool -> RefocusLastToggle
RefocusLastToggle { refocusing :: Bool
refocusing = Bool
True }
  extensionType :: RefocusLastToggle -> StateExtension
extensionType = RefocusLastToggle -> StateExtension
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 = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet (String -> X ()
updateRecentsOn (String -> X ()) -> (WindowSet -> String) -> WindowSet -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> String
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 :: l a -> ModifiedLayout RefocusLastLayoutHook l a
refocusLastLayoutHook = RefocusLastLayoutHook a
-> l a -> ModifiedLayout RefocusLastLayoutHook l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout RefocusLastLayoutHook a
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 All -> X () -> X All
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 <- (XState -> Int) -> X Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (XState -> Maybe Int) -> XState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> Map Window Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Window
w (Map Window Int -> Maybe Int)
-> (XState -> Map Window Int) -> XState -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> Map Window Int
waitingUnmap)
    Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
synth Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
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
_                                                   -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    refocusLast :: Window -> X ()
refocusLast Window
w = X Bool -> X () -> X ()
whenX (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
w) (X () -> X ())
-> ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
      Maybe String -> (String -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (Window -> WindowSet -> Maybe String
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w WindowSet
ws) ((String -> X ()) -> X ()) -> (String -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \String
tag ->
        String -> () -> (Window -> Window -> X ()) -> X ()
forall a. String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn String
tag () ((Window -> Window -> X ()) -> X ())
-> (Window -> Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
          Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
cw) (X () -> X ())
-> ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \XState
xs ->
            XState
xs { windowset :: WindowSet
windowset = String -> [Window] -> WindowSet -> WindowSet
tryFocusIn String
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 = (X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool)
-> ((RefocusLastToggle -> Bool) -> X Bool)
-> (RefocusLastToggle -> Bool)
-> Query Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RefocusLastToggle -> Bool) -> X Bool
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 = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> (X Bool -> Query Bool
forall a. X a -> Query a
liftX (X Bool -> Query Bool)
-> ((XState -> Bool) -> X Bool) -> (XState -> Bool) -> Query Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XState -> Bool) -> X Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets) (Window -> Map Window RationalRect -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w (Map Window RationalRect -> Bool)
-> (XState -> Map Window RationalRect) -> XState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Map Window RationalRect
forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating (WindowSet -> Map Window RationalRect)
-> (XState -> WindowSet) -> XState -> Map Window RationalRect
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 = (RefocusLastToggle -> RefocusLastToggle) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify (Bool -> RefocusLastToggle
RefocusLastToggle (Bool -> RefocusLastToggle)
-> (RefocusLastToggle -> Bool)
-> RefocusLastToggle
-> RefocusLastToggle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (RefocusLastToggle -> Bool) -> RefocusLastToggle -> Bool
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 ((Window -> Window -> X ()) -> X ())
-> (Window -> Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
lw) (X () -> X ())
-> ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
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 ((Window -> Window -> X ()) -> X ())
-> (Window -> Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw ->
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
lw) (X () -> X ())
-> ((Window -> Window) -> X ()) -> (Window -> Window) -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> ((Window -> Window) -> WindowSet -> WindowSet)
-> (Window -> Window)
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Stack Window) -> Maybe (Stack Window))
-> WindowSet -> WindowSet
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''((Maybe (Stack Window) -> Maybe (Stack Window))
 -> WindowSet -> WindowSet)
-> ((Window -> Window)
    -> Maybe (Stack Window) -> Maybe (Stack Window))
-> (Window -> Window)
-> WindowSet
-> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Window) -> Maybe (Stack Window) -> Maybe (Stack Window)
forall a b. (a -> b) -> Zipper a -> Zipper b
mapZ_ ((Window -> Window) -> X ()) -> (Window -> Window) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
w ->
    if | (Window
w Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
lw) -> Window
cw
       | (Window
w Window -> Window -> Bool
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 = Maybe (Stack a)
-> (Stack a -> Maybe (Stack a))
-> StackSet i l a s sd
-> StackSet i l a s sd
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 Maybe (Stack a)
forall a. Maybe a
Nothing) (Maybe (Stack a) -> Maybe (Stack a)
f (Maybe (Stack a) -> Maybe (Stack a))
-> (Stack a -> Maybe (Stack a)) -> Stack a -> Maybe (Stack a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack a -> Maybe (Stack a)
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 -> String -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p String
tag = String
-> (WindowSet -> WindowSet)
-> (Window -> Window -> X (WindowSet -> WindowSet))
-> X (WindowSet -> WindowSet)
forall a. String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn String
tag WindowSet -> WindowSet
forall a. a -> a
id ((Window -> Window -> X (WindowSet -> WindowSet))
 -> X (WindowSet -> WindowSet))
-> (Window -> Window -> X (WindowSet -> WindowSet))
-> X (WindowSet -> WindowSet)
forall a b. (a -> b) -> a -> b
$ \Window
lw Window
cw -> do
  Bool
b <- Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
p Window
cw
  (WindowSet -> WindowSet) -> X (WindowSet -> WindowSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
b then String -> [Window] -> WindowSet -> WindowSet
tryFocusIn String
tag [Window
cw, Window
lw] else WindowSet -> WindowSet
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 -> String -> X (WindowSet -> WindowSet)
shiftRLWhen Query Bool
p String
to = (WindowSet -> X (WindowSet -> WindowSet))
-> X (WindowSet -> WindowSet)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (WindowSet -> WindowSet))
 -> X (WindowSet -> WindowSet))
-> (WindowSet -> X (WindowSet -> WindowSet))
-> X (WindowSet -> WindowSet)
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> do
  WindowSet -> WindowSet
refocus <- Query Bool -> String -> X (WindowSet -> WindowSet)
refocusWhen Query Bool
p (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws)
  let shift :: StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd
shift = (StackSet String l Window ScreenId sd
 -> StackSet String l Window ScreenId sd)
-> (Window
    -> StackSet String l Window ScreenId sd
    -> StackSet String l Window ScreenId sd)
-> Maybe Window
-> StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd
forall a. a -> a
id (String
-> Window
-> StackSet String l Window ScreenId sd
-> StackSet String l Window ScreenId sd
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 String
to) (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek WindowSet
ws)
  (WindowSet -> WindowSet) -> X (WindowSet -> WindowSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowSet -> WindowSet
refocus (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
forall l sd.
StackSet String l Window ScreenId sd
-> StackSet String 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 :: String -> X ()
updateRecentsOn String
tag = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws ->
  Maybe Window -> (Window -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust (WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (WindowSet -> Maybe Window) -> WindowSet -> Maybe Window
forall a b. (a -> b) -> a -> b
$ String -> 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.view String
tag WindowSet
ws) ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
fw -> do
    Map String RecentWins
m <- X (Map String RecentWins)
getRecentsMap
    let insertRecent :: Window -> Window -> m ()
insertRecent Window
l Window
c = RecentsMap -> m ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (RecentsMap -> m ())
-> (Map String RecentWins -> RecentsMap)
-> Map String RecentWins
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String RecentWins -> RecentsMap
RecentsMap (Map String RecentWins -> m ()) -> Map String RecentWins -> m ()
forall a b. (a -> b) -> a -> b
$ String
-> RecentWins -> Map String RecentWins -> Map String RecentWins
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
tag (Window -> Window -> RecentWins
Recent Window
l Window
c) Map String RecentWins
m
    case String -> Map String RecentWins -> Maybe RecentWins
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
tag Map String RecentWins
m of
      Just (Recent Window
_ Window
cw) -> Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window
cw Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Window
fw) (Window -> Window -> X ()
forall (m :: * -> *). XLike m => Window -> Window -> m ()
insertRecent Window
cw Window
fw)
      Maybe RecentWins
Nothing            ->                  Window -> Window -> X ()
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 = (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' ((Stack Window -> Stack Window) -> WindowSet -> WindowSet)
-> (Stack Window -> Stack Window) -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ \Stack Window
s ->
  Stack Window -> Maybe (Stack Window) -> Stack Window
forall a. a -> Maybe a -> a
fromMaybe Stack Window
s (Maybe (Stack Window) -> Stack Window)
-> ([Maybe (Stack Window)] -> Maybe (Stack Window))
-> [Maybe (Stack Window)]
-> Stack Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Stack Window)] -> Maybe (Stack Window)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe (Stack Window)] -> Stack Window)
-> [Maybe (Stack Window)] -> Stack Window
forall a b. (a -> b) -> a -> b
$ (\Window
w -> (Window -> Bool) -> Stack Window -> Maybe (Stack Window)
forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
findS (Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
w) Stack Window
s) (Window -> Maybe (Stack Window))
-> [Window] -> [Maybe (Stack Window)]
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 :: String -> [Window] -> WindowSet -> WindowSet
tryFocusIn String
tag [Window]
wins WindowSet
ws =
  String -> 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.view (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Window] -> WindowSet -> WindowSet
tryFocus [Window]
wins (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> 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.view String
tag (WindowSet -> WindowSet) -> WindowSet -> WindowSet
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 String RecentWins)
getRecentsMap = X RecentsMap
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get X RecentsMap
-> (RecentsMap -> X (Map String RecentWins))
-> X (Map String RecentWins)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(RecentsMap Map String RecentWins
m) -> Map String RecentWins -> X (Map String RecentWins)
forall (m :: * -> *) a. Monad m => a -> m a
return Map String 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 :: String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn String
tag a
dflt Window -> Window -> X a
f = X a -> (RecentWins -> X a) -> Maybe RecentWins -> X a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> X a
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)
                         (Maybe RecentWins -> X a)
-> (Map String RecentWins -> Maybe RecentWins)
-> Map String RecentWins
-> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String RecentWins -> Maybe RecentWins
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
tag
                       (Map String RecentWins -> X a) -> X (Map String RecentWins) -> X a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X (Map String 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 = (WindowSet -> X ()) -> X ()
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WindowSet
ws -> String -> () -> (Window -> Window -> X ()) -> X ()
forall a. String -> a -> (Window -> Window -> X a) -> X a
withRecentsIn (WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws) () Window -> Window -> X ()
f

-- }}}