Use ErrorT instead of nested case for H.WorkspaceByPos

This commit is contained in:
Adam Vogt
2009-09-30 20:49:14 +00:00
parent e6158615cb
commit bf2fc75035

View File

@@ -22,9 +22,11 @@ module XMonad.Hooks.WorkspaceByPos (
import XMonad import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Util.XUtils (fi)
import Data.Maybe import Data.Maybe
import Control.Applicative((<$>)) import Control.Applicative((<$>))
import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -36,30 +38,17 @@ import Control.Applicative((<$>))
-- > main = xmonad defaultConfig { manageHook = myManageHook } -- > main = xmonad defaultConfig { manageHook = myManageHook }
workspaceByPos :: ManageHook workspaceByPos :: ManageHook
workspaceByPos = ask >>= \w -> do workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
b <- liftX $ needsMoving w
case b of
Nothing -> idHook
Just wkspc -> doShift wkspc
needsMoving :: Window -> X (Maybe WorkspaceId) needsMoving :: Window -> X (Maybe WorkspaceId)
needsMoving w = withDisplay $ \d -> do needsMoving w = withDisplay $ \d -> do
-- only relocate windows with non-zero position -- only relocate windows with non-zero position
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
if ((wa_x wa) == 0) && ((wa_y wa) == 0) fmap (const Nothing `either` Just) . runErrorT $ do
then return Nothing guard $ wa_x wa == 0 && wa_y wa == 0
else do ws <- gets windowset
ws <- gets windowset sc <- lift $ fromMaybe (W.current ws)
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
<$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) Just wkspc <- lift $ screenWorkspace (W.screen sc)
maybeWkspc <- screenWorkspace (W.screen sc) guard $ W.currentTag ws /= wkspc
case maybeWkspc of return wkspc `asTypeOf` throwError ""
Nothing -> return Nothing
Just wkspc -> do
let currentWksp = W.currentTag ws
if currentWksp == wkspc
then return Nothing
else return (Just wkspc)
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral