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 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 ->

View File

@ -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 ()

View File

@ -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,7 +480,7 @@ 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 } } }
@ -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