{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.MostRecentlyUsed
-- Description :  Tab through windows by recency of use.
-- Copyright   :  (c) 2022 L. S. Leary
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  @LSLeary (on github)
-- Stability   :  unstable
-- Portability :  unportable
--
-- Based on the Alt+Tab behaviour common outside of xmonad.
--
-----------------------------------------------------------------------------

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

module XMonad.Actions.MostRecentlyUsed (

  -- * Usage
  -- $usage

  -- * Interface
  configureMRU,
  mostRecentlyUsed,
  withMostRecentlyUsed,
  Location(..),

  ) where

-- base
import Data.List.NonEmpty (nonEmpty)
import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
import Control.Monad.IO.Class (MonadIO)

-- mtl
import Control.Monad.Trans (lift)
import Control.Monad.State (get, put, gets)

-- containers
import qualified Data.Map.Strict as M

-- xmonad
import XMonad
  ( Window, KeySym, keyPress, io
  , Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)
  )
import XMonad.Core
  ( X, XConfig(..), windowset, WorkspaceId, ScreenId
  , ExtensionClass(..), StateExtension(..)
  , waitingUnmap
  )
import XMonad.Operations (screenWorkspace)
import qualified XMonad.StackSet as W

-- xmonad-contrib
import qualified XMonad.Util.ExtensibleConf  as XC
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.PureX
  (handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
import XMonad.Util.History (History, origin, event, erase, ledger)
import XMonad.Actions.Repeatable (repeatableSt)
import XMonad.Prelude

-- }}}

-- --< Core Data Types: WindowHistory & Location >-- {{{

data WindowHistory = WinHist
  { WindowHistory -> Bool
busy :: !Bool
  , WindowHistory -> History Window Location
hist :: !(History Window Location)
  } deriving (Int -> WindowHistory -> ShowS
[WindowHistory] -> ShowS
WindowHistory -> WorkspaceId
(Int -> WindowHistory -> ShowS)
-> (WindowHistory -> WorkspaceId)
-> ([WindowHistory] -> ShowS)
-> Show WindowHistory
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindowHistory -> ShowS
showsPrec :: Int -> WindowHistory -> ShowS
$cshow :: WindowHistory -> WorkspaceId
show :: WindowHistory -> WorkspaceId
$cshowList :: [WindowHistory] -> ShowS
showList :: [WindowHistory] -> ShowS
Show, ReadPrec [WindowHistory]
ReadPrec WindowHistory
Int -> ReadS WindowHistory
ReadS [WindowHistory]
(Int -> ReadS WindowHistory)
-> ReadS [WindowHistory]
-> ReadPrec WindowHistory
-> ReadPrec [WindowHistory]
-> Read WindowHistory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WindowHistory
readsPrec :: Int -> ReadS WindowHistory
$creadList :: ReadS [WindowHistory]
readList :: ReadS [WindowHistory]
$creadPrec :: ReadPrec WindowHistory
readPrec :: ReadPrec WindowHistory
$creadListPrec :: ReadPrec [WindowHistory]
readListPrec :: ReadPrec [WindowHistory]
Read)

instance ExtensionClass WindowHistory where
  initialValue :: WindowHistory
initialValue = WinHist
    { busy :: Bool
busy = Bool
False
    , hist :: History Window Location
hist = History Window Location
forall k a. History k a
origin
    }
  extensionType :: WindowHistory -> StateExtension
extensionType = WindowHistory -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

data Location = Location
  { Location -> WorkspaceId
workspace :: !WorkspaceId
  , Location -> ScreenId
screen    :: !ScreenId
  } deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> WorkspaceId
(Int -> Location -> ShowS)
-> (Location -> WorkspaceId)
-> ([Location] -> ShowS)
-> Show Location
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> WorkspaceId
show :: Location -> WorkspaceId
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show, ReadPrec [Location]
ReadPrec Location
Int -> ReadS Location
ReadS [Location]
(Int -> ReadS Location)
-> ReadS [Location]
-> ReadPrec Location
-> ReadPrec [Location]
-> Read Location
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Location
readsPrec :: Int -> ReadS Location
$creadList :: ReadS [Location]
readList :: ReadS [Location]
$creadPrec :: ReadPrec Location
readPrec :: ReadPrec Location
$creadListPrec :: ReadPrec [Location]
readListPrec :: ReadPrec [Location]
Read, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: Location -> Location -> Bool
Eq, Eq Location
Eq Location =>
(Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$c< :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> Location
Ord)

-- }}}

-- --< Interface >-- {{{

-- $usage
--
-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'
-- to work.
--
-- > main :: IO ()
-- > main = xmonad . configureMRU . ... $ def
-- >   { ...
-- >   }
--
-- Once that's done, it can be used normally in keybinds:
--
-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)
--
-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not
-- always the case, depending on how your system is configured.

-- | Configure xmonad to support 'mostRecentlyUsed'.
configureMRU :: XConfig l -> XConfig l
configureMRU :: forall (l :: * -> *). XConfig l -> XConfig l
configureMRU = (XConfig l -> XConfig l) -> MRU -> XConfig l -> XConfig l
forall a (l :: * -> *).
(Semigroup a, Typeable a) =>
(XConfig l -> XConfig l) -> a -> XConfig l -> XConfig l
XC.once XConfig l -> XConfig l
forall (l :: * -> *). XConfig l -> XConfig l
f (() -> MRU
MRU ()) where
  f :: XConfig l -> XConfig l
f XConfig l
cnf = XConfig l
cnf
    { logHook         = logHook         cnf <> logWinHist
    , handleEventHook = handleEventHook cnf <> winHistEH
    }
newtype MRU = MRU () deriving NonEmpty MRU -> MRU
MRU -> MRU -> MRU
(MRU -> MRU -> MRU)
-> (NonEmpty MRU -> MRU)
-> (forall b. Integral b => b -> MRU -> MRU)
-> Semigroup MRU
forall b. Integral b => b -> MRU -> MRU
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: MRU -> MRU -> MRU
<> :: MRU -> MRU -> MRU
$csconcat :: NonEmpty MRU -> MRU
sconcat :: NonEmpty MRU -> MRU
$cstimes :: forall b. Integral b => b -> MRU -> MRU
stimes :: forall b. Integral b => b -> MRU -> MRU
Semigroup

-- | An action to browse through the history of focused windows, taking
--   another step back with each tap of the key.
mostRecentlyUsed
  :: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the
              --   action is bound.
  -> KeySym   -- ^ The 'KeySym' corresponding to the key to which the action
              --   is bound.
  -> X ()
mostRecentlyUsed :: [Window] -> Window -> X ()
mostRecentlyUsed [Window]
mods Window
key = do
  (X Any -> X ()
toUndo, X Any
undo) <- X (X Any -> X (), X Any)
forall (m :: * -> *) a.
(MonadIO m, Monoid a) =>
m (m a -> m (), m a)
undoer
  let undoably :: X t -> (t -> X Any) -> t -> X ()
undoably X t
curThing t -> X Any
withThing t
thing = X t
curThing X t -> (t -> X ()) -> X ()
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \t
cur ->
        Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (t
cur t -> t -> Bool
forall a. Eq a => a -> a -> Bool
/= t
thing) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ t -> X Any
withThing t
thing X Any -> X () -> X ()
forall a b. X a -> X b -> X b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X Any -> X ()
toUndo (t -> X Any
withThing t
cur)
  [Window] -> Window -> (Window -> Location -> X ()) -> X ()
withMostRecentlyUsed [Window]
mods Window
key ((Window -> Location -> X ()) -> X ())
-> (Window -> Location -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win Location{WorkspaceId
workspace :: Location -> WorkspaceId
workspace :: WorkspaceId
workspace,ScreenId
screen :: Location -> ScreenId
screen :: ScreenId
screen} ->
    X () -> X ()
handlingRefresh (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
      X Any
undo
      X ScreenId -> (ScreenId -> X Any) -> ScreenId -> X ()
forall {t}. Eq t => X t -> (t -> X Any) -> t -> X ()
undoably X ScreenId
forall (m :: * -> *). XLike m => m ScreenId
curScreenId ScreenId -> X Any
viewScreen ScreenId
screen
      X WorkspaceId -> (WorkspaceId -> X Any) -> WorkspaceId -> X ()
forall {t}. Eq t => X t -> (t -> X Any) -> t -> X ()
undoably X WorkspaceId
forall (m :: * -> *). XLike m => m WorkspaceId
curTag      WorkspaceId -> X Any
forall (m :: * -> *). XLike m => WorkspaceId -> m Any
greedyView WorkspaceId
workspace
      Maybe WorkspaceId
mi <- (XState -> Maybe WorkspaceId) -> X (Maybe WorkspaceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Window
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
win (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Maybe WorkspaceId)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
      Maybe WorkspaceId -> (WorkspaceId -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe WorkspaceId
mi ((WorkspaceId -> X ()) -> X ()) -> (WorkspaceId -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
i -> do
        X WorkspaceId -> (WorkspaceId -> X Any) -> WorkspaceId -> X ()
forall {t}. Eq t => X t -> (t -> X Any) -> t -> X ()
undoably X WorkspaceId
forall (m :: * -> *). XLike m => m WorkspaceId
curTag WorkspaceId -> X Any
forall (m :: * -> *). XLike m => WorkspaceId -> m Any
greedyView WorkspaceId
i
        Maybe Window
mfw <- X (Maybe Window)
forall (m :: * -> *). XLike m => m (Maybe Window)
peek
        Maybe Window -> (Window -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Window
mfw ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
fw -> do
          X Window -> (Window -> X Any) -> Window -> X ()
forall {t}. Eq t => X t -> (t -> X Any) -> t -> X ()
undoably (Window -> X Window
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Window
fw) Window -> X Any
forall (m :: * -> *). XLike m => Window -> m Any
focusWindow Window
win
  where
    undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)
    undoer :: forall (m :: * -> *) a.
(MonadIO m, Monoid a) =>
m (m a -> m (), m a)
undoer = do
      IORef (m a)
ref <- IO (IORef (m a)) -> m (IORef (m a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (IORef (m a)) -> m (IORef (m a)))
-> (m a -> IO (IORef (m a))) -> m a -> m (IORef (m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> IO (IORef (m a))
forall a. a -> IO (IORef a)
newIORef (m a -> m (IORef (m a))) -> m a -> m (IORef (m a))
forall a b. (a -> b) -> a -> b
$ a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
      let toUndo :: m a -> m ()
toUndo = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> (m a -> IO ()) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (m a) -> (m a -> m a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (m a)
ref ((m a -> m a) -> IO ()) -> (m a -> m a -> m a) -> m a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> a) -> m a -> m a -> m a
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
          undo :: m a
undo   = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (m a) -> m (m a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (m a) -> m (m a)) -> IO (m a) -> m (m a)
forall a b. (a -> b) -> a -> b
$ IORef (m a) -> IO (m a)
forall a. IORef a -> IO a
readIORef IORef (m a)
ref)
                m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IORef (m a) -> m a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (m a)
ref (m a -> IO ()) -> m a -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty)
      (m a -> m (), m a) -> m (m a -> m (), m a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> m ()
toUndo, m a
undo)
    viewScreen :: ScreenId -> X Any
    viewScreen :: ScreenId -> X Any
viewScreen ScreenId
scr = ScreenId -> X (Maybe WorkspaceId)
screenWorkspace ScreenId
scr X (Maybe WorkspaceId) -> (Maybe WorkspaceId -> X Any) -> X Any
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WorkspaceId -> X Any) -> Maybe WorkspaceId -> X Any
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap WorkspaceId -> X Any
forall (m :: * -> *). XLike m => WorkspaceId -> m Any
view

-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what
--   is done with each window you tab through (the default being to visit its
--   previous 'Location' and give it focus).
withMostRecentlyUsed
  :: [KeySym]                     -- ^ The 'KeySym's corresponding to the
                                  --   modifier to which the action is bound.
  -> KeySym                       -- ^ The 'KeySym' corresponding to the key to
                                  --   which the action is bound.
  -> (Window -> Location -> X ()) -- ^ The function applied to each window.
  -> X ()
withMostRecentlyUsed :: [Window] -> Window -> (Window -> Location -> X ()) -> X ()
withMostRecentlyUsed [Window]
mods Window
tab Window -> Location -> X ()
preview = do
  wh :: WindowHistory
wh@WinHist{Bool
busy :: WindowHistory -> Bool
busy :: Bool
busy,History Window Location
hist :: WindowHistory -> History Window Location
hist :: History Window Location
hist} <- X WindowHistory
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
busy (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    WindowHistory -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put WindowHistory
wh{ busy = True }

    Maybe (NonEmpty (Window, Location))
-> (NonEmpty (Window, Location)
    -> X ((), Stream (Window, Location)))
-> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([(Window, Location)] -> Maybe (NonEmpty (Window, Location))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([(Window, Location)] -> Maybe (NonEmpty (Window, Location)))
-> [(Window, Location)] -> Maybe (NonEmpty (Window, Location))
forall a b. (a -> b) -> a -> b
$ History Window Location -> [(Window, Location)]
forall k a. History k a -> [(k, a)]
ledger History Window Location
hist) ((NonEmpty (Window, Location) -> X ((), Stream (Window, Location)))
 -> X ())
-> (NonEmpty (Window, Location)
    -> X ((), Stream (Window, Location)))
-> X ()
forall a b. (a -> b) -> a -> b
$ \NonEmpty (Window, Location)
ne -> do
      Maybe Window
mfw <- (XState -> Maybe Window) -> X (Maybe Window)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Maybe Window)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Maybe Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
      let iSt :: Stream (Window, Location)
iSt = case NonEmpty (Window, Location) -> Stream (Window, Location)
forall a. NonEmpty a -> Stream a
cycleS NonEmpty (Window, Location)
ne of
            (Window
w, Location
_) :~ Stream (Window, Location)
s | Maybe Window
mfw Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w -> Stream (Window, Location)
s
            Stream (Window, Location)
s                           -> Stream (Window, Location)
s
      Stream (Window, Location)
-> [Window]
-> Window
-> (EventType -> Window -> StateT (Stream (Window, Location)) X ())
-> X ((), Stream (Window, Location))
forall a s.
Monoid a =>
s
-> [Window]
-> Window
-> (EventType -> Window -> StateT s X a)
-> X (a, s)
repeatableSt Stream (Window, Location)
iSt [Window]
mods Window
tab ((EventType -> Window -> StateT (Stream (Window, Location)) X ())
 -> X ((), Stream (Window, Location)))
-> (EventType -> Window -> StateT (Stream (Window, Location)) X ())
-> X ((), Stream (Window, Location))
forall a b. (a -> b) -> a -> b
$ \EventType
t Window
s ->
        Bool
-> StateT (Stream (Window, Location)) X ()
-> StateT (Stream (Window, Location)) X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress Bool -> Bool -> Bool
&& Window
s Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
tab) (StateT (Stream (Window, Location)) X (Window, Location)
pop StateT (Stream (Window, Location)) X (Window, Location)
-> ((Window, Location) -> StateT (Stream (Window, Location)) X ())
-> StateT (Stream (Window, Location)) X ()
forall a b.
StateT (Stream (Window, Location)) X a
-> (a -> StateT (Stream (Window, Location)) X b)
-> StateT (Stream (Window, Location)) X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= X () -> StateT (Stream (Window, Location)) X ()
forall (m :: * -> *) a.
Monad m =>
m a -> StateT (Stream (Window, Location)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (X () -> StateT (Stream (Window, Location)) X ())
-> ((Window, Location) -> X ())
-> (Window, Location)
-> StateT (Stream (Window, Location)) X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Window -> Location -> X ()) -> (Window, Location) -> X ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Window -> Location -> X ()
preview)

    (WindowHistory -> WindowHistory) -> X ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WindowHistory -> WindowHistory) -> X ())
-> (WindowHistory -> WindowHistory) -> X ()
forall a b. (a -> b) -> a -> b
$ \ws :: WindowHistory
ws@WinHist{} -> WindowHistory
ws{ busy = False }
    X ()
logWinHist
  where
    pop :: StateT (Stream (Window, Location)) X (Window, Location)
pop = do
      (Window, Location)
h :~ Stream (Window, Location)
t <- StateT (Stream (Window, Location)) X (Stream (Window, Location))
forall s (m :: * -> *). MonadState s m => m s
get
      Stream (Window, Location)
-> StateT (Stream (Window, Location)) X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Stream (Window, Location)
t StateT (Stream (Window, Location)) X ()
-> (Window, Location)
-> StateT (Stream (Window, Location)) X (Window, Location)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Window, Location)
h

-- }}}

-- --< Raw Config >-- {{{

logWinHist :: X ()
logWinHist :: X ()
logWinHist = do
  wh :: WindowHistory
wh@WinHist{Bool
busy :: WindowHistory -> Bool
busy :: Bool
busy,History Window Location
hist :: WindowHistory -> History Window Location
hist :: History Window Location
hist} <- X WindowHistory
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
  Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
busy (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ do
    Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cs <- (XState
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> X (Screen
        WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Screen WorkspaceId (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 (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> (XState
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> XState
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
windowset)
    let cws :: Workspace WorkspaceId (Layout Window) Window
cws = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cs
    Maybe (Stack Window) -> (Stack Window -> X ()) -> X ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Workspace WorkspaceId (Layout Window) Window
-> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack Workspace WorkspaceId (Layout Window) Window
cws) ((Stack Window -> X ()) -> X ()) -> (Stack Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Stack Window
st -> do
      let location :: Location
location = Location{ workspace :: WorkspaceId
workspace = Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag Workspace WorkspaceId (Layout Window) Window
cws, screen :: ScreenId
screen = Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
cs }
      WindowHistory -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put WindowHistory
wh{ hist = event (W.focus st) location hist }

winHistEH :: Event -> X All
winHistEH :: Event -> X All
winHistEH Event
ev = Bool -> All
All Bool
True All -> X () -> X All
forall a b. a -> X b -> X a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case Event
ev 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 ()
forall {m :: * -> *}. XLike m => Window -> m ()
collect Window
w)
  DestroyWindowEvent{                ev_window :: Event -> Window
ev_window = Window
w } -> Window -> X ()
forall {m :: * -> *}. XLike m => Window -> m ()
collect Window
w
  Event
_                                                  -> () -> X ()
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where collect :: Window -> m ()
collect Window
w = (WindowHistory -> WindowHistory) -> m ()
forall a (m :: * -> *).
(ExtensionClass a, XLike m) =>
(a -> a) -> m ()
XS.modify ((WindowHistory -> WindowHistory) -> m ())
-> (WindowHistory -> WindowHistory) -> m ()
forall a b. (a -> b) -> a -> b
$ \wh :: WindowHistory
wh@WinHist{History Window Location
hist :: WindowHistory -> History Window Location
hist :: History Window Location
hist} -> WindowHistory
wh{ hist = erase w hist }

-- }}}