diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index b995d28..aff0857 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -5,6 +5,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | @@ -39,7 +40,7 @@ module XMonad.Core ( import XMonad.StackSet hiding (modify) import Prelude -import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..)) +import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..)) import qualified Control.Exception as E import Control.Applicative ((<|>), empty) import Control.Monad.Fail @@ -176,7 +177,7 @@ newtype Query a = Query (ReaderT Window X a) deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO) runQuery :: Query a -> Window -> X a -runQuery (Query m) w = runReaderT m w +runQuery (Query m) = runReaderT m instance Semigroup a => Semigroup (Query a) where (<>) = liftM2 (<>) @@ -199,7 +200,7 @@ catchX job errcase = do st <- get c <- ask (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of - Just x -> throw e `const` (x `asTypeOf` ExitSuccess) + Just (_ :: ExitCode) -> throw e _ -> do hPrint stderr e; runX c st errcase put s' return a @@ -207,12 +208,12 @@ catchX job errcase = do -- | Execute the argument, catching all exceptions. Either this function or -- 'catchX' should be used at all callsites of user customized code. userCode :: X a -> X (Maybe a) -userCode a = catchX (Just `liftM` a) (return Nothing) +userCode a = catchX (Just <$> a) (return Nothing) -- | Same as userCode but with a default argument to return instead of using -- Maybe, provided for convenience. userCodeDef :: a -> X a -> X a -userCodeDef defValue a = fromMaybe defValue `liftM` userCode a +userCodeDef defValue a = fromMaybe defValue <$> userCode a -- --------------------------------------------------------------------- -- Convenient wrappers to state @@ -233,7 +234,7 @@ withWindowAttributes dpy win f = do -- | True if the given window is the root window isRoot :: Window -> X Bool -isRoot w = (w==) <$> asks theRoot +isRoot w = asks $ (w ==) . theRoot -- | Wrapper for the common case of atom internment getAtom :: String -> X Atom @@ -649,7 +650,7 @@ getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> r compile :: Directories -> Compile -> IO ExitCode compile dirs method = bracket_ uninstallSignalHandlers installSignalHandlers $ - bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do + withFile (errFileName dirs) WriteMode $ \err -> do let run = runProc (cfgDir dirs) err case method of CompileGhc -> diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs index b3b0213..170a019 100644 --- a/src/XMonad/Main.hs +++ b/src/XMonad/Main.hs @@ -503,7 +503,7 @@ grabButtons = do io $ ungrabButton dpy anyButton anyModifier rootw ems <- extraModifiers ba <- asks buttonActions - mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba) + mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba) -- | @replace@ to signals compliant window managers to exit. replace :: Display -> ScreenNumber -> Window -> IO () diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs index 95e56c5..d012436 100644 --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -3,6 +3,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} -- -------------------------------------------------------------------------- -- | @@ -193,7 +194,7 @@ windows f = do let m = W.floating ws flt = [(fw, scaleRationalRect viewrect r) - | fw <- filter (flip M.member m) (W.index this) + | fw <- filter (`M.member` m) (W.index this) , Just r <- [M.lookup fw m]] vs = flt ++ rs @@ -219,7 +220,7 @@ windows f = do -- all windows that are no longer in the windowset are marked as -- withdrawn, it is important to do this after the above, otherwise 'hide' -- will overwrite withdrawnState with iconicState - mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws) + mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws) isMouseFocused <- asks mouseFocused unless isMouseFocused $ clearEvents enterWindowMask @@ -235,8 +236,8 @@ windowBracket :: (a -> Bool) -> X a -> X a windowBracket p action = withWindowSet $ \old -> do a <- action when (p a) . withWindowSet $ \new -> do - modifyWindowSet $ \_ -> old - windows $ \_ -> new + modifyWindowSet $ const old + windows $ const new return a -- | Perform an @X@ action. If it returns @Any True@, unwind the @@ -444,7 +445,7 @@ setFocusX w = withWindowSet $ \ws -> do -- layout the windows, in which case changes are handled through a refresh. sendMessage :: Message a => a -> X () sendMessage a = windowBracket_ $ do - w <- W.workspace . W.current <$> gets windowset + w <- gets $ W.workspace . W.current . windowset ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing whenJust ml' $ \l' -> modifyWindowSet $ \ws -> ws { W.current = (W.current ws) @@ -479,9 +480,9 @@ updateLayout i ml = whenJust ml $ \l -> -- | Set the layout of the currently viewed workspace. setLayout :: Layout Window -> X () setLayout l = do - ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset + ss@W.StackSet{ W.current = c@W.Screen{ W.workspace = ws }} <- gets windowset handleMessage (W.layout ws) (SomeMessage ReleaseResources) - windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } } + windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } } ------------------------------------------------------------------------ -- Utilities @@ -607,8 +608,7 @@ floatLocation w = sc <- gets $ W.current . windowset return (W.screen sc, W.RationalRect 0 0 1 1) - where fi x = fromIntegral x - go = withDisplay $ \d -> do + where go = withDisplay $ \d -> do ws <- gets windowset wa <- io $ getWindowAttributes d w let bw = (fromIntegral . wa_border_width) wa @@ -634,6 +634,9 @@ floatLocation w = return (W.screen sc, rr) + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral + -- | Given a point, determine the screen (if any) that contains it. pointScreen :: Position -> Position -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) @@ -732,7 +735,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do sh <- getWMNormalHints d w wa <- C.try $ getWindowAttributes d w case wa of - Left err -> const (return id) (err :: C.SomeException) + Left (_ :: C.SomeException) -> return id Right wa' -> let bw = fromIntegral $ wa_border_width wa' in return $ applySizeHints bw sh