{-# LANGUAGE LambdaCase #-}
module XMonad.Hooks.WorkspaceByPos (
workspaceByPos
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as W
import Control.Monad.Except (runExceptT, throwError)
import Control.Monad.Trans (lift)
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
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
""