    {-# 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 ""