-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.InsertPosition
-- Description :  Configure where new windows should be added and how focus should shift.
-- Copyright   :  (c) 2009 Adam Vogt
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  vogt.adam@gmail.com
-- Stability   :  unstable
-- Portability :  portable
--
-- Configure where new windows should be added and which window should be
-- focused.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.InsertPosition (
    -- * Usage
    -- $usage
    insertPosition
    ,Focus(..), Position(..)
    ) where

import XMonad(ManageHook, MonadReader(ask))
import XMonad.Prelude (Endo (Endo), find)
import qualified XMonad.StackSet as W

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.InsertPosition
-- > xmonad def { manageHook = insertPosition Master Newer <> myManageHook }
--
-- You should you put the manageHooks that use 'doShift' to take effect
-- /before/ 'insertPosition', so that the window order will be consistent.
-- Because ManageHooks compose from right to left (like function composition
-- '.'), this means that 'insertPosition' should be the leftmost ManageHook.

data Position = Master | End | Above | Below
data Focus = Newer | Older

-- | insertPosition. A manage hook for placing new windows. XMonad's default is
-- the same as using: @insertPosition Above Newer@.
insertPosition :: Position -> Focus -> ManageHook
insertPosition :: Position -> Focus -> ManageHook
insertPosition Position
pos Focus
foc = (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 -> StackSet
      WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Endo
     (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall a. (a -> a) -> Endo a
Endo ((StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
  -> StackSet
       WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
 -> Endo
      (StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> (Window
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail
    -> StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
-> Window
-> Endo
     (StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
-> StackSet
     WorkspaceId (Layout Window) Window ScreenId ScreenDetail
forall {l} {sd}.
Window
-> StackSet WorkspaceId l Window ScreenId sd
-> StackSet WorkspaceId l Window ScreenId sd
g (Window
 -> Endo
      (StackSet
         WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
-> 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

-- | Modify the StackSet when the workspace containing w is focused
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
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
    Maybe (Workspace i l a)
ws <- (Workspace i l a -> Bool)
-> [Workspace i l a] -> Maybe (Workspace i l a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
w ([a] -> Bool)
-> (Workspace i l a -> [a]) -> Workspace i l a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
W.integrate' (Maybe (Stack a) -> [a])
-> (Workspace i l a -> Maybe (Stack a)) -> Workspace i l a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack) ([Workspace i l a] -> Maybe (Workspace i l a))
-> (StackSet i l a s sd -> [Workspace i l a])
-> StackSet i l a s sd
-> Maybe (Workspace i l a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i l a s sd -> [Workspace i l a]
forall i l a s sd. StackSet i l a s sd -> [Workspace i l a]
W.workspaces
    (StackSet i l a s sd -> StackSet i l a s sd)
-> (Workspace i l a -> StackSet i l a s sd -> StackSet i l a s sd)
-> Maybe (Workspace i l 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 ((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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (i -> StackSet i l a s sd -> StackSet i l a s sd
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 i
i (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
f) ((StackSet i l a s sd -> StackSet i l a s sd)
 -> StackSet i l a s sd -> StackSet i l a s sd)
-> (Workspace i l a -> StackSet i l a s sd -> StackSet i l a s sd)
-> Workspace i l a
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> StackSet i l a s sd -> StackSet i l a s sd
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 (i -> StackSet i l a s sd -> StackSet i l a s sd)
-> (Workspace i l a -> i)
-> Workspace i l a
-> StackSet i l a s sd
-> StackSet i l a s sd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i l a -> i
forall i l a. Workspace i l a -> i
W.tag) Maybe (Workspace i l a)
ws

-- | 'insertDown' and 'focusLast' belong in XMonad.StackSet?
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 = let ws :: [a]
ws = Stack a -> [a]
forall a. Stack a -> [a]
W.integrate Stack a
st
    in a -> [a] -> [a] -> Stack a
forall a. a -> [a] -> [a] -> Stack a
W.Stack ([a] -> a
forall a. [a] -> a
last [a]
ws) ([a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
ws) []