mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
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:
@@ -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)
|
||||
|
Reference in New Issue
Block a user