Apply hlint hints

Makes src/ hlint-clean.
This commit is contained in:
Tomas Janousek 2022-06-25 18:04:41 +01:00
parent 0edb65107b
commit 711b28f494
3 changed files with 22 additions and 18 deletions

View File

@ -5,6 +5,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@ -39,7 +40,7 @@ module XMonad.Core (
import XMonad.StackSet hiding (modify) import XMonad.StackSet hiding (modify)
import Prelude 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 qualified Control.Exception as E
import Control.Applicative ((<|>), empty) import Control.Applicative ((<|>), empty)
import Control.Monad.Fail import Control.Monad.Fail
@ -176,7 +177,7 @@ newtype Query a = Query (ReaderT Window X a)
deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO) deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
runQuery :: Query a -> Window -> X a 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 instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>) (<>) = liftM2 (<>)
@ -199,7 +200,7 @@ catchX job errcase = do
st <- get st <- get
c <- ask c <- ask
(a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of (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 _ -> do hPrint stderr e; runX c st errcase
put s' put s'
return a return a
@ -207,12 +208,12 @@ catchX job errcase = do
-- | Execute the argument, catching all exceptions. Either this function or -- | Execute the argument, catching all exceptions. Either this function or
-- 'catchX' should be used at all callsites of user customized code. -- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a) 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 -- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience. -- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a 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 -- Convenient wrappers to state
@ -233,7 +234,7 @@ withWindowAttributes dpy win f = do
-- | True if the given window is the root window -- | True if the given window is the root window
isRoot :: Window -> X Bool isRoot :: Window -> X Bool
isRoot w = (w==) <$> asks theRoot isRoot w = asks $ (w ==) . theRoot
-- | Wrapper for the common case of atom internment -- | Wrapper for the common case of atom internment
getAtom :: String -> X Atom getAtom :: String -> X Atom
@ -649,7 +650,7 @@ getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> r
compile :: Directories -> Compile -> IO ExitCode compile :: Directories -> Compile -> IO ExitCode
compile dirs method = compile dirs method =
bracket_ uninstallSignalHandlers installSignalHandlers $ bracket_ uninstallSignalHandlers installSignalHandlers $
bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do withFile (errFileName dirs) WriteMode $ \err -> do
let run = runProc (cfgDir dirs) err let run = runProc (cfgDir dirs) err
case method of case method of
CompileGhc -> CompileGhc ->

View File

@ -503,7 +503,7 @@ grabButtons = do
io $ ungrabButton dpy anyButton anyModifier rootw io $ ungrabButton dpy anyButton anyModifier rootw
ems <- extraModifiers ems <- extraModifiers
ba <- asks buttonActions 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@ to signals compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO () replace :: Display -> ScreenNumber -> Window -> IO ()

View File

@ -3,6 +3,7 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
@ -193,7 +194,7 @@ windows f = do
let m = W.floating ws let m = W.floating ws
flt = [(fw, scaleRationalRect viewrect r) 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]] , Just r <- [M.lookup fw m]]
vs = flt ++ rs vs = flt ++ rs
@ -219,7 +220,7 @@ windows f = do
-- all windows that are no longer in the windowset are marked as -- all windows that are no longer in the windowset are marked as
-- withdrawn, it is important to do this after the above, otherwise 'hide' -- withdrawn, it is important to do this after the above, otherwise 'hide'
-- will overwrite withdrawnState with iconicState -- 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 isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask unless isMouseFocused $ clearEvents enterWindowMask
@ -235,8 +236,8 @@ windowBracket :: (a -> Bool) -> X a -> X a
windowBracket p action = withWindowSet $ \old -> do windowBracket p action = withWindowSet $ \old -> do
a <- action a <- action
when (p a) . withWindowSet $ \new -> do when (p a) . withWindowSet $ \new -> do
modifyWindowSet $ \_ -> old modifyWindowSet $ const old
windows $ \_ -> new windows $ const new
return a return a
-- | Perform an @X@ action. If it returns @Any True@, unwind the -- | 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. -- layout the windows, in which case changes are handled through a refresh.
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = windowBracket_ $ do 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 ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> whenJust ml' $ \l' ->
modifyWindowSet $ \ws -> ws { W.current = (W.current ws) modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
@ -479,7 +480,7 @@ updateLayout i ml = whenJust ml $ \l ->
-- | Set the layout of the currently viewed workspace. -- | Set the layout of the currently viewed workspace.
setLayout :: Layout Window -> X () setLayout :: Layout Window -> X ()
setLayout l = do 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) 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 } } }
@ -607,8 +608,7 @@ floatLocation w =
sc <- gets $ W.current . windowset sc <- gets $ W.current . windowset
return (W.screen sc, W.RationalRect 0 0 1 1) return (W.screen sc, W.RationalRect 0 0 1 1)
where fi x = fromIntegral x where go = withDisplay $ \d -> do
go = withDisplay $ \d -> do
ws <- gets windowset ws <- gets windowset
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
let bw = (fromIntegral . wa_border_width) wa let bw = (fromIntegral . wa_border_width) wa
@ -634,6 +634,9 @@ floatLocation w =
return (W.screen sc, rr) 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. -- | Given a point, determine the screen (if any) that contains it.
pointScreen :: Position -> Position pointScreen :: Position -> Position
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@ -732,7 +735,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do
sh <- getWMNormalHints d w sh <- getWMNormalHints d w
wa <- C.try $ getWindowAttributes d w wa <- C.try $ getWindowAttributes d w
case wa of case wa of
Left err -> const (return id) (err :: C.SomeException) Left (_ :: C.SomeException) -> return id
Right wa' -> Right wa' ->
let bw = fromIntegral $ wa_border_width wa' let bw = fromIntegral $ wa_border_width wa'
in return $ applySizeHints bw sh in return $ applySizeHints bw sh