{-# LANGUAGE LambdaCase #-}
----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.WorkspaceByPos
-- Description :  Move new window to non-focused screen based on its requested geometry.
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- Useful in a dual-head setup: Looks at the requested geometry of
-- new windows and moves them to the workspace of the non-focused
-- screen if necessary.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.WorkspaceByPos (
    -- * Usage
    -- $usage
    workspaceByPos
    ) where

import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W

import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Trans (lift)

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Hooks.WorkspaceByPos
-- >
-- > myManageHook = workspaceByPos <> manageHook def
-- >
-- > main = xmonad def { manageHook = myManageHook }

workspaceByPos :: ManageHook
workspaceByPos :: Query (Endo WindowSet)
workspaceByPos = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall m. Monoid m => m
idHook String -> Query (Endo WindowSet)
doShift forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. X a -> Query a
liftX forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X (Maybe String)
needsMoving) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall r (m :: * -> *). MonadReader r m => m r
ask

needsMoving :: Window -> X (Maybe WorkspaceId)
needsMoving :: Window -> X (Maybe String)
needsMoving Window
w = Window -> X (Maybe WindowAttributes)
safeGetWindowAttributes Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WindowAttributes
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just WindowAttributes
wa -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
        -- only relocate windows with non-zero position
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa forall a. Eq a => a -> a -> Bool
/= CInt
0 Bool -> Bool -> Bool
|| WindowAttributes -> CInt
wa_y WindowAttributes
wa forall a. Eq a => a -> a -> Bool
/= CInt
0
        WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
        Screen String (Layout Window) Window ScreenId ScreenDetail
sc <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current WindowSet
ws)
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Position
-> Position
-> X (Maybe
        (Screen String (Layout Window) Window ScreenId ScreenDetail))
pointScreen (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa) (forall a b. (Integral a, Num b) => a -> b
fi forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_y WindowAttributes
wa)
        Just String
wkspc <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ ScreenId -> X (Maybe String)
screenWorkspace (forall i l a sid sd. Screen i l a sid sd -> sid
W.screen Screen String (Layout Window) Window ScreenId ScreenDetail
sc)
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall i l a s sd. StackSet i l a s sd -> i
W.currentTag WindowSet
ws forall a. Eq a => a -> a -> Bool
/= String
wkspc
        forall (m :: * -> *) a. Monad m => a -> m a
return String
wkspc forall a. a -> a -> a
`asTypeOf` forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
""