Apply hlint hints

All hints are applied in one single commit, as a commit per hint would
result in 80+ separate commits—tihs is really just too much noise.

Related: https://github.com/xmonad/xmonad-contrib/issues/537
This commit is contained in:
slotThe
2021-06-06 16:11:17 +02:00
parent b96899afb6
commit bd5b969d9b
222 changed files with 1119 additions and 1193 deletions

View File

@@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.FixedColumn
@@ -29,7 +29,7 @@ import Graphics.X11.Xlib.Extras ( getWMNormalHints
, sh_resize_inc
, wa_border_width)
import XMonad.Prelude (fromMaybe, msum)
import XMonad.Prelude (fromMaybe, msum, (<&>))
import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)
import XMonad.Layout (Resize(..), IncMasterN(..), tile)
import XMonad.StackSet as W
@@ -61,7 +61,7 @@ instance LayoutClass FixedColumn Window where
fws <- mapM (widthCols fallback ncol) ws
let frac = maximum (take nmaster fws) // rect_width r
rs = tile frac r nmaster (length ws)
return $ (zip ws rs, Nothing)
return (zip ws rs, Nothing)
where ws = W.integrate s
x // y = fromIntegral x / fromIntegral y
@@ -84,7 +84,7 @@ widthCols :: Int -> Int -> Window -> X Int
widthCols inc n w = withDisplay $ \d -> io $ do
sh <- getWMNormalHints d w
bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
let widthHint f = f sh >>= return . fromIntegral . fst
let widthHint f = f sh <&> fromIntegral . fst
oneCol = fromMaybe inc $ widthHint sh_resize_inc
base = fromMaybe 0 $ widthHint sh_base_size
return $ 2 * bw + base + n * oneCol