{-# 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 (find, fromJust, guard, liftA2, toList, when, (<=<))

-- $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 :: [[String]] -> Cursors String
makeCursors [] = String -> Cursors String
forall a. HasCallStack => String -> a
error String
"Workspace Cursors cannot be empty"
makeCursors [[String]]
a = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> String) -> Cursors [String] -> Cursors String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Cursors [String] -> [[String]] -> Cursors [String])
-> Cursors [String] -> [[[String]]] -> Cursors [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Cursors [String] -> [[String]] -> Cursors [String]
forall a. Monoid a => Cursors a -> [a] -> Cursors a
addDim Cursors [String]
x [[[String]]]
xs
    where x :: Cursors [String]
x = [[String]] -> Cursors [String]
forall a. [a] -> Cursors a
end ([[String]] -> Cursors [String]) -> [[String]] -> Cursors [String]
forall a b. (a -> b) -> a -> b
$ (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall a. [a] -> a
head [[String]]
a
          xs :: [[[String]]]
xs = ([String] -> [[String]]) -> [[String]] -> [[[String]]]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
forall (m :: * -> *) a. Monad m => a -> m a
return) ([[String]] -> [[[String]]]) -> [[String]] -> [[[String]]]
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. [a] -> [a]
tail [[String]]
a
          -- 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 :: Cursors a -> [a] -> Cursors a
addDim Cursors a
prev [a]
prefixes = Stack (Cursors a) -> Cursors a
forall a. Stack (Cursors a) -> Cursors a
Cons (Stack (Cursors a) -> Cursors a)
-> ([Cursors a] -> Stack (Cursors a)) -> [Cursors a] -> Cursors a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack (Cursors a)) -> Stack (Cursors a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Stack (Cursors a)) -> Stack (Cursors a))
-> ([Cursors a] -> Maybe (Stack (Cursors a)))
-> [Cursors a]
-> Stack (Cursors a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cursors a] -> Maybe (Stack (Cursors a))
forall a. [a] -> Maybe (Stack a)
W.differentiate
            ([Cursors a] -> Cursors a) -> [Cursors a] -> Cursors a
forall a b. (a -> b) -> a -> b
$ (a -> Cursors a) -> [a] -> [Cursors a]
forall a b. (a -> b) -> [a] -> [b]
map (((a -> a) -> Cursors a -> Cursors a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cursors a
prev) ((a -> a) -> Cursors a) -> (a -> a -> a) -> a -> Cursors a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. Monoid a => a -> a -> a
mappend) [a]
prefixes

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

data Cursors a
    = Cons (W.Stack (Cursors a))
    | End a deriving (Cursors a -> Cursors a -> Bool
(Cursors a -> Cursors a -> Bool)
-> (Cursors a -> Cursors a -> Bool) -> Eq (Cursors a)
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
[Cursors a] -> ShowS
Cursors a -> String
(Int -> Cursors a -> ShowS)
-> (Cursors a -> String)
-> ([Cursors a] -> ShowS)
-> Show (Cursors a)
forall a. Show a => Int -> Cursors a -> ShowS
forall a. Show a => [Cursors a] -> ShowS
forall a. Show a => Cursors a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursors a] -> ShowS
$cshowList :: forall a. Show a => [Cursors a] -> ShowS
show :: Cursors a -> String
$cshow :: forall a. Show a => Cursors a -> String
showsPrec :: Int -> Cursors a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Cursors a -> ShowS
Show,ReadPrec [Cursors a]
ReadPrec (Cursors a)
Int -> ReadS (Cursors a)
ReadS [Cursors a]
(Int -> ReadS (Cursors a))
-> ReadS [Cursors a]
-> ReadPrec (Cursors a)
-> ReadPrec [Cursors a]
-> Read (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 :: (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)) = (a -> m) -> Cursors a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Cursors a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` [m] -> m
forall a. Monoid a => [a] -> a
mconcat ((Cursors a -> m) -> [Cursors a] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> m) -> Cursors a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f) ([Cursors a] -> [m]) -> [Cursors a] -> [m]
forall a b. (a -> b) -> a -> b
$ [Cursors a] -> [Cursors a]
forall a. [a] -> [a]
reverse [Cursors a]
y [Cursors a] -> [Cursors a] -> [Cursors a]
forall a. [a] -> [a] -> [a]
++ [Cursors a]
z)

instance Functor Cursors where
    fmap :: (a -> b) -> Cursors a -> Cursors b
fmap a -> b
f (End a
a) = b -> Cursors b
forall a. a -> Cursors a
End (b -> Cursors b) -> b -> Cursors b
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)) = Stack (Cursors b) -> Cursors b
forall a. Stack (Cursors a) -> Cursors a
Cons (Stack (Cursors b) -> Cursors b) -> Stack (Cursors b) -> Cursors b
forall a b. (a -> b) -> a -> b
$ Cursors b -> [Cursors b] -> [Cursors b] -> Stack (Cursors b)
forall a. a -> [a] -> [a] -> Stack a
W.Stack ((a -> b) -> Cursors a -> Cursors b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Cursors a
x) ((Cursors a -> Cursors b) -> [Cursors a] -> [Cursors b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Cursors a -> Cursors b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Cursors a]
y) ((Cursors a -> Cursors b) -> [Cursors a] -> [Cursors b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Cursors a -> Cursors b
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 :: (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus Cursors t -> Bool
p (Cons Stack (Cursors t)
x) = do
    Stack (Cursors t)
choose <- (Cursors t -> Bool) -> Stack (Cursors t) -> [Stack (Cursors t)]
forall a. (a -> Bool) -> Stack a -> [Stack a]
chFocus Cursors t -> Bool
p Stack (Cursors t)
x
    Cursors t
foc    <- (Cursors t -> Bool) -> Cursors t -> [Cursors t]
forall t. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus Cursors t -> Bool
p (Cursors t -> [Cursors t]) -> Cursors t -> [Cursors t]
forall a b. (a -> b) -> a -> b
$ Stack (Cursors t) -> Cursors t
forall a. Stack a -> a
W.focus Stack (Cursors t)
choose
    Cursors t -> [Cursors t]
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursors t -> [Cursors t])
-> (Stack (Cursors t) -> Cursors t)
-> Stack (Cursors t)
-> [Cursors t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Cursors t) -> Cursors t
forall a. Stack (Cursors a) -> Cursors a
Cons (Stack (Cursors t) -> [Cursors t])
-> Stack (Cursors t) -> [Cursors t]
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 = Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Cursors t -> Bool
p Cursors t
x) [()] -> [Cursors t] -> [Cursors t]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Cursors t -> [Cursors t]
forall (m :: * -> *) a. Monad m => a -> m a
return Cursors t
x

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

getFocus ::  Cursors b -> b
getFocus :: Cursors b -> b
getFocus (Cons Stack (Cursors b)
x) = Cursors b -> b
forall b. Cursors b -> b
getFocus (Cursors b -> b) -> Cursors b -> b
forall a b. (a -> b) -> a -> b
$ Stack (Cursors b) -> Cursors 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 :: t -> Cursors t -> Maybe (Cursors t)
focusTo t
x = (Cursors t -> Bool) -> [Cursors t] -> Maybe (Cursors t)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((t
xt -> t -> Bool
forall a. Eq a => a -> a -> Bool
==) (t -> Bool) -> (Cursors t -> t) -> Cursors t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursors t -> t
forall b. Cursors b -> b
getFocus) ([Cursors t] -> Maybe (Cursors t))
-> (Cursors t -> [Cursors t]) -> Cursors t -> Maybe (Cursors t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
forall t. (Cursors t -> Bool) -> Cursors t -> [Cursors t]
changeFocus (Bool -> Cursors t -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | non-wrapping version of 'W.focusUp''
noWrapUp ::  W.Stack t -> W.Stack t
noWrapUp :: Stack t -> Stack t
noWrapUp (W.Stack t
t (t
l:[t]
ls) [t]
rs) = t -> [t] -> [t] -> Stack t
forall a. a -> [a] -> [a] -> Stack a
W.Stack t
l [t]
ls (t
tt -> [t] -> [t]
forall 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 :: Stack t -> Stack t
noWrapDown = Stack t -> Stack t
forall a. Stack a -> Stack a
reverseS (Stack t -> Stack t) -> (Stack t -> Stack t) -> Stack t -> Stack t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack t -> Stack t
forall a. Stack a -> Stack a
noWrapUp (Stack t -> Stack t) -> (Stack t -> Stack t) -> Stack t -> Stack t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack t -> Stack t
forall a. Stack a -> Stack a
reverseS

focusDepth ::  Cursors t -> Int
focusDepth :: Cursors t -> Int
focusDepth (Cons Stack (Cursors t)
x) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Cursors t -> Int
forall a. Cursors a -> Int
focusDepth (Stack (Cursors t) -> Cursors t
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 :: (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) = Stack (Cursors a) -> Cursors a
forall a. Stack (Cursors a) -> Cursors a
Cons (Stack (Cursors a) -> Cursors a)
-> m (Stack (Cursors a)) -> m (Cursors a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (Stack (Cursors a) -> Cursors a)
-> m (Stack (Cursors a)) -> m (Cursors a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stack (Cursors a) -> Cursors a
forall a. Stack (Cursors a) -> Cursors a
Cons (m (Stack (Cursors a)) -> m (Cursors a))
-> m (Stack (Cursors a)) -> m (Cursors a)
forall a b. (a -> b) -> a -> b
$ (Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
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 -> Int
forall a. Enum a => a -> a
pred Int
n) (Cursors a -> m (Cursors a))
-> Stack (Cursors a) -> m (Stack (Cursors a))
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 = Cursors a -> m (Cursors a)
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 :: (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}) (a1 -> Stack a1) -> m a1 -> m (Stack a1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a1 -> m a1
f (Stack a1 -> a1
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 String) -> Stack (Cursors String)) -> Int -> X ()
modifyLayer Stack (Cursors String) -> Stack (Cursors String)
f Int
depth = (Cursors String -> X (Cursors String)) -> X ()
modifyCursors ((Stack (Cursors String) -> X (Stack (Cursors String)))
-> Int -> Cursors String -> X (Cursors String)
forall (m :: * -> *) a.
Monad m =>
(Stack (Cursors a) -> m (Stack (Cursors a)))
-> Int -> Cursors a -> m (Cursors a)
descend (Stack (Cursors String) -> X (Stack (Cursors String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Stack (Cursors String) -> X (Stack (Cursors String)))
-> (Stack (Cursors String) -> Stack (Cursors String))
-> Stack (Cursors String)
-> X (Stack (Cursors String))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack (Cursors String) -> Stack (Cursors String)
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 String) -> Stack (Cursors String)) -> Int -> X ()
shiftModifyLayer Stack (Cursors String) -> Stack (Cursors String)
f = (Stack (Cursors String) -> X (Stack (Cursors String)))
-> Int -> X ()
modifyLayer' ((Stack (Cursors String) -> X (Stack (Cursors String)))
 -> Int -> X ())
-> (Stack (Cursors String) -> X (Stack (Cursors String)))
-> Int
-> X ()
forall a b. (a -> b) -> a -> b
$ \Stack (Cursors String)
st -> do
    let st' :: Stack (Cursors String)
st' = Stack (Cursors String) -> Stack (Cursors String)
f Stack (Cursors String)
st
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ String -> WindowSet -> WindowSet
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 (String -> WindowSet -> WindowSet)
-> String -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Cursors String -> String
forall b. Cursors b -> b
getFocus (Stack (Cursors String) -> Cursors String
forall a. Stack (Cursors a) -> Cursors a
Cons Stack (Cursors String)
st')
    Stack (Cursors String) -> X (Stack (Cursors String))
forall (m :: * -> *) a. Monad m => a -> m a
return Stack (Cursors String)
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 String) -> Stack (Cursors String)) -> Int -> X ()
shiftLayer Stack (Cursors String) -> Stack (Cursors String)
f = (Stack (Cursors String) -> X (Stack (Cursors String)))
-> Int -> X ()
modifyLayer' ((Stack (Cursors String) -> X (Stack (Cursors String)))
 -> Int -> X ())
-> (Stack (Cursors String) -> X (Stack (Cursors String)))
-> Int
-> X ()
forall a b. (a -> b) -> a -> b
$ \Stack (Cursors String)
st -> do
    (WindowSet -> WindowSet) -> X ()
windows ((WindowSet -> WindowSet) -> X ())
-> (WindowSet -> WindowSet) -> X ()
forall a b. (a -> b) -> a -> b
$ String -> WindowSet -> WindowSet
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 (String -> WindowSet -> WindowSet)
-> String -> WindowSet -> WindowSet
forall a b. (a -> b) -> a -> b
$ Cursors String -> String
forall b. Cursors b -> b
getFocus (Cursors String -> String) -> Cursors String -> String
forall a b. (a -> b) -> a -> b
$ Stack (Cursors String) -> Cursors String
forall a. Stack (Cursors a) -> Cursors a
Cons (Stack (Cursors String) -> Cursors String)
-> Stack (Cursors String) -> Cursors String
forall a b. (a -> b) -> a -> b
$ Stack (Cursors String) -> Stack (Cursors String)
f Stack (Cursors String)
st
    Stack (Cursors String) -> X (Stack (Cursors String))
forall (m :: * -> *) a. Monad m => a -> m a
return Stack (Cursors String)
st

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

modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
modifyCursors = ChangeCursors -> X ()
forall a. Message a => a -> X ()
sendMessage (ChangeCursors -> X ())
-> ((Cursors String -> X (Cursors String)) -> ChangeCursors)
-> (Cursors String -> X (Cursors String))
-> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cursors String -> X (Cursors String)) -> ChangeCursors
ChangeCursors ((Cursors String -> X (Cursors String)) -> ChangeCursors)
-> ((Cursors String -> X (Cursors String))
    -> Cursors String -> X (Cursors String))
-> (Cursors String -> X (Cursors String))
-> ChangeCursors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((X () -> X (Cursors String) -> X (Cursors String))
-> (Cursors String -> X ())
-> (Cursors String -> X (Cursors String))
-> Cursors String
-> X (Cursors String)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 X () -> X (Cursors String) -> X (Cursors String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) Cursors String -> X ()
updateXMD Cursors String -> X (Cursors String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Cursors String -> X (Cursors String))
-> (Cursors String -> X (Cursors String))
-> Cursors String
-> X (Cursors String)
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)
Int -> ReadS (WorkspaceCursors a)
ReadS [WorkspaceCursors a]
(Int -> ReadS (WorkspaceCursors a))
-> ReadS [WorkspaceCursors a]
-> ReadPrec (WorkspaceCursors a)
-> ReadPrec [WorkspaceCursors a]
-> Read (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
[WorkspaceCursors a] -> ShowS
WorkspaceCursors a -> String
(Int -> WorkspaceCursors a -> ShowS)
-> (WorkspaceCursors a -> String)
-> ([WorkspaceCursors a] -> ShowS)
-> Show (WorkspaceCursors a)
forall a. Int -> WorkspaceCursors a -> ShowS
forall a. [WorkspaceCursors a] -> ShowS
forall a. WorkspaceCursors a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceCursors a] -> ShowS
$cshowList :: forall a. [WorkspaceCursors a] -> ShowS
show :: WorkspaceCursors a -> String
$cshow :: forall a. WorkspaceCursors a -> String
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 :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
workspaceCursors = WorkspaceCursors a -> l a -> ModifiedLayout WorkspaceCursors l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (WorkspaceCursors a -> l a -> ModifiedLayout WorkspaceCursors l a)
-> (Cursors String -> WorkspaceCursors a)
-> Cursors String
-> l a
-> ModifiedLayout WorkspaceCursors l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursors String -> WorkspaceCursors a
forall a. Cursors String -> WorkspaceCursors a
WorkspaceCursors

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

instance Message ChangeCursors

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

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

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