{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.CycleRecentWS
-- Description :  Cycle through most recently used workspaces.
-- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Michal Janeczek <janeczek@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Provides bindings to cycle through most recently used workspaces
-- with repeated presses of a single key (as long as modifier key is
-- held down). This is similar to how many window managers handle
-- window switching.
--
-----------------------------------------------------------------------------

module XMonad.Actions.CycleRecentWS (
                                -- * Usage
                                -- $usage
                                cycleRecentWS,
                                cycleRecentNonEmptyWS,
                                cycleWindowSets,
                                toggleRecentWS,
                                toggleRecentNonEmptyWS,
                                toggleWindowSets,
                                recentWS,

#ifdef TESTING
                                unView,
#endif
) where

import XMonad hiding (workspaces)
import XMonad.StackSet hiding (filter)

import Control.Arrow ((&&&))
import Data.Function (on)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleRecentWS
-- >
-- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
--
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".

-- | Cycle through most recent workspaces with repeated presses of a key, while
--   a modifier key is held down. The recency of workspaces previewed while browsing
--   to the target workspace is not affected. That way a stack of most recently used
--   workspaces is maintained, similarly to how many window managers handle window
--   switching. For best effects use the same modkey+key combination as the one used
--   to invoke this action.
cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
                          --   As soon as one of them is released, the final switch is made.
              -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
              -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
                          --   If it's the same as the nextWorkspace key, it is effectively ignored.
              -> X ()
cycleRecentWS :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentWS = (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets ((WindowSet -> [WorkspaceId])
 -> [KeySym] -> KeySym -> KeySym -> X ())
-> (WindowSet -> [WorkspaceId])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> WindowSpace -> Bool
forall a b. a -> b -> a
const Bool
True)


-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.
cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
                                  --   As soon as one of them is released, the final switch is made.
                      -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
                      -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
                                  --   If it's the same as the nextWorkspace key, it is effectively ignored.
                      -> X ()
cycleRecentNonEmptyWS :: [KeySym] -> KeySym -> KeySym -> X ()
cycleRecentNonEmptyWS = (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets ((WindowSet -> [WorkspaceId])
 -> [KeySym] -> KeySym -> KeySym -> X ())
-> (WindowSet -> [WorkspaceId])
-> [KeySym]
-> KeySym
-> KeySym
-> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not (Bool -> Bool) -> (WindowSpace -> Bool) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (Stack KeySym) -> Bool)
-> (WindowSpace -> Maybe (Stack KeySym)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack)


-- | Switch to the most recent workspace. The stack of most recently used workspaces
-- is updated, so repeated use toggles between a pair of workspaces.
toggleRecentWS :: X ()
toggleRecentWS :: X ()
toggleRecentWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets ((WindowSet -> [WorkspaceId]) -> X ())
-> (WindowSet -> [WorkspaceId]) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> WindowSpace -> Bool
forall a b. a -> b -> a
const Bool
True)


-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS :: X ()
toggleRecentNonEmptyWS = (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets ((WindowSet -> [WorkspaceId]) -> X ())
-> (WindowSet -> [WorkspaceId]) -> X ()
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS (Bool -> Bool
not (Bool -> Bool) -> (WindowSpace -> Bool) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack KeySym) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (Stack KeySym) -> Bool)
-> (WindowSpace -> Maybe (Stack KeySym)) -> WindowSpace -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSpace -> Maybe (Stack KeySym)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack)


-- | Given a predicate @p@ and the current 'WindowSet' @w@, create a
-- list of workspaces to choose from. They are ordered by recency and
-- have to satisfy @p@.
recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
         -> WindowSet             -- ^ The current WindowSet
         -> [WorkspaceId]
recentWS :: (WindowSpace -> Bool) -> WindowSet -> [WorkspaceId]
recentWS WindowSpace -> Bool
p WindowSet
w = (WindowSpace -> WorkspaceId) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> [a] -> [b]
map WindowSpace -> WorkspaceId
forall i l a. Workspace i l a -> i
tag
             ([WindowSpace] -> [WorkspaceId]) -> [WindowSpace] -> [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ (WindowSpace -> Bool) -> [WindowSpace] -> [WindowSpace]
forall a. (a -> Bool) -> [a] -> [a]
filter WindowSpace -> Bool
p
             ([WindowSpace] -> [WindowSpace]) -> [WindowSpace] -> [WindowSpace]
forall a b. (a -> b) -> a -> b
$ (Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
 -> WindowSpace)
-> [Screen
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail]
-> [WindowSpace]
forall a b. (a -> b) -> [a] -> [b]
map Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (WindowSet
-> [Screen
      WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
w)
               [WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ WindowSet -> [WindowSpace]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
w
               [WindowSpace] -> [WindowSpace] -> [WindowSpace]
forall a. [a] -> [a] -> [a]
++ [Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
-> WindowSpace
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace (WindowSet
-> Screen WorkspaceId (Layout KeySym) KeySym ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
w)]

-- | Cycle through a finite list of workspaces with repeated presses of a key, while
--   a modifier key is held down. For best effects use the same modkey+key combination
--   as the one used to invoke this action.
cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a list of workspaces to choose from
                -> [KeySym]                     -- ^ A list of modifier keys used when invoking this action.
                                                --   As soon as one of them is released, the final workspace is chosen and the action exits.
                -> KeySym                       -- ^ Key used to preview next workspace from the list of generated options
                -> KeySym                       -- ^ Key used to preview previous workspace from the list of generated options.
                                                --   If it's the same as nextOption key, it is effectively ignored.
                -> X ()
cycleWindowSets :: (WindowSet -> [WorkspaceId])
-> [KeySym] -> KeySym -> KeySym -> X ()
cycleWindowSets WindowSet -> [WorkspaceId]
genOptions [KeySym]
mods KeySym
keyNext KeySym
keyPrev = do
  ([WorkspaceId]
options, WindowSet -> WindowSet
unView') <- (XState -> ([WorkspaceId], WindowSet -> WindowSet))
-> X ([WorkspaceId], WindowSet -> WindowSet)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> ([WorkspaceId], WindowSet -> WindowSet))
 -> X ([WorkspaceId], WindowSet -> WindowSet))
-> (XState -> ([WorkspaceId], WindowSet -> WindowSet))
-> X ([WorkspaceId], WindowSet -> WindowSet)
forall a b. (a -> b) -> a -> b
$ (WindowSet -> [WorkspaceId]
genOptions (WindowSet -> [WorkspaceId])
-> (WindowSet -> WindowSet -> WindowSet)
-> WindowSet
-> ([WorkspaceId], WindowSet -> WindowSet)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WindowSet -> WindowSet -> WindowSet
forall i l a s sd.
(Eq i, Eq s) =>
StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView) (WindowSet -> ([WorkspaceId], WindowSet -> WindowSet))
-> (XState -> WindowSet)
-> XState
-> ([WorkspaceId], WindowSet -> WindowSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  XConf {theRoot :: XConf -> KeySym
theRoot = KeySym
root, display :: XConf -> Display
display = Display
d} <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
  let event :: IO (EventType, KeySym)
event = (XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym)
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym))
-> (XEventPtr -> IO (EventType, KeySym)) -> IO (EventType, KeySym)
forall a b. (a -> b) -> a -> b
$ \XEventPtr
p -> do
                Display -> KeySym -> XEventPtr -> IO ()
maskEvent Display
d (KeySym
keyPressMask KeySym -> KeySym -> KeySym
forall a. Bits a => a -> a -> a
.|. KeySym
keyReleaseMask) XEventPtr
p
                KeyEvent {ev_event_type :: Event -> EventType
ev_event_type = EventType
t, ev_keycode :: Event -> KeyCode
ev_keycode = KeyCode
c} <- XEventPtr -> IO Event
getEvent XEventPtr
p
                KeySym
s <- Display -> KeyCode -> CInt -> IO KeySym
keycodeToKeysym Display
d KeyCode
c CInt
0
                (EventType, KeySym) -> IO (EventType, KeySym)
forall (m :: * -> *) a. Monad m => a -> m a
return (EventType
t, KeySym
s)
  let setOption :: Int -> X ()
setOption Int
n = do (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> 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
view ([WorkspaceId]
options [WorkspaceId] -> Int -> WorkspaceId
forall a. [a] -> Int -> a
`cycref` Int
n) (WindowSet -> WindowSet)
-> (WindowSet -> WindowSet) -> WindowSet -> WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowSet
unView'
                       (EventType
t, KeySym
s) <- IO (EventType, KeySym) -> X (EventType, KeySym)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO (EventType, KeySym)
event
                       case () of
                         () | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress   Bool -> Bool -> Bool
&& KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyNext  -> Int -> X ()
setOption (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                            | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyPress   Bool -> Bool -> Bool
&& KeySym
s KeySym -> KeySym -> Bool
forall a. Eq a => a -> a -> Bool
== KeySym
keyPrev  -> Int -> X ()
setOption (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                            | EventType
t EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
keyRelease Bool -> Bool -> Bool
&& KeySym
s KeySym -> [KeySym] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KeySym]
mods -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                            | Bool
otherwise                        -> Int -> X ()
setOption Int
n
  IO CInt -> X CInt
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO CInt -> X CInt) -> IO CInt -> X CInt
forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> Bool -> CInt -> CInt -> KeySym -> IO CInt
grabKeyboard Display
d KeySym
root Bool
False CInt
grabModeAsync CInt
grabModeAsync KeySym
currentTime
  Int -> X ()
setOption Int
0
  IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Display -> KeySym -> IO ()
ungrabKeyboard Display
d KeySym
currentTime
 where
  cycref :: [a] -> Int -> a
  cycref :: forall a. [a] -> Int -> a
cycref [a]
l Int
i = [a]
l [a] -> Int -> a
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l)

-- | Given an old and a new 'WindowSet', which is __exactly__ one
-- 'view' away from the old one, restore the workspace order of the
-- former inside of the latter.  This respects any new state that the
-- new 'WindowSet' may have accumulated.
unView :: forall i l a s sd. (Eq i, Eq s)
       => StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView :: forall i l a s sd.
(Eq i, Eq s) =>
StackSet i l a s sd -> StackSet i l a s sd -> StackSet i l a s sd
unView StackSet i l a s sd
w0 StackSet i l a s sd
w1 = StackSet i l a s sd -> StackSet i l a s sd
forall {sid} {sd}. StackSet i l a sid sd -> StackSet i l a sid sd
fixOrderH (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> StackSet i l a s sd
fixOrderV (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
forall {l} {a} {sd}.
i -> StackSet i l a s sd -> StackSet i l a s sd
view' (StackSet i l a s sd -> i
forall i l a s sd. StackSet i l a s sd -> i
currentTag StackSet i l a s sd
w0) (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd
w1
 where
  view' :: i -> StackSet i l a s sd -> StackSet i l a s sd
view' = if Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
w0) s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== Screen i l a s sd -> s
forall i l a sid sd. Screen i l a sid sd -> sid
screen (StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current StackSet i l a s sd
w1) then i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
greedyView else i -> StackSet i l a s sd -> StackSet i l a s sd
forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
view
  fixOrderV :: StackSet i l a s sd -> StackSet i l a s sd
fixOrderV StackSet i l a s sd
w | Screen i l a s sd
v : [Screen i l a s sd]
vs <- StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
w = StackSet i l a s sd
w{ visible :: [Screen i l a s sd]
visible = Int
-> Screen i l a s sd -> [Screen i l a s sd] -> [Screen i l a s sd]
forall x. Int -> x -> [x] -> [x]
insertAt ([Screen i l a s sd] -> [Screen i l a s sd] -> Int
forall {l} {a} {sid} {sd}.
[Screen i l a sid sd] -> [Screen i l a sid sd] -> Int
pfxV (StackSet i l a s sd -> [Screen i l a s sd]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible StackSet i l a s sd
w0) [Screen i l a s sd]
vs) Screen i l a s sd
v [Screen i l a s sd]
vs }
              | Bool
otherwise = StackSet i l a s sd
w
  fixOrderH :: StackSet i l a sid sd -> StackSet i l a sid sd
fixOrderH StackSet i l a sid sd
w | Workspace i l a
h : [Workspace i l a]
hs <- StackSet i l a sid sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a sid sd
w = StackSet i l a sid sd
w{ hidden :: [Workspace i l a]
hidden = Int -> Workspace i l a -> [Workspace i l a] -> [Workspace i l a]
forall x. Int -> x -> [x] -> [x]
insertAt ([Workspace i l a] -> [Workspace i l a] -> Int
forall {l} {a}. [Workspace i l a] -> [Workspace i l a] -> Int
pfxH (StackSet i l a s sd -> [Workspace i l a]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden StackSet i l a s sd
w0) [Workspace i l a]
hs) Workspace i l a
h [Workspace i l a]
hs }
              | Bool
otherwise = StackSet i l a sid sd
w
  pfxV :: [Screen i l a sid sd] -> [Screen i l a sid sd] -> Int
pfxV = [i] -> [i] -> Int
forall x. Eq x => [x] -> [x] -> Int
commonPrefix ([i] -> [i] -> Int)
-> ([Screen i l a sid sd] -> [i])
-> [Screen i l a sid sd]
-> [Screen i l a sid sd]
-> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Screen i l a sid sd -> i) -> [Screen i l a sid sd] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag (Workspace i l a -> i)
-> (Screen i l a sid sd -> Workspace i l a)
-> Screen i l a sid sd
-> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a sid sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace)
  pfxH :: [Workspace i l a] -> [Workspace i l a] -> Int
pfxH = [i] -> [i] -> Int
forall x. Eq x => [x] -> [x] -> Int
commonPrefix ([i] -> [i] -> Int)
-> ([Workspace i l a] -> [i])
-> [Workspace i l a]
-> [Workspace i l a]
-> Int
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Workspace i l a -> i) -> [Workspace i l a] -> [i]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Workspace i l a -> i
forall i l a. Workspace i l a -> i
tag

  insertAt :: Int -> x -> [x] -> [x]
  insertAt :: forall x. Int -> x -> [x] -> [x]
insertAt Int
n x
x [x]
xs = let ([x]
l, [x]
r) = Int -> [x] -> ([x], [x])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [x]
xs in [x]
l [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x
x] [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ [x]
r

  commonPrefix :: Eq x => [x] -> [x] -> Int
  commonPrefix :: forall x. Eq x => [x] -> [x] -> Int
commonPrefix [x]
a [x]
b = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Bool -> Bool
forall a. a -> a
id ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (x -> x -> Bool) -> [x] -> [x] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith x -> x -> Bool
forall a. Eq a => a -> a -> Bool
(==) [x]
a [x]
b

-- | Given some function that generates a list of workspaces from a
-- given 'WindowSet', switch to the first generated workspace.
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets :: (WindowSet -> [WorkspaceId]) -> X ()
toggleWindowSets WindowSet -> [WorkspaceId]
genOptions = do
  [WorkspaceId]
options <- (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> [WorkspaceId]) -> X [WorkspaceId])
-> (XState -> [WorkspaceId]) -> X [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [WorkspaceId]
genOptions (WindowSet -> [WorkspaceId])
-> (XState -> WindowSet) -> XState -> [WorkspaceId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  case [WorkspaceId]
options of
    []  -> () -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    WorkspaceId
o:[WorkspaceId]
_ -> (WindowSet -> WindowSet) -> X ()
windows (WorkspaceId -> 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
view WorkspaceId
o)