module XMonad.Hooks.InsertPosition (
setupInsertPosition, insertPosition
,Focus(..), Position(..)
) where
import XMonad (ManageHook, MonadReader (ask), XConfig (manageHook))
import XMonad.Prelude (Endo (Endo), find)
import qualified XMonad.StackSet as W
data Position = Master | End | Above | Below
data Focus = Newer | Older
setupInsertPosition :: Position -> Focus -> XConfig a -> XConfig a
setupInsertPosition :: forall (a :: * -> *). Position -> Focus -> XConfig a -> XConfig a
setupInsertPosition Position
pos Focus
foc XConfig a
cfg =
XConfig a
cfg{ manageHook = insertPosition pos foc <> manageHook cfg }
insertPosition :: Position -> Focus -> ManageHook
insertPosition :: Position -> Focus -> ManageHook
insertPosition Position
pos Focus
foc = (WindowSet -> WindowSet) -> Endo WindowSet
forall a. (a -> a) -> Endo a
Endo ((WindowSet -> WindowSet) -> Endo WindowSet)
-> (Window -> WindowSet -> WindowSet) -> Window -> Endo WindowSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> WindowSet -> WindowSet
forall {l} {sd}.
Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
g (Window -> Endo WindowSet) -> Query Window -> ManageHook
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
where
g :: Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
g Window
w = Window
-> (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall a s i l sd.
(Eq a, Eq s, Eq i, Show i) =>
a
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
viewingWs Window
w (Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall {l} {sd}.
Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
updateFocus Window
w (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
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
ins Window
w (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.delete' Window
w)
ins :: a -> StackSet i l a s sd -> StackSet i l a s sd
ins a
w = (\StackSet i l a s sd -> StackSet i l a s sd
f StackSet i l a s sd
ws -> (StackSet i l a s sd -> StackSet i l a s sd)
-> (a -> StackSet i l a s sd -> StackSet i l a s sd)
-> Maybe a
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StackSet i l a s sd -> StackSet i l a s sd
forall a. a -> a
id a -> StackSet i l a s sd -> StackSet i l a s sd
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 (StackSet i l a s sd -> Maybe a
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek StackSet i l a s sd
ws) (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$ StackSet i l a s sd -> StackSet i l a s sd
f StackSet i l a s sd
ws) ((StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall a b. (a -> b) -> a -> b
$
case Position
pos of
Position
Master -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp a
w (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.focusMaster
Position
End -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
insertDown a
w (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
(Stack a -> Stack a) -> StackSet i l a s sd -> StackSet i l a s sd
W.modify' Stack a -> Stack a
forall a. Stack a -> Stack a
focusLast'
Position
Above -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp a
w
Position
Below -> a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
insertDown a
w
updateFocus :: Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
updateFocus =
case Focus
foc of
Focus
Older -> (StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd)
-> Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall a b. a -> b -> a
const StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
forall a. a -> a
id
Focus
Newer -> Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
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
viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd
viewingWs :: forall a s i l sd.
(Eq a, Eq s, Eq i, Show i) =>
a
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
viewingWs a
w StackSet i l a s sd -> StackSet i l a s sd
f = do
i <- Workspace i l a -> i
forall i l a. Workspace i l a -> i
W.tag (Workspace i l a -> i)
-> (StackSet i l a s sd -> Workspace i l a)
-> StackSet i l a s sd
-> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i l a s sd -> Workspace i l a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen i l a s sd -> Workspace i l a)
-> (StackSet i l a s sd -> Screen i l a s sd)
-> StackSet i l a s sd
-> Workspace i l a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> Screen i l a s sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current
ws <- find (elem w . W.integrate' . W.stack) . W.workspaces
maybe id (fmap (W.view i . f) . W.view . W.tag) ws
insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd
insertDown :: forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
insertDown a
w = StackSet i l a s sd -> StackSet i l a s sd
forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapDown (StackSet i l a s sd -> StackSet i l a s sd)
-> (StackSet i l a s sd -> StackSet i l a s sd)
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StackSet i l a s sd -> StackSet i l a s sd
forall a i l s sd.
Eq a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.insertUp a
w
focusLast' :: W.Stack a -> W.Stack a
focusLast' :: forall a. Stack a -> Stack a
focusLast' Stack a
st =
case [a] -> [a]
forall a. [a] -> [a]
reverse (Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st) of
[] -> Stack a
st
(a
l : [a]
ws) -> a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack a
l [a]
ws []