{-# 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 = (Query (Endo WindowSet)
-> (String -> Query (Endo WindowSet))
-> Maybe String
-> Query (Endo WindowSet)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Query (Endo WindowSet)
forall m. Monoid m => m
idHook String -> Query (Endo WindowSet)
doShift (Maybe String -> Query (Endo WindowSet))
-> (Window -> Query (Maybe String))
-> Window
-> Query (Endo WindowSet)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< X (Maybe String) -> Query (Maybe String)
forall a. X a -> Query a
liftX (X (Maybe String) -> Query (Maybe String))
-> (Window -> X (Maybe String)) -> Window -> Query (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X (Maybe String)
needsMoving) (Window -> Query (Endo WindowSet))
-> Query Window -> Query (Endo WindowSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Query Window
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 X (Maybe WindowAttributes)
-> (Maybe WindowAttributes -> X (Maybe String)) -> X (Maybe String)
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe WindowAttributes
Nothing -> Maybe String -> X (Maybe String)
forall a. a -> X a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
    Just WindowAttributes
wa -> (Either String String -> Maybe String)
-> X (Either String String) -> X (Maybe String)
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Maybe String)
-> (String -> Maybe String) -> Either String String -> Maybe String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe String -> String -> Maybe String
forall a b. a -> b -> a
const Maybe String
forall a. Maybe a
Nothing) String -> Maybe String
forall a. a -> Maybe a
Just) (X (Either String String) -> X (Maybe String))
-> (ExceptT String X String -> X (Either String String))
-> ExceptT String X String
-> X (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String X String -> X (Either String String)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String X String -> X (Maybe String))
-> ExceptT String X String -> X (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
        -- only relocate windows with non-zero position
        Bool -> ExceptT String X ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ExceptT String X ()) -> Bool -> ExceptT String X ()
forall a b. (a -> b) -> a -> b
$ WindowAttributes -> CInt
wa_x WindowAttributes
wa CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 Bool -> Bool -> Bool
|| WindowAttributes -> CInt
wa_y WindowAttributes
wa CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        ws <- (XState -> WindowSet) -> ExceptT String X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
        sc <- lift $ fromMaybe (W.current ws)
                <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
        Just wkspc <- lift $ screenWorkspace (W.screen sc)
        guard $ W.currentTag ws /= wkspc
        return wkspc `asTypeOf` throwError ""