{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module       : XMonad.Actions.WorkspaceCursors
-- Description  : Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
-- Copyright    : (c) 2009 Adam Vogt <vogt.adam@gmail.com>
-- License      : BSD
--
-- Maintainer   : Adam Vogt
-- Stability    : unstable
-- Portability  : unportable
--
-- Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
-----------------------------------------------------------------------------

module XMonad.Actions.WorkspaceCursors
    (
    -- * Usage
    -- $usage

     focusDepth
    ,makeCursors
    ,toList
    ,workspaceCursors

    ,WorkspaceCursors
    ,getFocus

    -- * Modifying the focus
    ,modifyLayer
    ,modifyLayer'
    ,shiftModifyLayer,shiftLayer

    -- * Functions to pass to 'modifyLayer'
    ,focusNth'
    ,noWrapUp,noWrapDown,

    -- * Todo
    -- $todo

    -- * Types
    Cursors,
    ) where

import qualified XMonad.StackSet as W

import XMonad.Actions.FocusNth(focusNth')
import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                    LayoutModifier(handleMess, redoLayout))
import XMonad(Message, WorkspaceId, X, XState(windowset),
              fromMessage, sendMessage, windows, gets)
import XMonad.Util.Stack (reverseS)
import XMonad.Prelude

-- $usage
--
-- Here is an example config:
--
-- > import XMonad
-- > import XMonad.Actions.WorkspaceCursors
-- > import XMonad.Util.EZConfig
-- > import qualified XMonad.StackSet as W
-- >
-- > main = xmonad conf
-- >
-- > conf = additionalKeysP def
-- >        { layoutHook = workspaceCursors myCursors $ layoutHook def
-- >        , workspaces = toList myCursors } $
-- >        [("M-"++shift++control++[k], f direction depth)
-- >          | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]
-- >          , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""]
-- >          , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"]
-- >        ++ moreKeybindings
-- >
-- > moreKeybindings = []
-- >
-- > myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"]
-- > -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]]


-- $todo
--
-- * Find and document how to raise the allowable length of arguments:
--   restoring xmonad's state results in: @xmonad: executeFile: resource
--   exhausted (Argument list too long)@ when you specify more than about 50
--   workspaces. Or change it such that workspaces are created when you try to
--   view it.
--
-- * Function for pretty printing for "XMonad.Hooks.StatusBar.PP" that groups
--   workspaces by
-- common prefixes
--
-- * Examples of adding workspaces to the cursors, having them appear multiple
--   times for being able to show jumping to some n'th multiple workspace

-- | makeCursors requires a nonempty string, and each sublist must be nonempty
makeCursors ::  [[String]] -> Cursors String
makeCursors :: [[WorkspaceId]] -> Cursors WorkspaceId
makeCursors []       = forall a. HasCallStack => WorkspaceId -> a
error WorkspaceId
"Workspace Cursors cannot be empty"
makeCursors ([WorkspaceId]
a : [[WorkspaceId]]
as) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Monoid a => Cursors a -> [a] -> Cursors a
addDim Cursors [WorkspaceId]
x [[[WorkspaceId]]]
xs
    where x :: Cursors [WorkspaceId]
x = forall a. [a] -> Cursors a
end forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return [WorkspaceId]
a
          xs :: [[[WorkspaceId]]]
xs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) a. Monad m => a -> m a
return) [[WorkspaceId]]
as
          -- this could probably be simplified, but this true:
          -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
          -- the strange order is used because it makes the regular M-1..9
          -- bindings change the prefixes first

addDim ::  (Monoid a) => Cursors a -> [a] -> Cursors a
addDim :: forall a. Monoid a => Cursors a -> [a] -> Cursors a
addDim Cursors a
prev [a]
prefixes = forall a. Stack (Cursors a) -> Cursors a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (Stack a)
W.differentiate
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cursors a
prev) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend) [a]
prefixes

end :: [a] -> Cursors a
end :: forall a. [a] -> Cursors a
end = forall a. Stack (Cursors a) -> Cursors a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (Stack a)
W.differentiate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. a -> Cursors a
End

data Cursors a
    = Cons (W.Stack (Cursors a))
    | End a deriving (Cursors a -> Cursors a -> Bool
forall a. Eq a => Cursors a -> Cursors a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursors a -> Cursors a -> Bool
$c/= :: forall a. Eq a => Cursors a -> Cursors a -> Bool
== :: Cursors a -> Cursors a -> Bool
$c== :: forall a. Eq a => Cursors a -> Cursors a -> Bool
Eq,Int -> Cursors a -> ShowS
forall a. Show a => Int -> Cursors a -> ShowS
forall a. Show a => [Cursors a] -> ShowS
forall a. Show a => Cursors a -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [Cursors a] -> ShowS
$cshowList :: forall a. Show a => [Cursors a] -> ShowS
show :: Cursors a -> WorkspaceId
$cshow :: forall a. Show a => Cursors a -> WorkspaceId
showsPrec :: Int -> Cursors a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cursors a -> ShowS
Show,ReadPrec [Cursors a]
ReadPrec (Cursors a)
ReadS [Cursors a]
forall a. Read a => ReadPrec [Cursors a]
forall a. Read a => ReadPrec (Cursors a)
forall a. Read a => Int -> ReadS (Cursors a)
forall a. Read a => ReadS [Cursors a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cursors a]
$creadListPrec :: forall a. Read a => ReadPrec [Cursors a]
readPrec :: ReadPrec (Cursors a)
$creadPrec :: forall a. Read a => ReadPrec (Cursors a)
readList :: ReadS [Cursors a]
$creadList :: forall a. Read a => ReadS [Cursors a]
readsPrec :: Int -> ReadS (Cursors a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Cursors a)
Read)

instance Foldable Cursors where
    foldMap :: forall m a. Monoid m => (a -> m) -> Cursors a -> m
foldMap a -> m
f (End a
x) = a -> m
f a
x
    foldMap a -> m
f (Cons (W.Stack Cursors a
x [Cursors a]
y [Cursors a]
z)) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Cursors a
x forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Cursors a]
y forall a. [a] -> [a] -> [a]
++ [Cursors a]
z)

instance Functor Cursors where
    fmap :: forall a b. (a -> b) -> Cursors a -> Cursors b
fmap a -> b
f (End a
a) = forall a. a -> Cursors a
End forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
    fmap a -> b
f (Cons (W.Stack Cursors a
x [Cursors a]
y [Cursors a]
z)) = forall a. Stack (Cursors a) -> Cursors a
Cons forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
W.Stack (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Cursors a
x) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Cursors a]
y) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Cursors a]
z)

changeFocus ::  (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus :: forall t. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus Cursors t -> Bool
p (Cons Stack (Cursors t)
x) = do
    Stack (Cursors t)
choose <- forall a. (a -> Bool) -> Stack a -> [Stack a]
chFocus Cursors t -> Bool
p Stack (Cursors t)
x
    Cursors t
foc    <- forall t. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus Cursors t -> Bool
p forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack (Cursors t)
choose
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack (Cursors a) -> Cursors a
Cons forall a b. (a -> b) -> a -> b
$ Stack (Cursors t)
choose { focus :: Cursors t
W.focus = Cursors t
foc }
changeFocus Cursors t -> Bool
p Cursors t
x = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Cursors t -> Bool
p Cursors t
x) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Cursors t
x

chFocus :: (a -> Bool) -> W.Stack a -> [W.Stack a]
chFocus :: forall a. (a -> Bool) -> Stack a -> [Stack a]
chFocus a -> Bool
p Stack a
st = forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> a
W.focus) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const (forall a. (a -> a) -> a -> [a]
iterate forall a. Stack a -> Stack a
W.focusDown' Stack a
st) (forall a. Stack a -> [a]
W.integrate Stack a
st)

getFocus ::  Cursors b -> b
getFocus :: forall b. Cursors b -> b
getFocus (Cons Stack (Cursors b)
x) = forall b. Cursors b -> b
getFocus forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack (Cursors b)
x
getFocus (End b
x) = b
x

-- This could be made more efficient, if the fact that the suffixes are grouped
focusTo ::  (Eq t) => t -> Cursors t -> Maybe (Cursors t)
focusTo :: forall t. Eq t => t -> Cursors t -> Maybe (Cursors t)
focusTo t
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((t
xforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Cursors b -> b
getFocus) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus (forall a b. a -> b -> a
const Bool
True)

-- | non-wrapping version of 'W.focusUp''
noWrapUp ::  W.Stack t -> W.Stack t
noWrapUp :: forall a. Stack a -> Stack a
noWrapUp (W.Stack t
t (t
l:[t]
ls) [t]
rs) = forall a. a -> [a] -> [a] -> Stack a
W.Stack t
l [t]
ls (t
tforall a. a -> [a] -> [a]
:[t]
rs)
noWrapUp x :: Stack t
x@(W.Stack t
_ []   [t]
_ ) = Stack t
x

-- | non-wrapping version of 'W.focusDown''
noWrapDown ::  W.Stack t -> W.Stack t
noWrapDown :: forall a. Stack a -> Stack a
noWrapDown = forall a. Stack a -> Stack a
reverseS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> Stack a
noWrapUp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> Stack a
reverseS

focusDepth ::  Cursors t -> Int
focusDepth :: forall a. Cursors a -> Int
focusDepth (Cons Stack (Cursors t)
x) = Int
1 forall a. Num a => a -> a -> a
+ forall a. Cursors a -> Int
focusDepth (forall a. Stack a -> a
W.focus Stack (Cursors t)
x)
focusDepth (End  t
_) = Int
0

descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
descend :: forall (m :: * -> *) a.
Monad m =>
(Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
descend Stack (Cursors a) -> m (Stack (Cursors a))
f Int
1 (Cons Stack (Cursors a)
x) = forall a. Stack (Cursors a) -> Cursors a
Cons forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stack (Cursors a) -> m (Stack (Cursors a))
f Stack (Cursors a)
x
descend Stack (Cursors a) -> m (Stack (Cursors a))
f Int
n (Cons Stack (Cursors a)
x) | Int
n forall a. Ord a => a -> a -> Bool
> Int
1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Stack (Cursors a) -> Cursors a
Cons forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
(Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
descend Stack (Cursors a) -> m (Stack (Cursors a))
f (forall a. Enum a => a -> a
pred Int
n) forall (m :: * -> *) a1.
Monad m =>
(a1 -> m a1) -> Stack a1 -> m (Stack a1)
`onFocus` Stack (Cursors a)
x
descend Stack (Cursors a) -> m (Stack (Cursors a))
_ Int
_ Cursors a
x = forall (m :: * -> *) a. Monad m => a -> m a
return Cursors a
x

onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
onFocus :: forall (m :: * -> *) a1.
Monad m =>
(a1 -> m a1) -> Stack a1 -> m (Stack a1)
onFocus a1 -> m a1
f Stack a1
st = (\a1
x -> Stack a1
st { focus :: a1
W.focus = a1
x}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a1 -> m a1
f (forall a. Stack a -> a
W.focus Stack a1
st)

-- | @modifyLayer@ is used to change the focus at a given depth
modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
modifyLayer :: (Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId))
-> Int -> X ()
modifyLayer Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f Int
depth = (Cursors WorkspaceId -> X (Cursors WorkspaceId)) -> X ()
modifyCursors (forall (m :: * -> *) a.
Monad m =>
(Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
descend (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f) Int
depth)

-- | @shiftModifyLayer@ is the same as 'modifyLayer', but also shifts the
-- currently focused window to the new workspace
shiftModifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X ()
shiftModifyLayer :: (Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId))
-> Int -> X ()
shiftModifyLayer Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f = (Stack (Cursors WorkspaceId) -> X (Stack (Cursors WorkspaceId)))
-> Int -> X ()
modifyLayer' forall a b. (a -> b) -> a -> b
$ \Stack (Cursors WorkspaceId)
st -> do
    let st' :: Stack (Cursors WorkspaceId)
st' = Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f Stack (Cursors WorkspaceId)
st
    (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift forall a b. (a -> b) -> a -> b
$ forall b. Cursors b -> b
getFocus (forall a. Stack (Cursors a) -> Cursors a
Cons Stack (Cursors WorkspaceId)
st')
    forall (m :: * -> *) a. Monad m => a -> m a
return Stack (Cursors WorkspaceId)
st'

-- | @shiftLayer@ is the same as 'shiftModifyLayer', but the focus remains on
-- the current workspace.
shiftLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X ()
shiftLayer :: (Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId))
-> Int -> X ()
shiftLayer Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f = (Stack (Cursors WorkspaceId) -> X (Stack (Cursors WorkspaceId)))
-> Int -> X ()
modifyLayer' forall a b. (a -> b) -> a -> b
$ \Stack (Cursors WorkspaceId)
st -> do
    (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift forall a b. (a -> b) -> a -> b
$ forall b. Cursors b -> b
getFocus forall a b. (a -> b) -> a -> b
$ forall a. Stack (Cursors a) -> Cursors a
Cons forall a b. (a -> b) -> a -> b
$ Stack (Cursors WorkspaceId) -> Stack (Cursors WorkspaceId)
f Stack (Cursors WorkspaceId)
st
    forall (m :: * -> *) a. Monad m => a -> m a
return Stack (Cursors WorkspaceId)
st

-- | example usages are 'shiftLayer' and 'shiftModifyLayer'
modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> Int -> X ()
modifyLayer' :: (Stack (Cursors WorkspaceId) -> X (Stack (Cursors WorkspaceId)))
-> Int -> X ()
modifyLayer' Stack (Cursors WorkspaceId) -> X (Stack (Cursors WorkspaceId))
f Int
depth = (Cursors WorkspaceId -> X (Cursors WorkspaceId)) -> X ()
modifyCursors (forall (m :: * -> *) a.
Monad m =>
(Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
descend Stack (Cursors WorkspaceId) -> X (Stack (Cursors WorkspaceId))
f Int
depth)

modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()
modifyCursors :: (Cursors WorkspaceId -> X (Cursors WorkspaceId)) -> X ()
modifyCursors = forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursors WorkspaceId -> X (Cursors WorkspaceId)) -> ChangeCursors
ChangeCursors forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) Cursors WorkspaceId -> X ()
updateXMD forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<)

newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
    deriving (ReadPrec [WorkspaceCursors a]
ReadPrec (WorkspaceCursors a)
ReadS [WorkspaceCursors a]
forall a. ReadPrec [WorkspaceCursors a]
forall a. ReadPrec (WorkspaceCursors a)
forall a. Int -> ReadS (WorkspaceCursors a)
forall a. ReadS [WorkspaceCursors a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceCursors a]
$creadListPrec :: forall a. ReadPrec [WorkspaceCursors a]
readPrec :: ReadPrec (WorkspaceCursors a)
$creadPrec :: forall a. ReadPrec (WorkspaceCursors a)
readList :: ReadS [WorkspaceCursors a]
$creadList :: forall a. ReadS [WorkspaceCursors a]
readsPrec :: Int -> ReadS (WorkspaceCursors a)
$creadsPrec :: forall a. Int -> ReadS (WorkspaceCursors a)
Read,Int -> WorkspaceCursors a -> ShowS
forall a. Int -> WorkspaceCursors a -> ShowS
forall a. [WorkspaceCursors a] -> ShowS
forall a. WorkspaceCursors a -> WorkspaceId
forall a.
(Int -> a -> ShowS)
-> (a -> WorkspaceId) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceCursors a] -> ShowS
$cshowList :: forall a. [WorkspaceCursors a] -> ShowS
show :: WorkspaceCursors a -> WorkspaceId
$cshow :: forall a. WorkspaceCursors a -> WorkspaceId
showsPrec :: Int -> WorkspaceCursors a -> ShowS
$cshowsPrec :: forall a. Int -> WorkspaceCursors a -> ShowS
Show)

-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
-- your outermost modifier, unless you want different cursors at different
-- times (using "XMonad.Layout.MultiToggle")
workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
workspaceCursors :: forall (l :: * -> *) a.
Cursors WorkspaceId -> l a -> ModifiedLayout WorkspaceCursors l a
workspaceCursors = forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Cursors WorkspaceId -> WorkspaceCursors a
WorkspaceCursors

newtype ChangeCursors = ChangeCursors { ChangeCursors -> Cursors WorkspaceId -> X (Cursors WorkspaceId)
unWrap :: Cursors String -> X (Cursors String) }

instance Message ChangeCursors

updateXMD ::  Cursors WorkspaceId -> X ()
updateXMD :: Cursors WorkspaceId -> X ()
updateXMD Cursors WorkspaceId
cs = do
    Bool
changed <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ (forall b. Cursors b -> b
getFocus Cursors WorkspaceId
cs forall a. Eq a => a -> a -> Bool
/=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
changed forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall b. Cursors b -> b
getFocus Cursors WorkspaceId
cs

instance LayoutModifier WorkspaceCursors a where
    redoLayout :: WorkspaceCursors a
-> Rectangle
-> Maybe (Stack a)
-> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (WorkspaceCursors a))
redoLayout (WorkspaceCursors Cursors WorkspaceId
cs) Rectangle
_ Maybe (Stack a)
_ [(a, Rectangle)]
arrs = do
        WorkspaceId
cws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> i
W.currentTag forall b c a. (b -> c) -> (a -> b) -> a -> c
. XState -> WindowSet
windowset
        forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
arrs,forall a. Cursors WorkspaceId -> WorkspaceCursors a
WorkspaceCursors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Eq t => t -> Cursors t -> Maybe (Cursors t)
focusTo WorkspaceId
cws Cursors WorkspaceId
cs)

    handleMess :: WorkspaceCursors a -> SomeMessage -> X (Maybe (WorkspaceCursors a))
handleMess (WorkspaceCursors Cursors WorkspaceId
cs) SomeMessage
m =
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Cursors WorkspaceId -> WorkspaceCursors a
WorkspaceCursors forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ Cursors WorkspaceId
cs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChangeCursors -> Cursors WorkspaceId -> X (Cursors WorkspaceId)
unWrap) (forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m)