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

@@ -199,8 +199,7 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
lastViewedHiddenExcept skips = do
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
vs <- WH.workspaceHistory
return $ choose hs (find (`elem` hs) vs)
choose hs . find (`elem` hs) <$> WH.workspaceHistory
where choose [] _ = Nothing
choose (h:_) Nothing = Just h
choose _ vh@(Just _) = vh
@@ -211,7 +210,7 @@ switchWorkspace d = wsBy d >>= windows . greedyView
shiftBy :: Int -> X ()
shiftBy d = wsBy d >>= windows . shift
wsBy :: Int -> X (WorkspaceId)
wsBy :: Int -> X WorkspaceId
wsBy = findWorkspace getSortByIndex Next AnyWS
{- $taketwo
@@ -260,7 +259,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w)
wsTypeToPred AnyWS = return (const True)
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
return $ (cur ==).groupName
where groupName = takeWhile (/=sep).tag
wsTypeToPred (WSIs p) = p
@@ -297,7 +296,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
where
maybeNegate Next d = d
maybeNegate Prev d = (-d)
maybeNegate Prev d = -d
findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
@@ -307,7 +306,7 @@ findWorkspaceGen sortX wsPredX d = do
ws <- gets windowset
let cur = workspace (current ws)
sorted = sort (workspaces ws)
pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a
ws' = filter wsPred pivoted
mCurIx = findWsIndex cur ws'
d' = if d > 0 then d - 1 else d
@@ -319,7 +318,7 @@ findWorkspaceGen sortX wsPredX d = do
return $ tag next
findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
findWsIndex ws = findIndex ((== tag ws) . tag)
-- | View next screen
nextScreen :: X ()
@@ -347,7 +346,7 @@ the default screen keybindings:
> , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
-}
screenBy :: Int -> X (ScreenId)
screenBy :: Int -> X ScreenId
screenBy d = do ws <- gets windowset
--let ss = sortBy screen (screens ws)
let now = screen (current ws)