{-# LANGUAGE ViewPatterns #-}
module XMonad.Actions.RotateSome (
surfaceNext,
surfacePrev,
rotateSome,
) where
import Control.Arrow ((***))
import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\))
import qualified Data.Map as M
import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
import XMonad.Util.Stack (reverseS)
surfaceNext :: X ()
surfaceNext :: X ()
surfaceNext = do
[Window]
ring <- X [Window]
surfaceRing
(WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Stack a -> Stack a
rotateSome (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ring)
surfacePrev :: X ()
surfacePrev :: X ()
surfacePrev = do
[Window]
ring <- X [Window]
surfaceRing
(WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
modify' forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> Stack a
reverseS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Stack a -> Stack a
rotateSome (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Window]
ring) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stack a -> Stack a
reverseS
surfaceRing :: X [Window]
surfaceRing :: X [Window]
surfaceRing = forall a. (WindowSet -> X a) -> X a
withWindowSet forall a b. (a -> b) -> a -> b
$ \WindowSet
wset -> do
let Screen Workspace WorkspaceId (Layout Window) Window
wsp ScreenId
_ ScreenDetail
sd = forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
wset
case forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace WorkspaceId (Layout Window) Window
wsp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
filter' (forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
floating WindowSet
wset) of
Maybe (Stack Window)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Stack Window
st -> Stack Window -> [Window] -> [Window]
go Stack Window
st forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace WorkspaceId (Layout Window) Window
-> Rectangle -> X [Window]
layoutWindows Workspace WorkspaceId (Layout Window) Window
wsp {stack :: Maybe (Stack Window)
stack = forall a. a -> Maybe a
Just Stack Window
st} (ScreenDetail -> Rectangle
screenRect ScreenDetail
sd)
where
go :: Stack Window -> [Window] -> [Window]
go :: Stack Window -> [Window] -> [Window]
go (Stack Window
t [Window]
ls [Window]
rs) [Window]
shown = Window
t forall a. a -> [a] -> [a]
: (([Window]
ls forall a. [a] -> [a] -> [a]
++ [Window]
rs) forall a. Eq a => [a] -> [a] -> [a]
\\ [Window]
shown)
layoutWindows :: WindowSpace -> Rectangle -> X [Window]
layoutWindows :: Workspace WorkspaceId (Layout Window) Window
-> Rectangle -> X [Window]
layoutWindows Workspace WorkspaceId (Layout Window) Window
wsp Rectangle
rect = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace WorkspaceId (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout Workspace WorkspaceId (Layout Window) Window
wsp Rectangle
rect
filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
filter' :: forall a. (a -> Bool) -> Stack a -> Maybe (Stack a)
filter' a -> Bool
p (Stack a
f [a]
ls [a]
rs)
| a -> Bool
p a
f = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a] -> Stack a
Stack a
f (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
ls) (forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
p [a]
rs)
| Bool
otherwise = forall a. Maybe a
Nothing
rotateSome :: (a -> Bool) -> Stack a -> Stack a
rotateSome :: forall a. (a -> Bool) -> Stack a -> Stack a
rotateSome a -> Bool
p (Stack a
t [a]
ls [a]
rs) =
let
([(Int, a)]
movables, [(Int, a)]
anchors) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$
forall a b. [a] -> [b] -> [(a, b)]
zip
[forall a. Num a => a -> a
negate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ls)..]
(forall a. [a] -> [a]
reverse [a]
ls forall a. [a] -> [a] -> [a]
++ a
t forall a. a -> [a] -> [a]
: [a]
rs)
([a]
ls', forall a. HasCallStack => [a] -> NonEmpty a
notEmpty -> a
t' :| [a]
rs') =
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
< Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a] -> [a]
(++) [(Int, a)]
anchors
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall a b. (a, b) -> a
fst forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall a b. (a, b) -> b
snd)) [(Int, a)]
movables (forall a. [a] -> [a]
rotate [(Int, a)]
movables)
in
forall a. a -> [a] -> [a] -> Stack a
Stack a
t' (forall a. [a] -> [a]
reverse [a]
ls') [a]
rs'
rotate :: [a] -> [a]
rotate :: forall a. [a] -> [a]
rotate = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. [a] -> [a] -> [a]
(++)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> ([a], [a])
splitAt Int
1