From 5aff766a4c51ec211de9302cfa297a9011143c6c Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Thu, 4 Nov 2021 20:39:39 +0000 Subject: [PATCH] Apply hlint 3.3 hints --- XMonad/Actions/CopyWindow.hs | 4 ++-- XMonad/Actions/EasyMotion.hs | 2 +- XMonad/Actions/Launcher.hs | 4 ++-- XMonad/Actions/WindowNavigation.hs | 2 +- XMonad/Config/Bluetile.hs | 2 +- XMonad/Hooks/DebugKeyEvents.hs | 4 ---- XMonad/Hooks/SetWMName.hs | 2 +- XMonad/Layout/ButtonDecoration.hs | 2 +- XMonad/Layout/Decoration.hs | 6 +++--- XMonad/Layout/Groups.hs | 2 +- XMonad/Layout/ImageButtonDecoration.hs | 2 +- XMonad/Layout/LayoutHints.hs | 2 +- XMonad/Layout/LayoutModifier.hs | 2 +- XMonad/Layout/LimitWindows.hs | 8 ++++---- XMonad/Layout/ResizeScreen.hs | 2 +- XMonad/Layout/ShowWName.hs | 2 +- XMonad/Layout/WindowSwitcherDecoration.hs | 4 ++-- XMonad/Prompt.hs | 4 ++-- XMonad/Prompt/Window.hs | 4 ++-- XMonad/Util/Stack.hs | 8 ++++---- 20 files changed, 32 insertions(+), 36 deletions(-) diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs index d577df1f..f3f23bf0 100644 --- a/XMonad/Actions/CopyWindow.hs +++ b/XMonad/Actions/CopyWindow.hs @@ -114,10 +114,10 @@ copyWindow w n = copy' where copy' s = if n `W.tagMember` s then W.view (W.currentTag s) $ insertUp' w $ W.view n s else s - insertUp' a s = W.modify (Just $ W.Stack a [] []) + insertUp' a = W.modify (Just $ W.Stack a [] []) (\(W.Stack t l r) -> if a `elem` t:l++r then Just $ W.Stack t l r - else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s + else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) -- | runOrCopy will run the provided shell command unless it can diff --git a/XMonad/Actions/EasyMotion.hs b/XMonad/Actions/EasyMotion.hs index 5df77f79..795365dc 100644 --- a/XMonad/Actions/EasyMotion.hs +++ b/XMonad/Actions/EasyMotion.hs @@ -296,7 +296,7 @@ handleSelectWindow c = do allKeys (PerScreenKeys m) = concat $ M.elems m buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay] - buildOverlays ks = appendChords (maxChordLen c) ks + buildOverlays = appendChords (maxChordLen c) buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow] buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws diff --git a/XMonad/Actions/Launcher.hs b/XMonad/Actions/Launcher.hs index 26eb42f4..8d35269a 100644 --- a/XMonad/Actions/Launcher.hs +++ b/XMonad/Actions/Launcher.hs @@ -62,7 +62,7 @@ type ExtensionActions = M.Map String (String -> X()) instance XPrompt CalculatorMode where showXPrompt CalcMode = "calc %s> " commandToComplete CalcMode = id --send the whole string to `calc` - completionFunction CalcMode = \s -> if null s then return [] else + completionFunction CalcMode s = if null s then return [] else lines <$> runProcessWithInput "calc" [s] "" modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard @@ -70,7 +70,7 @@ instance XPrompt CalculatorMode where instance XPrompt HoogleMode where showXPrompt _ = "hoogle %s> " commandToComplete _ = id - completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s] + completionFunction (HMode pathToHoogleBin' _) s = completionFunctionWith pathToHoogleBin' ["--count","8",s] -- This action calls hoogle again to find the URL corresponding to the autocompleted item modeAction (HMode pathToHoogleBin'' browser') query result = do completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query] diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs index 5f06cdf9..bfcb7e54 100644 --- a/XMonad/Actions/WindowNavigation.hs +++ b/XMonad/Actions/WindowNavigation.hs @@ -127,7 +127,7 @@ swap = withTargetWindow swapWithFocused Just currentWin -> W.focusWindow currentWin $ mapWindows (swapWin currentWin targetWin) winSet Nothing -> winSet - mapWindows f ss = W.mapWorkspace (mapWindows' f) ss + mapWindows f = W.mapWorkspace (mapWindows' f) mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s } mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down) swapWin win1 win2 win diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index f7eaa46b..f39fdd17 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -194,7 +194,7 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ fullscreen = tilingDeco $ maximize $ smartBorders Full tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l) - floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l + floatingDeco = buttonDeco shrinkText defaultThemeWithButtons bluetileConfig = docks . ewmhFullscreen . ewmh $ diff --git a/XMonad/Hooks/DebugKeyEvents.hs b/XMonad/Hooks/DebugKeyEvents.hs index 4e39fc21..6f5a7d48 100644 --- a/XMonad/Hooks/DebugKeyEvents.hs +++ b/XMonad/Hooks/DebugKeyEvents.hs @@ -92,10 +92,6 @@ vmask numLockMask msk = unwords $ fst $ foldr vmask' ([],msk) masks where - -#if __GLASGOW_HASKELL__ < 707 - finiteBitSize x = bitSize x -#endif masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++ [(numLockMask,"num" ) ,( lockMask,"lock" ) diff --git a/XMonad/Hooks/SetWMName.hs b/XMonad/Hooks/SetWMName.hs index e6d4b92d..e44e1402 100644 --- a/XMonad/Hooks/SetWMName.hs +++ b/XMonad/Hooks/SetWMName.hs @@ -69,7 +69,7 @@ setWMName name = do changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM propModeReplace (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList) where latin1StringToCCharList :: String -> [CChar] - latin1StringToCCharList str = map (fromIntegral . ord) str + latin1StringToCCharList = map (fromIntegral . ord) netSupportingWMCheckAtom :: X Atom netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK" diff --git a/XMonad/Layout/ButtonDecoration.hs b/XMonad/Layout/ButtonDecoration.hs index 8ccefe04..31f73965 100644 --- a/XMonad/Layout/ButtonDecoration.hs +++ b/XMonad/Layout/ButtonDecoration.hs @@ -53,5 +53,5 @@ newtype ButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ButtonDecoration a where describeDeco _ = "ButtonDeco" - decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR + decorationCatchClicksHook _ = titleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 58e56301..eadb1079 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -152,7 +152,7 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where -- | The description that the 'Decoration' modifier will display. describeDeco :: ds a -> String - describeDeco ds = show ds + describeDeco = show -- | Shrink the window's rectangle when applying a decoration. shrink :: ds a -> Rectangle -> Rectangle -> Rectangle @@ -160,7 +160,7 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where -- | The decoration event hook decorationEventHook :: ds a -> DecorationState -> Event -> X () - decorationEventHook ds s e = handleMouseFocusDrag ds s e + decorationEventHook = handleMouseFocusDrag -- | A hook that can be used to catch the cases when the user -- clicks on the decoration. If you return True here, the click event @@ -176,7 +176,7 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where -- The hook can be overwritten if a different way of handling the dragging -- is required. decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X () - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y + decorationWhileDraggingHook _ = handleDraggingInProgress -- | This hoook is called after a window has been dragged using the decoration. decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index e2f6364f..7eabad31 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -239,7 +239,7 @@ removeDeleted z = filterZ_ (`elemZ` z) findNewWindows :: Eq a => [a] -> Zipper (Group l a) -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs) - where removePresent g as' = filter (not . flip elemZ (gZipper g)) as' + where removePresent g = filter (not . flip elemZ (gZipper g)) -- | Add windows to the focused group. If you need to create one, -- use the given layout and an id from the given list. diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs index c6081451..4bff8aac 100644 --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -177,5 +177,5 @@ newtype ImageButtonDecoration a = NFD Bool deriving (Show, Read) instance Eq a => DecorationStyle ImageButtonDecoration a where describeDeco _ = "ImageButtonDeco" - decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR + decorationCatchClicksHook _ = imageTitleBarButtonHandler decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return () diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index 07d8bc4f..aa886168 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -164,7 +164,7 @@ applyHints s root (((w,lrect@(Rectangle a b c d)),adj):xs) = $ if isInStack s w then Rectangle a b c' d' else lrect ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d') - growOther' r = growOther ds lrect (freeDirs root lrect) r + growOther' = growOther ds lrect (freeDirs root lrect) mapSnd f = map (first $ second f) next = applyHints s root $ mapSnd growOther' xs in (w,redr):next diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index 9528258b..e9d8ffc8 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -107,7 +107,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where -> Workspace WorkspaceId (l a) a -- ^ current workspace -> Rectangle -- ^ screen rectangle -> X ([(a, Rectangle)], Maybe (l a)) - modifyLayout _ w r = runLayout w r + modifyLayout _ = runLayout -- | Similar to 'modifyLayout', but this function also allows you -- update the state of your layout modifier(the second value in the diff --git a/XMonad/Layout/LimitWindows.hs b/XMonad/Layout/LimitWindows.hs index 6709584b..a22821ea 100644 --- a/XMonad/Layout/LimitWindows.hs +++ b/XMonad/Layout/LimitWindows.hs @@ -99,8 +99,8 @@ instance LayoutModifier LimitWindows a where where pos x = guard (x>=1) >> return x app f x = guard (f x /= x) >> return (f x) - modifyLayout (LimitWindows style n) ws r = - runLayout ws { W.stack = f n <$> W.stack ws } r + modifyLayout (LimitWindows style n) ws = + runLayout ws { W.stack = f n <$> W.stack ws } where f = case style of FirstN -> firstN Slice -> slice @@ -123,8 +123,8 @@ data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int } deriving (Read, Show, Eq) instance LayoutModifier Selection a where - modifyLayout s w r = - runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r + modifyLayout s w = + runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) pureModifier sel _ stk wins = (wins, update sel <$> stk) diff --git a/XMonad/Layout/ResizeScreen.hs b/XMonad/Layout/ResizeScreen.hs index 68c41396..c92646c8 100644 --- a/XMonad/Layout/ResizeScreen.hs +++ b/XMonad/Layout/ResizeScreen.hs @@ -71,7 +71,7 @@ instance LayoutModifier ResizeScreen a where | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i) | ResizeScreen B i <- m = resize $ Rectangle x y w (h - fi i) | WithNewScreen r <- m = resize r - where resize nr = runLayout ws nr + where resize = runLayout ws pureMess (ResizeScreen d _) m | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t) diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs index 55d46d8a..f7b2048a 100644 --- a/XMonad/Layout/ShowWName.hs +++ b/XMonad/Layout/ShowWName.hs @@ -77,7 +77,7 @@ instance Default SWNConfig where } instance LayoutModifier ShowWName a where - redoLayout sn r _ wrs = doShow sn r wrs + redoLayout sn r _ = doShow sn r handleMess (SWN _ c (Just (i,w))) m | Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing) diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs index e2babbea..2ed17387 100644 --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -84,7 +84,7 @@ instance Eq a => DecorationStyle WindowSwitcherDecoration a where decorationCatchClicksHook (WSD withButtons) mainw dFL dFR = if withButtons then titleBarButtonHandler mainw dFL dFR else return False - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y + decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped @@ -105,7 +105,7 @@ instance Eq a => DecorationStyle ImageWindowSwitcherDecoration a where decorationCatchClicksHook (IWSD withButtons) mainw dFL dFR = if withButtons then imageTitleBarButtonHandler mainw dFL dFR else return False - decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y + decorationWhileDraggingHook _ = handleTiledDraggingInProgress decorationAfterDraggingHook _ (mainw, _) decoWin = do focus mainw hasCrossed <- handleScreenCrossing mainw decoWin unless hasCrossed $ do sendMessage DraggingStopped diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 068adb95..18838512 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -271,7 +271,7 @@ class XPrompt t where -- The argument passed to this function is given by `commandToComplete` -- The default implementation shows an error message. completionFunction :: t -> ComplFunction - completionFunction t = \_ -> return ["Completions for " ++ showXPrompt t ++ " could not be loaded"] + completionFunction t = const $ return ["Completions for " ++ showXPrompt t ++ " could not be loaded"] -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called -- when the user picks an item from the autocompletion list. @@ -748,7 +748,7 @@ handleCompletion cs = do alwaysHlight <- gets $ alwaysHighlight . config st <- get - let updateWins l = redrawWindows (pure ()) l + let updateWins = redrawWindows (pure ()) updateState l = if alwaysHlight then hlComplete (getLastWord $ command st) l st else simpleComplete l st diff --git a/XMonad/Prompt/Window.hs b/XMonad/Prompt/Window.hs index 95f8884f..2e116335 100644 --- a/XMonad/Prompt/Window.hs +++ b/XMonad/Prompt/Window.hs @@ -92,8 +92,8 @@ instance XPrompt WindowModePrompt where showXPrompt (WindowModePrompt action _ _) = showXPrompt action - completionFunction (WindowModePrompt _ winmap predicate) = - \s -> return . filter (predicate s) . map fst . M.toList $ winmap + completionFunction (WindowModePrompt _ winmap predicate) s = + return . filter (predicate s) . map fst . M.toList $ winmap modeAction (WindowModePrompt action winmap _) buf auto = do let name = if null auto then buf else auto diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs index be5c0576..0ef69a93 100644 --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -162,20 +162,20 @@ focusUpZ :: Zipper a -> Zipper a focusUpZ Nothing = Nothing focusUpZ (Just s) | u:up <- W.up s = Just $ W.Stack u up (W.focus s:W.down s) focusUpZ (Just s) | null $ W.down s = Just s -focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (reverse (init down) ++ [f]) [] +focusUpZ (Just (W.Stack f _ down)) = Just $ W.Stack (last down) (tail (reverse down) ++ [f]) [] -- | Move the focus to the next element focusDownZ :: Zipper a -> Zipper a focusDownZ Nothing = Nothing focusDownZ (Just s) | d:down <- W.down s = Just $ W.Stack d (W.focus s:W.up s) down focusDownZ (Just s) | null $ W.up s = Just s -focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (reverse (init up) ++ [f]) +focusDownZ (Just (W.Stack f up _)) = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f]) -- | Move the focus to the first element focusMasterZ :: Zipper a -> Zipper a focusMasterZ Nothing = Nothing focusMasterZ (Just (W.Stack f up down)) | not $ null up - = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down) + = Just $ W.Stack (last up) [] (tail (reverse up) ++ [f] ++ down) focusMasterZ (Just s) = Just s -- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to @@ -284,7 +284,7 @@ deleteFocusedZ = filterZ (\b _ -> not b) -- | Delete the ith element deleteIndexZ :: Int -> Zipper a -> Zipper a deleteIndexZ i z = let numbered = (fromTags . zipWith number [0..] . toTags) z - number j ea = mapE (\_ a -> (j,a)) ea + number j = mapE (\_ a -> (j,a)) in mapZ_ snd $ filterZ_ ((/=i) . fst) numbered -- ** Folds