{-# LANGUAGE DerivingVia, GeneralizedNewtypeDeriving, FlexibleContexts #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.PureX
-- Description :  Composable @X@ actions.
-- Copyright   :  L. S. Leary 2018
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  L. S. Leary
-- Stability   :  unstable
-- Portability :  not portable
--
-- Unlike the opaque @IO@ actions that @X@ actions can wrap, regular reads from
-- the 'XConf' and modifications to the 'XState' are fundamentally pure—contrary
-- to the current treatment of such actions in most xmonad code. Pure
-- modifications to the 'WindowSet' can be readily composed, but due to the need
-- for those modifications to be properly handled by 'windows', other pure
-- changes to the @XState@ cannot be interleaved with those changes to the
-- @WindowSet@ without superfluous refreshes, hence breaking composability.
--
-- This module aims to rectify that situation by drawing attention to it and
-- providing 'PureX': a pure type with the same monadic interface to state as
-- @X@. The 'XLike' typeclass enables writing actions generic over the two
-- monads; if pure, existing @X@ actions can be generalised with only a change
-- to the type signature. Various other utilities are provided, in particular
-- the 'defile' function which is needed by end-users.
--
-----------------------------------------------------------------------------

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

module XMonad.Util.PureX (
  -- * Usage
  -- $Usage
  PureX, XLike(..), defile,
  windowBracket', handlingRefresh,
  runPureX, toXLike,
  -- * Utility
  -- ** Generalised when* functions
  when', whenM', whenJust',
  -- ** Infix operators
  (<?), (&>),
  -- ** @WindowSet@ operations
  withWindowSet', withFocii,
  modify'', modifyWindowSet',
  getStack, putStack, peek,
  focusWindow, focusNth,
  view, greedyView, invisiView,
  shift, shiftWin, curScreen, curWorkspace,
  curTag, curScreenId,
) where

-- xmonad
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified XMonad.Actions.FocusNth

-- mtl
import Control.Monad.State
import Control.Monad.Reader

-- }}}

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

-- $Usage
--
-- The suggested pattern of usage for this module is to write composable, pure
-- actions as @XLike m => m Any@ or @PureX Any@ values, where the encapsulated
-- @Any@ value encodes whether or not a refresh is needed to properly institute
-- changes. These values can then be combined monoidally (i.e. with '<>' AKA
-- '<+>') or with operators such as '<*', '*>', '<?' and '&>' to build seamless
-- new actions. The end user can run and handle the effects of the pure actions
-- in the @X@ monad by applying the @defile@ function, which you may want to
-- re-export. Alternatively, if an action does not make stackset changes that
-- need to be handled by @windows@, it can be written with as an
-- @XLike m => m ()@ and used directly.
--
-- Unfortunately since layouts must handle messages in the @X@ monad, this
-- approach does not quite apply to actions involving them. However a relatively
-- direct translation to impure actions is possible: you can write composable,
-- refresh-tracking actions as @X Any@ values, making sure to eschew
-- refresh-inducing functions like @windows@ and @sendMessage@ in favour of
-- 'modifyWindowSet' and utilities provided by "XMonad.Actions.MessageFeedback".
-- The 'windowBracket_' function recently added to "XMonad.Operations" is the
-- impure analogue of @defile@. Note that @PureX Any@ actions can be composed
-- into impure ones after applying 'toX'; don't use @defile@ for this. E.g.
--
-- > windowBracket_ (composableImpureAction <> toX composablePureAction)
--
-- Although both @X@ and @PureX@ have Monoid instances over monoidal values,
-- @(XLike m, Monoid a)@ is not enough to infer @Monoid (m a)@ (due to the
-- open-world assumption). Hence a @Monoid (m Any)@ constraint may need to be
-- used when working with @XLike m => m Any@ where no context is forcing @m@ to
-- unify with @X@ or @PureX@. This can also be avoided by working with
-- @PureX Any@ values and generalising them with 'toXLike' where necessary.
--
-- @PureX@ also enables a more monadic style when writing windowset operations;
-- see the implementation of the utilities in this module for examples.
-- For an example of a whole module written in terms of this one, see
-- "XMonad.Hooks.RefocusLast".
--

-- }}}

-- --< Core >-- {{{

-- | The @PureX@ newtype over @ReaderT XConf (State XState) a@.
newtype PureX a = PureX (ReaderT XConf (State XState) a)
  deriving ((forall a b. (a -> b) -> PureX a -> PureX b)
-> (forall a b. a -> PureX b -> PureX a) -> Functor PureX
forall a b. a -> PureX b -> PureX a
forall a b. (a -> b) -> PureX a -> PureX b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PureX a -> PureX b
fmap :: forall a b. (a -> b) -> PureX a -> PureX b
$c<$ :: forall a b. a -> PureX b -> PureX a
<$ :: forall a b. a -> PureX b -> PureX a
Functor, Functor PureX
Functor PureX =>
(forall a. a -> PureX a)
-> (forall a b. PureX (a -> b) -> PureX a -> PureX b)
-> (forall a b c. (a -> b -> c) -> PureX a -> PureX b -> PureX c)
-> (forall a b. PureX a -> PureX b -> PureX b)
-> (forall a b. PureX a -> PureX b -> PureX a)
-> Applicative PureX
forall a. a -> PureX a
forall a b. PureX a -> PureX b -> PureX a
forall a b. PureX a -> PureX b -> PureX b
forall a b. PureX (a -> b) -> PureX a -> PureX b
forall a b c. (a -> b -> c) -> PureX a -> PureX b -> PureX c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> PureX a
pure :: forall a. a -> PureX a
$c<*> :: forall a b. PureX (a -> b) -> PureX a -> PureX b
<*> :: forall a b. PureX (a -> b) -> PureX a -> PureX b
$cliftA2 :: forall a b c. (a -> b -> c) -> PureX a -> PureX b -> PureX c
liftA2 :: forall a b c. (a -> b -> c) -> PureX a -> PureX b -> PureX c
$c*> :: forall a b. PureX a -> PureX b -> PureX b
*> :: forall a b. PureX a -> PureX b -> PureX b
$c<* :: forall a b. PureX a -> PureX b -> PureX a
<* :: forall a b. PureX a -> PureX b -> PureX a
Applicative, Applicative PureX
Applicative PureX =>
(forall a b. PureX a -> (a -> PureX b) -> PureX b)
-> (forall a b. PureX a -> PureX b -> PureX b)
-> (forall a. a -> PureX a)
-> Monad PureX
forall a. a -> PureX a
forall a b. PureX a -> PureX b -> PureX b
forall a b. PureX a -> (a -> PureX b) -> PureX b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. PureX a -> (a -> PureX b) -> PureX b
>>= :: forall a b. PureX a -> (a -> PureX b) -> PureX b
$c>> :: forall a b. PureX a -> PureX b -> PureX b
>> :: forall a b. PureX a -> PureX b -> PureX b
$creturn :: forall a. a -> PureX a
return :: forall a. a -> PureX a
Monad, MonadReader XConf, MonadState XState)
  deriving (NonEmpty (PureX a) -> PureX a
PureX a -> PureX a -> PureX a
(PureX a -> PureX a -> PureX a)
-> (NonEmpty (PureX a) -> PureX a)
-> (forall b. Integral b => b -> PureX a -> PureX a)
-> Semigroup (PureX a)
forall b. Integral b => b -> PureX a -> PureX a
forall a. Semigroup a => NonEmpty (PureX a) -> PureX a
forall a. Semigroup a => PureX a -> PureX a -> PureX a
forall a b. (Semigroup a, Integral b) => b -> PureX a -> PureX a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a. Semigroup a => PureX a -> PureX a -> PureX a
<> :: PureX a -> PureX a -> PureX a
$csconcat :: forall a. Semigroup a => NonEmpty (PureX a) -> PureX a
sconcat :: NonEmpty (PureX a) -> PureX a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> PureX a -> PureX a
stimes :: forall b. Integral b => b -> PureX a -> PureX a
Semigroup, Semigroup (PureX a)
PureX a
Semigroup (PureX a) =>
PureX a
-> (PureX a -> PureX a -> PureX a)
-> ([PureX a] -> PureX a)
-> Monoid (PureX a)
[PureX a] -> PureX a
PureX a -> PureX a -> PureX a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (PureX a)
forall a. Monoid a => PureX a
forall a. Monoid a => [PureX a] -> PureX a
forall a. Monoid a => PureX a -> PureX a -> PureX a
$cmempty :: forall a. Monoid a => PureX a
mempty :: PureX a
$cmappend :: forall a. Monoid a => PureX a -> PureX a -> PureX a
mappend :: PureX a -> PureX a -> PureX a
$cmconcat :: forall a. Monoid a => [PureX a] -> PureX a
mconcat :: [PureX a] -> PureX a
Monoid) via Ap PureX a

-- | The @XLike@ typeclass over monads reading @XConf@ values and tracking
--   @XState@ state.
class (MonadReader XConf m, MonadState XState m) => XLike m where
  toX :: m a -> X a

instance XLike X where
  toX :: forall a. X a -> X a
toX = X a -> X a
forall a. a -> a
id

instance XLike PureX where
  toX :: forall a. PureX a -> X a
toX = PureX a -> X a
forall (m :: * -> *) a. XLike m => PureX a -> m a
toXLike

-- | Consume a @PureX a@.
runPureX :: PureX a -> XConf -> XState -> (a, XState)
runPureX :: forall a. PureX a -> XConf -> XState -> (a, XState)
runPureX (PureX ReaderT XConf (State XState) a
m) = State XState a -> XState -> (a, XState)
forall s a. State s a -> s -> (a, s)
runState (State XState a -> XState -> (a, XState))
-> (XConf -> State XState a) -> XConf -> XState -> (a, XState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT XConf (State XState) a -> XConf -> State XState a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT XConf (State XState) a
m

-- | Despite appearing less general, @PureX a@ is actually isomorphic to
--   @XLike m => m a@.
toXLike :: XLike m => PureX a -> m a
toXLike :: forall (m :: * -> *) a. XLike m => PureX a -> m a
toXLike PureX a
pa = (XState -> (a, XState)) -> m a
forall a. (XState -> (a, XState)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state ((XState -> (a, XState)) -> m a)
-> (XConf -> XState -> (a, XState)) -> XConf -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureX a -> XConf -> XState -> (a, XState)
forall a. PureX a -> XConf -> XState -> (a, XState)
runPureX PureX a
pa (XConf -> m a) -> m XConf -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m XConf
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | A generalisation of 'windowBracket'. Handles refreshing for an action that
--   __performs no refresh of its own__ but can indicate that it needs one
--   through a return value that's tested against the supplied predicate. The
--   action can interleave changes to the @WindowSet@ with @IO@ or changes to
--   the @XState@.
windowBracket' :: XLike m => (a -> Bool) -> m a -> X a
windowBracket' :: forall (m :: * -> *) a. XLike m => (a -> Bool) -> m a -> X a
windowBracket' a -> Bool
p = (a -> Bool) -> X a -> X a
forall a. (a -> Bool) -> X a -> X a
windowBracket a -> Bool
p (X a -> X a) -> (m a -> X a) -> m a -> X a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> X a
forall a. m a -> X a
forall (m :: * -> *) a. XLike m => m a -> X a
toX

-- | A version of @windowBracket'@ specialised to take a @PureX Any@ action and
--   handle windowset changes with a refresh when the @Any@ holds @True@.
--   Analogous to 'windowBracket_'. Don't bake this into your action; it's for
--   the end-user.
defile :: PureX Any -> X ()
defile :: PureX Any -> X ()
defile = X Any -> X ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (X Any -> X ()) -> (PureX Any -> X Any) -> PureX Any -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Any -> Bool) -> PureX Any -> X Any
forall (m :: * -> *) a. XLike m => (a -> Bool) -> m a -> X a
windowBracket' Any -> Bool
getAny

-- | A version of @windowBracket@ specialised to take an @X ()@ action and
--   perform a refresh handling any changes it makes.
handlingRefresh :: X () -> X ()
handlingRefresh :: X () -> X ()
handlingRefresh = (() -> Bool) -> X () -> X ()
forall a. (a -> Bool) -> X a -> X a
windowBracket (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)

-- }}}

-- --< Utility >-- {{{

-- | A 'when' that accepts a monoidal return value.
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' :: forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' Bool
b m a
ma = if Bool
b then m a
ma else a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty

-- | A @whenX@/@whenM@ that accepts a monoidal return value.
whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a
whenM' :: forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
whenM' m Bool
mb m a
m = ((m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ m a
m) ((m a -> m a) -> m a) -> (Bool -> m a -> m a) -> Bool -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> m a -> m a
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (Bool -> m a) -> m Bool -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Bool
mb

-- | A 'whenJust' that accepts a monoidal return value.
whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b
whenJust' :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
Maybe a -> (a -> m b) -> m b
whenJust' = ((a -> m b) -> Maybe a -> m b) -> Maybe a -> (a -> m b) -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((a -> m b) -> Maybe a -> m b) -> Maybe a -> (a -> m b) -> m b)
-> ((a -> m b) -> Maybe a -> m b) -> Maybe a -> (a -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Monoid a => a
mempty)

-- | Akin to @<*@. Discarding the wrapped value in the second argument either
--   way, keep its effects iff the first argument returns @Any True@.
(<?) :: Monad m => m Any -> m a -> m Any
m Any
ifthis <? :: forall (m :: * -> *) a. Monad m => m Any -> m a -> m Any
<? m a
thenthis = do
  Any Bool
b <- m Any
ifthis
  Bool -> m Any -> m Any
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' Bool
b (Bool -> Any
Any Bool
b Any -> m a -> m Any
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m a
thenthis)
infixl 4 <?

-- | Akin to a low precedence @<>@. Combines applicative effects left-to-right
--   and wrapped @Bool@s with @&&@ (instead of @||@).
(&>) :: Applicative f => f Any -> f Any -> f Any
&> :: forall (f :: * -> *). Applicative f => f Any -> f Any -> f Any
(&>) = (Any -> Any -> Any) -> f Any -> f Any -> f Any
forall a b c. (a -> b -> c) -> f a -> f b -> f c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Any -> Any -> Any) -> f Any -> f Any -> f Any)
-> (Any -> Any -> Any) -> f Any -> f Any -> f Any
forall a b. (a -> b) -> a -> b
$ \(Any Bool
b1) (Any Bool
b2) -> Bool -> Any
Any (Bool
b1 Bool -> Bool -> Bool
&& Bool
b2)
infixl 1 &>

-- | A generalisation of 'withWindowSet'.
withWindowSet' :: XLike m => (WindowSet -> m a) -> m a
withWindowSet' :: forall (m :: * -> *) a. XLike m => (WindowSet -> m a) -> m a
withWindowSet' = ((WindowSet -> m a) -> m WindowSet -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (XState -> WindowSet) -> m WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset)

-- | If there is a current tag and a focused window, perform an operation with
--   them, otherwise return mempty.
withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a
withFocii :: forall (m :: * -> *) a.
(XLike m, Monoid a) =>
(WorkspaceId -> Window -> m a) -> m a
withFocii WorkspaceId -> Window -> m a
f = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> m (m a) -> m a
forall a b. (a -> b) -> a -> b
$ (Maybe Window -> (Window -> m a) -> m a
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
Maybe a -> (a -> m b) -> m b
whenJust' (Maybe Window -> (Window -> m a) -> m a)
-> m (Maybe Window) -> m ((Window -> m a) -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe Window)
forall (m :: * -> *). XLike m => m (Maybe Window)
peek) m ((Window -> m a) -> m a) -> m (Window -> m a) -> m (m a)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (WorkspaceId -> Window -> m a
f (WorkspaceId -> Window -> m a)
-> m WorkspaceId -> m (Window -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WorkspaceId
forall (m :: * -> *). XLike m => m WorkspaceId
curTag)

-- | A generalisation of 'modifyWindowSet'.
modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' :: forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' WindowSet -> WindowSet
f = (XState -> XState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> m ()) -> (XState -> XState) -> m ()
forall a b. (a -> b) -> a -> b
$ \XState
xs -> XState
xs { windowset = f (windowset xs) }

-- | A variant of @W.modify@ and @W.modify'@ handling the @Nothing@ and @Just@
--   cases uniformly.
modify''
  :: (Maybe (W.Stack a) -> Maybe (W.Stack a))
  -> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
modify'' :: 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 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)

-- | Get the stack from the current workspace.
getStack :: XLike m => m (Maybe (W.Stack Window))
getStack :: forall (m :: * -> *). XLike m => m (Maybe (Stack Window))
getStack = 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
 -> Maybe (Stack Window))
-> m (Workspace WorkspaceId (Layout Window) Window)
-> m (Maybe (Stack Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Workspace WorkspaceId (Layout Window) Window)
forall (m :: * -> *).
XLike m =>
m (Workspace WorkspaceId (Layout Window) Window)
curWorkspace

-- | Set the stack on the current workspace.
putStack :: XLike m => Maybe (W.Stack Window) -> m ()
putStack :: forall (m :: * -> *). XLike m => Maybe (Stack Window) -> m ()
putStack Maybe (Stack Window)
mst = (WindowSet -> WindowSet) -> m ()
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' ((WindowSet -> WindowSet) -> m ())
-> ((Maybe (Stack Window) -> Maybe (Stack Window))
    -> WindowSet -> WindowSet)
-> (Maybe (Stack Window) -> Maybe (Stack Window))
-> m ()
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)) -> m ())
-> (Maybe (Stack Window) -> Maybe (Stack Window)) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (Stack Window)
-> Maybe (Stack Window) -> Maybe (Stack Window)
forall a b. a -> b -> a
const Maybe (Stack Window)
mst

-- | Get the focused window if there is one.
peek :: XLike m => m (Maybe Window)
peek :: forall (m :: * -> *). XLike m => m (Maybe Window)
peek = (WindowSet -> m (Maybe Window)) -> m (Maybe Window)
forall (m :: * -> *) a. XLike m => (WindowSet -> m a) -> m a
withWindowSet' (Maybe Window -> m (Maybe Window)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Window -> m (Maybe Window))
-> (WindowSet -> Maybe Window) -> WindowSet -> m (Maybe Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek)

-- | Get the current screen.
curScreen :: XLike m => m WindowScreen
curScreen :: forall (m :: * -> *). XLike m => m WindowScreen
curScreen = (WindowSet -> m WindowScreen) -> m WindowScreen
forall (m :: * -> *) a. XLike m => (WindowSet -> m a) -> m a
withWindowSet' (WindowScreen -> m WindowScreen
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (WindowScreen -> m WindowScreen)
-> (WindowSet -> WindowScreen) -> WindowSet -> m WindowScreen
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> WindowScreen
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current)

-- | Get the current workspace.
curWorkspace :: XLike m => m WindowSpace
curWorkspace :: forall (m :: * -> *).
XLike m =>
m (Workspace WorkspaceId (Layout Window) Window)
curWorkspace = WindowScreen -> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (WindowScreen -> Workspace WorkspaceId (Layout Window) Window)
-> m WindowScreen
-> m (Workspace WorkspaceId (Layout Window) Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WindowScreen
forall (m :: * -> *). XLike m => m WindowScreen
curScreen

-- | Get the current tag.
curTag :: XLike m => m WorkspaceId
curTag :: forall (m :: * -> *). XLike m => m WorkspaceId
curTag = Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> m (Workspace WorkspaceId (Layout Window) Window)
-> m WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Workspace WorkspaceId (Layout Window) Window)
forall (m :: * -> *).
XLike m =>
m (Workspace WorkspaceId (Layout Window) Window)
curWorkspace

-- | Get the current @ScreenId@.
curScreenId :: XLike m => m ScreenId
curScreenId :: forall (m :: * -> *). XLike m => m ScreenId
curScreenId = WindowScreen -> ScreenId
forall i l a sid sd. Screen i l a sid sd -> sid
W.screen (WindowScreen -> ScreenId) -> m WindowScreen -> m ScreenId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WindowScreen
forall (m :: * -> *). XLike m => m WindowScreen
curScreen

-- | Internal. Refresh-tracking logic of view operations.
viewWith
  :: XLike m => (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith :: forall (m :: * -> *).
XLike m =>
(WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith WorkspaceId -> WindowSet -> WindowSet
viewer WorkspaceId
tag = do
  WorkspaceId
itag <- m WorkspaceId
forall (m :: * -> *). XLike m => m WorkspaceId
curTag
  Bool -> m Any -> m Any
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (WorkspaceId
tag WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
/= WorkspaceId
itag) (m Any -> m Any) -> m Any -> m Any
forall a b. (a -> b) -> a -> b
$ do
    (WindowSet -> WindowSet) -> m ()
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' (WorkspaceId -> WindowSet -> WindowSet
viewer WorkspaceId
tag)
    Bool -> Any
Any (Bool -> Any) -> (WorkspaceId -> Bool) -> WorkspaceId -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceId
tag WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
==) (WorkspaceId -> Any) -> m WorkspaceId -> m Any
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m WorkspaceId
forall (m :: * -> *). XLike m => m WorkspaceId
curTag

-- | A version of @W.view@ that tracks the need to refresh.
view :: XLike m => WorkspaceId -> m Any
view :: forall (m :: * -> *). XLike m => WorkspaceId -> m Any
view = (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
forall (m :: * -> *).
XLike m =>
(WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith 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
W.view

-- | A version of @W.greedyView@ that tracks the need to refresh.
greedyView :: XLike m => WorkspaceId -> m Any
greedyView :: forall (m :: * -> *). XLike m => WorkspaceId -> m Any
greedyView = (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
forall (m :: * -> *).
XLike m =>
(WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith 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
W.greedyView

-- | View a workspace if it's not visible. An alternative to @view@ and
--   @greedyView@ that—rather than changing the current screen or affecting
--   another—opts not to act.
invisiView :: XLike m => WorkspaceId -> m Any
invisiView :: forall (m :: * -> *). XLike m => WorkspaceId -> m Any
invisiView = (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
forall (m :: * -> *).
XLike m =>
(WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith ((WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any)
-> (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
tag WindowSet
ws ->
  if   WorkspaceId
tag WorkspaceId -> [WorkspaceId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId
forall i l a. Workspace i l a -> i
W.tag (Workspace WorkspaceId (Layout Window) Window -> WorkspaceId)
-> (WindowScreen -> Workspace WorkspaceId (Layout Window) Window)
-> WindowScreen
-> WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowScreen -> Workspace WorkspaceId (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (WindowScreen -> WorkspaceId) -> [WindowScreen] -> [WorkspaceId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowSet -> WindowScreen
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws WindowScreen -> [WindowScreen] -> [WindowScreen]
forall a. a -> [a] -> [a]
: WindowSet -> [WindowScreen]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
W.visible WindowSet
ws)
  then 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
W.view WorkspaceId
tag WindowSet
ws
  else WindowSet
ws

-- | A refresh-tracking version of @W.Shift@.
shift :: XLike m => WorkspaceId -> m Any
shift :: forall (m :: * -> *). XLike m => WorkspaceId -> m Any
shift WorkspaceId
tag = (WorkspaceId -> Window -> m Any) -> m Any
forall (m :: * -> *) a.
(XLike m, Monoid a) =>
(WorkspaceId -> Window -> m a) -> m a
withFocii ((WorkspaceId -> Window -> m Any) -> m Any)
-> (WorkspaceId -> Window -> m Any) -> m Any
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
ctag Window
fw ->
  Bool -> m Any -> m Any
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (WorkspaceId
tag WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
/= WorkspaceId
ctag) (m Any -> m Any) -> m Any -> m Any
forall a b. (a -> b) -> a -> b
$ do
    (WindowSet -> WindowSet) -> m ()
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' (WorkspaceId -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
tag Window
fw)
    Maybe Window
mfw' <- m (Maybe Window)
forall (m :: * -> *). XLike m => m (Maybe Window)
peek
    Any -> m Any
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ Window -> Maybe Window
forall a. a -> Maybe a
Just Window
fw Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Window
mfw')

-- | A refresh tracking version of @W.shiftWin@.
shiftWin :: XLike m => WorkspaceId -> Window -> m Any
shiftWin :: forall (m :: * -> *). XLike m => WorkspaceId -> Window -> m Any
shiftWin WorkspaceId
tag Window
w = do
  Maybe WorkspaceId
mtag <- (XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId))
-> (XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId)
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w (WindowSet -> Maybe WorkspaceId)
-> (XState -> WindowSet) -> XState -> Maybe WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
  Maybe WorkspaceId -> (WorkspaceId -> m Any) -> m Any
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
Maybe a -> (a -> m b) -> m b
whenJust' Maybe WorkspaceId
mtag ((WorkspaceId -> m Any) -> m Any)
-> (WorkspaceId -> m Any) -> m Any
forall a b. (a -> b) -> a -> b
$ \WorkspaceId
wtag ->
    Bool -> m Any -> m Any
forall (m :: * -> *) a. (Monad m, Monoid a) => Bool -> m a -> m a
when' (WorkspaceId
tag WorkspaceId -> WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
/= WorkspaceId
wtag) (m Any -> m Any) -> m Any -> m Any
forall a b. (a -> b) -> a -> b
$ do
      (WindowSet -> WindowSet) -> m ()
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' ((WindowSet -> WindowSet) -> m ())
-> (WindowSet -> WindowSet) -> m ()
forall a b. (a -> b) -> a -> b
$ WorkspaceId -> Window -> WindowSet -> WindowSet
forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> a -> StackSet i l a s sd -> StackSet i l a s sd
W.shiftWin WorkspaceId
tag Window
w
      Maybe WorkspaceId
ntag <- (XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId))
-> (XState -> Maybe WorkspaceId) -> m (Maybe WorkspaceId)
forall a b. (a -> b) -> a -> b
$ Window -> WindowSet -> Maybe WorkspaceId
forall a i l s sd. Eq a => a -> StackSet i l a s sd -> Maybe i
W.findTag Window
w (WindowSet -> Maybe WorkspaceId)
-> (XState -> WindowSet) -> XState -> Maybe WorkspaceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
      Any -> m Any
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceId
mtag Maybe WorkspaceId -> Maybe WorkspaceId -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe WorkspaceId
ntag)

-- | Internal. Refresh-tracking logic of focus operations.
focusWith :: XLike m => (WindowSet -> WindowSet) -> m Any
focusWith :: forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m Any
focusWith WindowSet -> WindowSet
focuser = do
    Maybe Window
old <- m (Maybe Window)
forall (m :: * -> *). XLike m => m (Maybe Window)
peek
    (WindowSet -> WindowSet) -> m ()
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' WindowSet -> WindowSet
focuser
    Maybe Window
new <- m (Maybe Window)
forall (m :: * -> *). XLike m => m (Maybe Window)
peek
    Any -> m Any
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Any
Any (Bool -> Any) -> Bool -> Any
forall a b. (a -> b) -> a -> b
$ Maybe Window
old Maybe Window -> Maybe Window -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Window
new)

-- | A refresh-tracking version of @W.focusWindow@.
focusWindow :: XLike m => Window -> m Any
focusWindow :: forall (m :: * -> *). XLike m => Window -> m Any
focusWindow Window
w = (WindowSet -> WindowSet) -> m Any
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m Any
focusWith (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
W.focusWindow Window
w)

-- | A refresh-tracking version of @XMonad.Actions.FocusNth.focusNth@.
focusNth :: XLike m => Int -> m Any
focusNth :: forall (m :: * -> *). XLike m => Int -> m Any
focusNth Int
i = (WindowSet -> WindowSet) -> m Any
forall (m :: * -> *). XLike m => (WindowSet -> WindowSet) -> m Any
focusWith ((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' (Int -> Stack Window -> Stack Window
forall a. Int -> Stack a -> Stack a
XMonad.Actions.FocusNth.focusNth' Int
i))

-- }}}