{-# language DeriveGeneric, DeriveAnyClass #-}
----------------------------------------------------------------------
-- |
-- Module      : XMonad.Actions.GroupNavigation
-- Description : Cycle through groups of windows across workspaces.
-- Copyright   : (c) nzeh@cs.dal.ca
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : nzeh@cs.dal.ca
-- Stability   : unstable
-- Portability : unportable
--
-- Provides methods for cycling through groups of windows across
-- workspaces, ignoring windows that do not belong to this group.  A
-- group consists of all windows matching a user-provided boolean
-- query.
--
-- Also provides a method for jumping back to the most recently used
-- window in any given group, and predefined groups.
--
----------------------------------------------------------------------

module XMonad.Actions.GroupNavigation ( -- * Usage
                                        -- $usage
                                        Direction (..)
                                      , nextMatch
                                      , nextMatchOrDo
                                      , nextMatchWithThis
                                      , historyHook

                                        -- * Utilities
                                        -- $utilities
                                      , isOnAnyVisibleWS
                                      ) where

import Control.Monad.Reader
import Control.Monad.State
import Control.DeepSeq
import Data.Map ((!))
import qualified Data.Map as Map
import Data.Sequence (Seq, ViewL (EmptyL, (:<)), viewl, (<|), (><), (|>))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Graphics.X11.Types
import GHC.Generics
import Prelude hiding (drop, elem, filter, null, reverse)
import XMonad.Core
import XMonad.ManageHook
import XMonad.Operations (windows, withFocused)
import XMonad.Prelude (elem, foldl')
import qualified XMonad.StackSet as SS
import qualified XMonad.Util.ExtensibleState as XS

{- $usage

Import the module into your @~\/.xmonad\/xmonad.hs@:

> import XMonad.Actions.GroupNavigation

To support cycling forward and backward through all xterm windows, add
something like this to your keybindings:

> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))

These key combinations do nothing if there is no xterm window open.
If you rather want to open a new xterm window if there is no open
xterm window, use 'nextMatchOrDo' instead:

> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))

You can use 'nextMatchWithThis' with an arbitrary query to cycle
through all windows for which this query returns the same value as the
current window.  For example, to cycle through all windows in the same
window class as the current window use:

> , ((modm , xK_f), nextMatchWithThis Forward  className)
> , ((modm , xK_b), nextMatchWithThis Backward className)

Finally, you can define keybindings to jump to the most recent window
matching a certain Boolean query.  To do this, you need to add
'historyHook' to your logHook:

> main = xmonad $ def { logHook = historyHook }

Then the following keybindings, for example, allow you to return to
the most recent xterm or emacs window or to simply to the most recent
window:

> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
> , ((modm                , xK_BackSpace), nextMatch History (return True))

Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
to execute an action if no window matching the query exists. -}

--- Basic cyclic navigation based on queries -------------------------

-- | The direction in which to look for the next match
data Direction = Forward  -- ^ Forward from current window or workspace
               | Backward -- ^ Backward from current window or workspace
               | History  -- ^ Backward in history

-- | Focuses the next window for which the given query produces the
-- same result as the currently focused window.  Does nothing if there
-- is no focused window (i.e., the current workspace is empty).
nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
nextMatchWithThis :: forall a. Eq a => Direction -> Query a -> X ()
nextMatchWithThis Direction
dir Query a
qry = (Window -> X ()) -> X ()
withFocused ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ \Window
win -> do
  a
prop <- Query a -> Window -> X a
forall a. Query a -> Window -> X a
runQuery Query a
qry Window
win
  Direction -> Query Bool -> X ()
nextMatch Direction
dir (Query a
qry Query a -> a -> Query Bool
forall a. Eq a => Query a -> a -> Query Bool
=? a
prop)

-- | Focuses the next window that matches the given boolean query.
-- Does nothing if there is no such window.  This is the same as
-- 'nextMatchOrDo' with alternate action @return ()@.
nextMatch :: Direction -> Query Bool -> X ()
nextMatch :: Direction -> Query Bool -> X ()
nextMatch Direction
dir Query Bool
qry = Direction -> Query Bool -> X () -> X ()
nextMatchOrDo Direction
dir Query Bool
qry (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Focuses the next window that matches the given boolean query.  If
-- there is no such window, perform the given action instead.
nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
nextMatchOrDo Direction
dir Query Bool
qry X ()
act = Direction -> X (Seq Window)
orderedWindowList Direction
dir
                            X (Seq Window) -> (Seq Window -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo Query Bool
qry X ()
act

-- Produces the action to perform depending on whether there's a
-- matching window
focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
focusNextMatchOrDo Query Bool
qry X ()
act = (Window -> X Bool) -> Seq Window -> X (Maybe Window)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM (Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery Query Bool
qry)
                             (Seq Window -> X (Maybe Window))
-> (Maybe Window -> X ()) -> Seq Window -> X ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> X () -> (Window -> X ()) -> Maybe Window -> X ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe X ()
act ((WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (Window -> WindowSet -> WindowSet) -> Window -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
forall s a i l sd.
(Eq s, Eq a, Eq i) =>
a -> StackSet i l a s sd -> StackSet i l a s sd
SS.focusWindow)

-- Returns the list of windows ordered by workspace as specified in
-- ~/.xmonad/xmonad.hs
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList Direction
History = (HistoryDB -> Seq Window) -> X HistoryDB -> X (Seq Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(HistoryDB Maybe Window
w Seq Window
ws) -> Seq Window -> (Window -> Seq Window) -> Maybe Window -> Seq Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq Window
ws (Seq Window
ws Seq Window -> Window -> Seq Window
forall a. Seq a -> a -> Seq a
|>) Maybe Window
w) X HistoryDB
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get
orderedWindowList Direction
dir     = (WindowSet -> X (Seq Window)) -> X (Seq Window)
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X (Seq Window)) -> X (Seq Window))
-> (WindowSet -> X (Seq Window)) -> X (Seq Window)
forall a b. (a -> b) -> a -> b
$ \WindowSet
ss -> do
  Seq WorkspaceId
wsids <- (XConf -> Seq WorkspaceId) -> X (Seq WorkspaceId)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ([WorkspaceId] -> Seq WorkspaceId
forall a. [a] -> Seq a
Seq.fromList ([WorkspaceId] -> Seq WorkspaceId)
-> (XConf -> [WorkspaceId]) -> XConf -> Seq WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConfig Layout -> [WorkspaceId]
forall (l :: * -> *). XConfig l -> [WorkspaceId]
workspaces (XConfig Layout -> [WorkspaceId])
-> (XConf -> XConfig Layout) -> XConf -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> XConfig Layout
config)
  let wspcs :: Seq WindowSpace
wspcs = WindowSet -> Seq WorkspaceId -> Seq WindowSpace
orderedWorkspaceList WindowSet
ss Seq WorkspaceId
wsids
      wins :: Seq Window
wins  = Direction -> Seq Window -> Seq Window
forall {a}. Direction -> Seq a -> Seq a
dirfun Direction
dir
              (Seq Window -> Seq Window) -> Seq Window -> Seq Window
forall a b. (a -> b) -> a -> b
$ (Seq Window -> Seq Window -> Seq Window)
-> Seq Window -> Seq (Seq Window) -> Seq Window
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Seq Window -> Seq Window -> Seq Window
forall a. Seq a -> Seq a -> Seq a
(><) Seq Window
forall a. Seq a
Seq.empty
              (Seq (Seq Window) -> Seq Window) -> Seq (Seq Window) -> Seq Window
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Seq Window) -> Seq WindowSpace -> Seq (Seq Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Window] -> Seq Window
forall a. [a] -> Seq a
Seq.fromList ([Window] -> Seq Window)
-> (WindowSpace -> [Window]) -> WindowSpace -> Seq Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack Window) -> [Window]
forall a. Maybe (Stack a) -> [a]
SS.integrate' (Maybe (Stack Window) -> [Window])
-> (WindowSpace -> Maybe (Stack Window)) -> WindowSpace -> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
SS.stack) Seq WindowSpace
wspcs
      cur :: Maybe Window
cur   = WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ss
  Seq Window -> X (Seq Window)
forall (m :: * -> *) a. Monad m => a -> m a
return (Seq Window -> X (Seq Window)) -> Seq Window -> X (Seq Window)
forall a b. (a -> b) -> a -> b
$ Seq Window -> (Window -> Seq Window) -> Maybe Window -> Seq Window
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq Window
wins (Seq Window -> Window -> Seq Window
forall {a}. Eq a => Seq a -> a -> Seq a
rotfun Seq Window
wins) Maybe Window
cur
  where
    dirfun :: Direction -> Seq a -> Seq a
dirfun Direction
Backward = Seq a -> Seq a
forall a. Seq a -> Seq a
Seq.reverse
    dirfun Direction
_        = Seq a -> Seq a
forall a. a -> a
id
    rotfun :: Seq a -> a -> Seq a
rotfun Seq a
wins a
x   = Seq a -> Seq a
forall a. Seq a -> Seq a
rotate (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ (a -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x) Seq a
wins

-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
orderedWorkspaceList :: WindowSet -> Seq WorkspaceId -> Seq WindowSpace
orderedWorkspaceList WindowSet
ss Seq WorkspaceId
wsids = (WindowSpace -> Bool) -> Seq WindowSpace -> Seq WindowSpace
forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo WindowSpace -> Bool
forall {l} {a}. Workspace WorkspaceId l a -> Bool
isCurWS Seq WindowSpace
wspcs'
    where
      wspcs :: [WindowSpace]
wspcs      = WindowSet -> [WindowSpace]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
SS.workspaces WindowSet
ss
      wspcsMap :: Map WorkspaceId WindowSpace
wspcsMap   = (Map WorkspaceId WindowSpace
 -> WindowSpace -> Map WorkspaceId WindowSpace)
-> Map WorkspaceId WindowSpace
-> [WindowSpace]
-> Map WorkspaceId WindowSpace
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map WorkspaceId WindowSpace
m WindowSpace
ws -> WorkspaceId
-> WindowSpace
-> Map WorkspaceId WindowSpace
-> Map WorkspaceId WindowSpace
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
SS.tag WindowSpace
ws) WindowSpace
ws Map WorkspaceId WindowSpace
m) Map WorkspaceId WindowSpace
forall k a. Map k a
Map.empty [WindowSpace]
wspcs
      wspcs' :: Seq WindowSpace
wspcs'     = (WorkspaceId -> WindowSpace) -> Seq WorkspaceId -> Seq WindowSpace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map WorkspaceId WindowSpace
wspcsMap Map WorkspaceId WindowSpace -> WorkspaceId -> WindowSpace
forall k a. Ord k => Map k a -> k -> a
!) Seq WorkspaceId
wsids
      isCurWS :: Workspace WorkspaceId l a -> Bool
isCurWS Workspace WorkspaceId l a
ws = Workspace WorkspaceId l a -> WorkspaceId
forall i l a. Workspace i l a -> i
SS.tag Workspace WorkspaceId l a
ws WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
== WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
SS.tag (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
SS.workspace (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> WindowSpace)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall a b. (a -> b) -> a -> b
$ WindowSet
-> 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
SS.current WindowSet
ss)

--- History navigation, requires a layout modifier -------------------

-- The state extension that holds the history information
data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
                           (Seq Window)   -- previously focused windows
               deriving (ReadPrec [HistoryDB]
ReadPrec HistoryDB
Int -> ReadS HistoryDB
ReadS [HistoryDB]
(Int -> ReadS HistoryDB)
-> ReadS [HistoryDB]
-> ReadPrec HistoryDB
-> ReadPrec [HistoryDB]
-> Read HistoryDB
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HistoryDB]
$creadListPrec :: ReadPrec [HistoryDB]
readPrec :: ReadPrec HistoryDB
$creadPrec :: ReadPrec HistoryDB
readList :: ReadS [HistoryDB]
$creadList :: ReadS [HistoryDB]
readsPrec :: Int -> ReadS HistoryDB
$creadsPrec :: Int -> ReadS HistoryDB
Read, Int -> HistoryDB -> ShowS
[HistoryDB] -> ShowS
HistoryDB -> WorkspaceId
(Int -> HistoryDB -> ShowS)
-> (HistoryDB -> WorkspaceId)
-> ([HistoryDB] -> ShowS)
-> Show HistoryDB
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [HistoryDB] -> ShowS
$cshowList :: [HistoryDB] -> ShowS
show :: HistoryDB -> WorkspaceId
$cshow :: HistoryDB -> WorkspaceId
showsPrec :: Int -> HistoryDB -> ShowS
$cshowsPrec :: Int -> HistoryDB -> ShowS
Show, (forall x. HistoryDB -> Rep HistoryDB x)
-> (forall x. Rep HistoryDB x -> HistoryDB) -> Generic HistoryDB
forall x. Rep HistoryDB x -> HistoryDB
forall x. HistoryDB -> Rep HistoryDB x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryDB x -> HistoryDB
$cfrom :: forall x. HistoryDB -> Rep HistoryDB x
Generic, HistoryDB -> ()
(HistoryDB -> ()) -> NFData HistoryDB
forall a. (a -> ()) -> NFData a
rnf :: HistoryDB -> ()
$crnf :: HistoryDB -> ()
NFData)

instance ExtensionClass HistoryDB where

    initialValue :: HistoryDB
initialValue  = Maybe Window -> Seq Window -> HistoryDB
HistoryDB Maybe Window
forall a. Maybe a
Nothing Seq Window
forall a. Seq a
Seq.empty
    extensionType :: HistoryDB -> StateExtension
extensionType = HistoryDB -> StateExtension
forall a. (Read a, Show a, ExtensionClass a) => a -> StateExtension
PersistentExtension

-- | Action that needs to be executed as a logHook to maintain the
-- focus history of all windows as the WindowSet changes.
historyHook :: X ()
historyHook :: X ()
historyHook = (HistoryDB -> X ()
forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m ()
XS.put (HistoryDB -> X ()) -> HistoryDB -> X ()
forall a b. (a -> b) -> a -> b
$!) (HistoryDB -> X ())
-> (HistoryDB -> HistoryDB) -> HistoryDB -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HistoryDB -> HistoryDB
forall a. NFData a => a -> a
force (HistoryDB -> X ()) -> X HistoryDB -> X ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HistoryDB -> X HistoryDB
updateHistory (HistoryDB -> X HistoryDB) -> X HistoryDB -> X HistoryDB
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X HistoryDB
forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a
XS.get

-- Updates the history in response to a WindowSet change
updateHistory :: HistoryDB -> X HistoryDB
updateHistory :: HistoryDB -> X HistoryDB
updateHistory (HistoryDB Maybe Window
oldcur Seq Window
oldhist) = (WindowSet -> X HistoryDB) -> X HistoryDB
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> X HistoryDB) -> X HistoryDB)
-> (WindowSet -> X HistoryDB) -> X HistoryDB
forall a b. (a -> b) -> a -> b
$ \WindowSet
ss ->
  let newcur :: Maybe Window
newcur   = WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ss
      wins :: Set Window
wins     = [Window] -> Set Window
forall a. Ord a => [a] -> Set a
Set.fromList ([Window] -> Set Window) -> [Window] -> Set Window
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Window]
forall a i l s sd. Eq a => StackSet i l a s sd -> [a]
SS.allWindows WindowSet
ss
      newhist :: Seq Window
newhist  = (Window -> Bool) -> Seq Window -> Seq Window
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (Window -> Set Window -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Window
wins) (Maybe Window -> Seq Window -> Seq Window
forall {a}. Maybe a -> Seq a -> Seq a
ins Maybe Window
oldcur Seq Window
oldhist)
  in HistoryDB -> X HistoryDB
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HistoryDB -> X HistoryDB) -> HistoryDB -> X HistoryDB
forall a b. (a -> b) -> a -> b
$ Maybe Window -> Seq Window -> HistoryDB
HistoryDB Maybe Window
newcur (Maybe Window -> Seq Window -> Seq Window
forall {a}. Eq a => Maybe a -> Seq a -> Seq a
del Maybe Window
newcur Seq Window
newhist)
  where
    ins :: Maybe a -> Seq a -> Seq a
ins Maybe a
x Seq a
xs = Seq a -> (a -> Seq a) -> Maybe a -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
xs (a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
xs) Maybe a
x
    del :: Maybe a -> Seq a -> Seq a
del Maybe a
x Seq a
xs = Seq a -> (a -> Seq a) -> Maybe a -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq a
xs (\a
x' -> (a -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x') Seq a
xs) Maybe a
x

--- Some sequence helpers --------------------------------------------

-- Rotates the sequence by one position
rotate :: Seq a -> Seq a
rotate :: forall a. Seq a -> Seq a
rotate Seq a
xs = ViewL a -> Seq a
forall {a}. ViewL a -> Seq a
rotate' (Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs)
  where
    rotate' :: ViewL a -> Seq a
rotate' ViewL a
EmptyL      = Seq a
forall a. Seq a
Seq.empty
    rotate' (a
x' :< Seq a
xs') = Seq a
xs' Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
x'

-- Rotates the sequence until an element matching the given condition
-- is at the beginning of the sequence.
rotateTo :: (a -> Bool) -> Seq a -> Seq a
rotateTo :: forall a. (a -> Bool) -> Seq a -> Seq a
rotateTo a -> Bool
cond Seq a
xs = let (Seq a
lxs, Seq a
rxs) = (a -> Bool) -> Seq a -> (Seq a, Seq a)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
Seq.breakl a -> Bool
cond Seq a
xs in Seq a
rxs Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
lxs

--- A monadic find ---------------------------------------------------

-- Applies the given action to every sequence element in turn until
-- the first element is found for which the action returns true.  The
-- remaining elements in the sequence are ignored.
findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM a -> m Bool
cond Seq a
xs = (a -> m Bool) -> ViewL a -> m (Maybe a)
forall {m :: * -> *} {a}.
Monad m =>
(a -> m Bool) -> ViewL a -> m (Maybe a)
findM' a -> m Bool
cond (Seq a -> ViewL a
forall a. Seq a -> ViewL a
viewl Seq a
xs)
  where
    findM' :: (a -> m Bool) -> ViewL a -> m (Maybe a)
findM' a -> m Bool
_   ViewL a
EmptyL      = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    findM' a -> m Bool
qry (a
x' :< Seq a
xs') = do
      Bool
isMatch <- a -> m Bool
qry a
x'
      if Bool
isMatch
        then Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x')
        else (a -> m Bool) -> Seq a -> m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Seq a -> m (Maybe a)
findM a -> m Bool
qry Seq a
xs'


-- $utilities
-- #utilities#
-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
-- and 'nextMatchWithThis'.

-- | A query that matches all windows on visible workspaces. This is
-- useful for configurations with multiple screens, and matches even
-- invisible windows.
isOnAnyVisibleWS :: Query Bool
isOnAnyVisibleWS :: Query Bool
isOnAnyVisibleWS = do
  Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
  WindowSet
ws <- X WindowSet -> Query WindowSet
forall a. X a -> Query a
liftX (X WindowSet -> Query WindowSet) -> X WindowSet -> Query WindowSet
forall a b. (a -> b) -> a -> b
$ (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
  let allVisible :: [Window]
allVisible = (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> [Window])
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Window]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Window]
-> (Stack Window -> [Window]) -> Maybe (Stack Window) -> [Window]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Stack Window -> [Window]
forall a. Stack a -> [a]
SS.integrate (Maybe (Stack Window) -> [Window])
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> Maybe (Stack Window))
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Window]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack Window)
forall i l a. Workspace i l a -> Maybe (Stack a)
SS.stack (WindowSpace -> Maybe (Stack Window))
-> (Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> WindowSpace)
-> Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> Maybe (Stack Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
SS.workspace) (WindowSet
-> 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
SS.current WindowSet
wsScreen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
-> [Screen
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
:WindowSet
-> [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]
SS.visible WindowSet
ws)
      visibleWs :: Bool
visibleWs = Window
w Window -> [Window] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
allVisible
      unfocused :: Bool
unfocused = Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
SS.peek WindowSet
ws
  Bool -> Query Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Query Bool) -> Bool -> Query Bool
forall a b. (a -> b) -> a -> b
$ Bool
visibleWs Bool -> Bool -> Bool
&& Bool
unfocused