From 8197cd9105070f31a672517e3c316c6c2004a19d Mon Sep 17 00:00:00 2001 From: Tomas Janousek <tomi@nomi.cz> Date: Sun, 31 Oct 2021 17:14:59 +0000 Subject: [PATCH] Fix -Wincomplete-uni-patterns warnings I am not proud of this. --- XMonad/Actions/CycleWindows.hs | 10 +++++++--- XMonad/Actions/DwmPromote.hs | 9 ++++++--- XMonad/Actions/DynamicWorkspaceOrder.hs | 3 ++- XMonad/Actions/FlexibleResize.hs | 5 ++++- XMonad/Actions/FocusNth.hs | 19 ++++++++---------- XMonad/Actions/KeyRemap.hs | 6 ++---- XMonad/Actions/MouseGestures.hs | 16 +++++---------- XMonad/Actions/Navigation2D.hs | 3 +-- XMonad/Actions/RotSlaves.hs | 11 +++++++---- XMonad/Actions/RotateSome.hs | 6 ++++-- XMonad/Actions/SpawnOn.hs | 6 ++---- XMonad/Actions/TiledWindowDragging.hs | 2 +- XMonad/Actions/WindowGo.hs | 8 ++++++-- XMonad/Actions/Workscreen.hs | 5 ++++- XMonad/Config/Dmwit.hs | 8 ++++---- XMonad/Hooks/WallpaperSetter.hs | 3 +-- XMonad/Layout/BinarySpacePartition.hs | 3 ++- XMonad/Layout/BoringWindows.hs | 5 +++-- XMonad/Layout/Decoration.hs | 2 +- XMonad/Layout/Groups.hs | 24 +++++++++++------------ XMonad/Layout/Groups/Helpers.hs | 4 ++-- XMonad/Layout/LayoutScreens.hs | 12 ++++++++---- XMonad/Layout/Spacing.hs | 3 +-- XMonad/Layout/SubLayouts.hs | 6 +++--- XMonad/Layout/TallMastersCombo.hs | 17 ++++------------ XMonad/Layout/WindowSwitcherDecoration.hs | 4 ++-- XMonad/Prelude.hs | 13 ++++++++++++ XMonad/Prompt/FuzzyMatch.hs | 9 +++++---- XMonad/Util/Rectangle.hs | 7 ++++--- 29 files changed, 124 insertions(+), 105 deletions(-) diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs index a144ff45..c00e3690 100644 --- a/XMonad/Actions/CycleWindows.hs +++ b/XMonad/Actions/CycleWindows.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + -------------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.CycleWindows @@ -53,7 +55,9 @@ module XMonad.Actions.CycleWindows ( ) where import XMonad +import XMonad.Prelude import qualified XMonad.StackSet as W +import qualified Data.List.NonEmpty as NE import XMonad.Actions.RotSlaves import Control.Arrow (second) @@ -179,7 +183,7 @@ rotOpposite' :: W.Stack a -> W.Stack a rotOpposite' (W.Stack t l r) = W.Stack t' l' r' where rrvl = r ++ reverse l part = (length rrvl + 1) `div` 2 - (l',t':r') = second reverse . splitAt (length l) $ + (l', notEmpty -> t' :| r') = second reverse . splitAt (length l) $ reverse (take part rrvl ++ t : drop part rrvl) @@ -205,7 +209,7 @@ rotFocusedDown = windows . W.modify' $ rotFocused' rotDown rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotFocused' _ s@(W.Stack _ [] []) = s rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus - where (t':rs') = f (t:rs) + where (notEmpty -> t' :| rs') = f (t:rs) rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise @@ -223,7 +227,7 @@ rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a rotUnfocused' _ s@(W.Stack _ [] []) = s rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master has focus rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise - where (master:revls) = reverse ls + where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll) (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs) -- $generic diff --git a/XMonad/Actions/DwmPromote.hs b/XMonad/Actions/DwmPromote.hs index 80493213..a4cbf8f0 100644 --- a/XMonad/Actions/DwmPromote.hs +++ b/XMonad/Actions/DwmPromote.hs @@ -25,6 +25,9 @@ module XMonad.Actions.DwmPromote ( import XMonad import XMonad.StackSet +import XMonad.Prelude + +import qualified Data.List.NonEmpty as NE -- $usage -- @@ -45,6 +48,6 @@ import XMonad.StackSet dwmpromote :: X () dwmpromote = windows $ modify' $ \c -> case c of - Stack _ [] [] -> c - Stack t [] (x:rs) -> Stack x [] (t:rs) - Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls + Stack _ [] [] -> c + Stack t [] (r:rs) -> Stack r [] (t:rs) + Stack t (l:ls) rs -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls) diff --git a/XMonad/Actions/DynamicWorkspaceOrder.hs b/XMonad/Actions/DynamicWorkspaceOrder.hs index eb8291a5..e0ee5976 100644 --- a/XMonad/Actions/DynamicWorkspaceOrder.hs +++ b/XMonad/Actions/DynamicWorkspaceOrder.hs @@ -152,7 +152,8 @@ swapOrder :: WorkspaceId -> WorkspaceId -> X () swapOrder w1 w2 = do io $ print (w1,w2) WSO (Just m) <- XS.get - let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2] + let i1 = fromJust (w1 `M.lookup` m) + let i2 = fromJust (w2 `M.lookup` m) XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1)) windows id -- force a status bar update diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs index 3bc260eb..6f0c5483 100644 --- a/XMonad/Actions/FlexibleResize.hs +++ b/XMonad/Actions/FlexibleResize.hs @@ -55,7 +55,10 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do sh <- io $ getWMNormalHints d w (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w let - [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height] + pos_x = fi $ wa_x wa + pos_y = fi $ wa_y wa + width = fi $ wa_width wa + height = fi $ wa_height wa west = findPos ix width north = findPos iy height (cx, fx, gx) = mkSel west width pos_x diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs index 0e4b7720..ef24e143 100644 --- a/XMonad/Actions/FocusNth.hs +++ b/XMonad/Actions/FocusNth.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.FocusNth @@ -18,8 +20,9 @@ module XMonad.Actions.FocusNth ( focusNth,focusNth', swapNth,swapNth') where -import XMonad.StackSet import XMonad +import XMonad.Prelude +import XMonad.StackSet -- $usage -- Add the import to your @~\/.xmonad\/xmonad.hs@: @@ -40,8 +43,8 @@ focusNth :: Int -> X () focusNth = windows . modify' . focusNth' focusNth' :: Int -> Stack a -> Stack a -focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s - | otherwise = listToStack n (integrate s) +focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs + | otherwise = s -- | Swap current window with nth. Focus stays in the same position swapNth :: Int -> X () @@ -50,11 +53,5 @@ swapNth = windows . modify' . swapNth' swapNth' :: Int -> Stack a -> Stack a swapNth' n s@(Stack c l r) | (n < 0) || (n > length l + length r) || (n == length l) = s - | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r - | otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr) - -listToStack :: Int -> [a] -> Stack a -listToStack n l = Stack t ls rs - where - (t:rs) = drop n l - ls = reverse (take n l) + | n < length l = let (nl, notEmpty -> nc :| nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r + | otherwise = let (nl, notEmpty -> nc :| nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr) diff --git a/XMonad/Actions/KeyRemap.hs b/XMonad/Actions/KeyRemap.hs index dde51481..e7de8871 100644 --- a/XMonad/Actions/KeyRemap.hs +++ b/XMonad/Actions/KeyRemap.hs @@ -148,8 +148,6 @@ dvorakProgrammerKeyRemap = layoutDvorakShift = map getShift layoutDvorak layoutDvorakKey = map getKey layoutDvorak - getKey char = let Just index = elemIndex char layoutUs - in layoutUsKey !! index - getShift char = let Just index = elemIndex char layoutUs - in layoutUsShift !! index + getKey char = fromJust $ (layoutUsKey !?) =<< elemIndex char layoutUs + getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs charToMask char = if [char] == "0" then 0 else shiftMask diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs index 2b0219e3..f57b2b2e 100644 --- a/XMonad/Actions/MouseGestures.hs +++ b/XMonad/Actions/MouseGestures.hs @@ -79,17 +79,11 @@ gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Pos gauge hook op st nx ny = do let np = (nx, ny) stx <- io $ readIORef st - let - (~(Just od), pivot) = case stx of - Nothing -> (Nothing, op) - Just (d, zp) -> (Just d, zp) - cont = do - guard $ significant np pivot - return $ do - let d' = dir pivot np - when (isNothing stx || od /= d') $ hook d' - io $ writeIORef st (Just (d', np)) - fromMaybe (return ()) cont + let pivot = maybe op snd stx + when (significant np pivot) $ do + let d' = dir pivot np + when ((fst <$> stx) /= Just d') $ hook d' + io $ writeIORef st (Just (d', np)) where significant a b = delta a b >= 10 diff --git a/XMonad/Actions/Navigation2D.hs b/XMonad/Actions/Navigation2D.hs index 169a77f0..522c6e6c 100644 --- a/XMonad/Actions/Navigation2D.hs +++ b/XMonad/Actions/Navigation2D.hs @@ -824,8 +824,7 @@ doSideNavigationWithBias bias dir (cur, rect) rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r) -- Apply the above function until d becomes synonymous with R (wolog). - rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R] - in foldr (const $ (.) rHalfPiCC) id l + rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC transform = rotateToR dir . translate . toSR diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs index 2118c53e..5e0392d2 100644 --- a/XMonad/Actions/RotSlaves.hs +++ b/XMonad/Actions/RotSlaves.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotSlaves @@ -18,8 +20,9 @@ module XMonad.Actions.RotSlaves ( rotAll', rotAllUp, rotAllDown ) where -import XMonad.StackSet import XMonad +import XMonad.StackSet +import XMonad.Prelude -- $usage -- @@ -49,8 +52,8 @@ rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a rotSlaves' _ s@(Stack _ [] []) = s rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise - where (master:ws) = integrate s - (revls',t':rs') = splitAt (length ls) (master:f ws) + where (notEmpty -> master :| ws) = integrate s + (revls', notEmpty -> t' :| rs') = splitAt (length ls) (master:f ws) -- | Rotate all the windows in the current stack. rotAllUp,rotAllDown :: X () @@ -60,4 +63,4 @@ rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l)) -- | The actual rotation, as a pure function on the window stack. rotAll' :: ([a] -> [a]) -> Stack a -> Stack a rotAll' f s = Stack r (reverse revls) rs - where (revls,r:rs) = splitAt (length (up s)) (f (integrate s)) + where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s)) diff --git a/XMonad/Actions/RotateSome.hs b/XMonad/Actions/RotateSome.hs index 02589c21..dc1c61cc 100644 --- a/XMonad/Actions/RotateSome.hs +++ b/XMonad/Actions/RotateSome.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.RotateSome @@ -26,7 +28,7 @@ module XMonad.Actions.RotateSome ( ) where import Control.Arrow ((***)) -import XMonad.Prelude (partition, sortOn, (\\)) +import XMonad.Prelude (NonEmpty(..), notEmpty, partition, sortOn, (\\)) import qualified Data.Map as M import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet) import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack) @@ -148,7 +150,7 @@ rotateSome p (Stack t ls rs) = -- Append anchored elements, along with their unchanged indices, and sort -- by index. Separate lefts (negative indices) from the rest, and grab the -- new focus from the head of the remaining elements. - (ls', t':rs') = + (ls', notEmpty -> t' :| rs') = (map snd *** map snd) . span ((< 0) . fst) . sortOn fst diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs index 946555cd..ec92ca7a 100644 --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -109,11 +109,9 @@ manageSpawnWithGC garbageCollect = do let ppid_chain = case mp of Just winpid -> winpid : getPPIDChain winpid Nothing -> [] - known_window_handlers = [ mh + known_window_handlers = [ mpid | ppid <- ppid_chain - , let mpid = lookup ppid pids - , isJust mpid - , let (Just mh) = mpid ] + , Just mpid <- [lookup ppid pids] ] case known_window_handlers of [] -> idHook (mh:_) -> do diff --git a/XMonad/Actions/TiledWindowDragging.hs b/XMonad/Actions/TiledWindowDragging.hs index 409ce9f7..4943e7e6 100644 --- a/XMonad/Actions/TiledWindowDragging.hs +++ b/XMonad/Actions/TiledWindowDragging.hs @@ -85,7 +85,7 @@ performWindowSwitching win = do let allWindows = W.index ws when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows - let (ls, t : rs) = break (== win) allWindowsSwitched + (ls, t : rs) <- pure $ break (== win) allWindowsSwitched let newStack = W.Stack t (reverse ls) rs windows $ W.modify' $ const newStack where diff --git a/XMonad/Actions/WindowGo.hs b/XMonad/Actions/WindowGo.hs index 939aff6f..e05fc046 100644 --- a/XMonad/Actions/WindowGo.hs +++ b/XMonad/Actions/WindowGo.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + {- | Module : XMonad.Actions.WindowGo Description : Operations for raising (traveling to) windows. @@ -158,8 +160,10 @@ raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do foc <- withWindowSet $ return . W.peek case foc of - Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match - in windows $ focusFn y + Just w | w `elem` ws -> + let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws + -- cannot fail to match + in windows $ focusFn y _ -> windows . focusFn . head $ ws -- | Given a function which gets us a String, we try to raise a window with that classname, diff --git a/XMonad/Actions/Workscreen.hs b/XMonad/Actions/Workscreen.hs index cf3c4475..4036b0ba 100644 --- a/XMonad/Actions/Workscreen.hs +++ b/XMonad/Actions/Workscreen.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.Workscreen @@ -35,6 +37,7 @@ module XMonad.Actions.Workscreen ( ) where import XMonad hiding (workspaces) +import XMonad.Prelude import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS import XMonad.Actions.OnScreen @@ -90,7 +93,7 @@ viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get let wscr = if wscrId == c then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId) else a !! wscrId - (x,_:ys) = splitAt wscrId a + (x, notEmpty -> _ :| ys) = splitAt wscrId a newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys) windows (viewWorkscreen' wscr) XS.put newWorkscreenStorage diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs index 0dca925f..7f4b19f8 100644 --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -1,5 +1,5 @@ -- boilerplate {{{ -{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-} +{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances, ViewPatterns, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-} ----------------------------------------------------------------------------- -- | @@ -78,7 +78,7 @@ modVolume kind n = do where sign | n > 0 = "+" | otherwise = "-" ctlKind = map (\c -> if c == ' ' then '-' else c) kind - parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind + parseKind = unwords . map (\(notEmpty -> c :| cs) -> toUpper c : cs) . words $ kind setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%" listCommand = "pactl list " ++ ctlKind ++ "s" -- }}} @@ -308,7 +308,7 @@ allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp color c = xmobarColor c "" ppFocus s@(S s_) = whenCurrentOn s def { - ppOrder = \(_:_:windowTitle:_) -> [windowTitle], + ppOrder = \case{ _:_:windowTitle:_ -> [windowTitle]; _ -> [] }, ppOutput = appendFile (pipeName "focus" s_) . (++ "\n") } @@ -318,7 +318,7 @@ ppWorkspaces s@(S s_) = marshallPP s def { ppHiddenNoWindows = color dark, ppUrgent = color "red", ppSep = "", - ppOrder = \(wss:_layout:_title:_) -> [wss], + ppOrder = \case{ wss:_layout:_title:_ -> [wss]; _ -> [] }, ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n") } -- }}} diff --git a/XMonad/Hooks/WallpaperSetter.hs b/XMonad/Hooks/WallpaperSetter.hs index 1c297149..12d6132a 100644 --- a/XMonad/Hooks/WallpaperSetter.hs +++ b/XMonad/Hooks/WallpaperSetter.hs @@ -183,9 +183,8 @@ getPicPathsAndWSRects wpconf = do visws <- getVisibleWorkspaces let visscr = S.current winset : S.visible winset visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr - hasPicAndIsVisible (n, mp) = n `elem` visws && isJust mp getRect tag = screenRect $ fromJust $ M.lookup tag visrects - foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths + foundpaths = [ (getRect n, p) | (n, Just p) <- paths, n `elem` visws ] return foundpaths where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y >>= \p -> return (x,p)) wl diff --git a/XMonad/Layout/BinarySpacePartition.hs b/XMonad/Layout/BinarySpacePartition.hs index 6fa8f13e..f829b808 100644 --- a/XMonad/Layout/BinarySpacePartition.hs +++ b/XMonad/Layout/BinarySpacePartition.hs @@ -432,7 +432,8 @@ resizeSplit dir (xsc,ysc) z = case goToBorder dir z of U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb) where sp = value t scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac - Just (Leaf{}, _) -> undefined + Just (Leaf{}, _) -> + undefined -- silence -Wincomplete-uni-patterns (goToBorder/goUp never return a Leaf) -- starting from a leaf, go to node representing a border of the according window goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split) diff --git a/XMonad/Layout/BoringWindows.hs b/XMonad/Layout/BoringWindows.hs index 436a02b0..844cca8c 100644 --- a/XMonad/Layout/BoringWindows.hs +++ b/XMonad/Layout/BoringWindows.hs @@ -37,8 +37,9 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..), LayoutModifier(handleMessOrMaybeModifyIt, redoLayout)) import XMonad(LayoutClass, Message, X, fromMessage, broadcastMessage, sendMessage, windows, withFocused, Window) -import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\)) +import XMonad.Prelude import XMonad.Util.Stack (reverseS) +import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import qualified XMonad.StackSet as W @@ -168,7 +169,7 @@ instance LayoutModifier BoringWindows Window where -- 'Stack' rather than an entire 'StackSet'. focusMaster' :: W.Stack a -> W.Stack a focusMaster' c@(W.Stack _ [] _) = c -focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls +focusMaster' (W.Stack t (l:ls) rs) = W.Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls) swapUp' :: W.Stack a -> W.Stack a swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs) diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 216904e4..58e56301 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -317,7 +317,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window = ew , ev_y_root = ey } | et == buttonPress , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do - let Just (Rectangle dx _ dwh _) = decoRectM + let Rectangle dx _ dwh _ = fromJust decoRectM distFromLeft = ex - fi dx distFromRight = fi dwh - (ex - fi dx) dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight) diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index c37f490b..e2f6364f 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -197,16 +197,16 @@ instance Message GroupsMessage modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a)) -> Groups l l2 a -> Groups l l2 a -modifyGroups f g = let (seed', id:_) = gen (seed g) - defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ +modifyGroups f g = let (seed', ids) = gen (seed g) + defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ in g { groups = fromMaybe defaultGroups . f . Just $ groups g , seed = seed' } modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a))) -> Groups l l2 a -> X (Groups l l2 a) modifyGroupsX f g = do - let (seed', id:_) = gen (seed g) - defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ + let (seed', ids) = gen (seed g) + defaultGroups = fromJust $ singletonZ $ G (ID (head ids) $ baseLayout g) emptyZ g' <- f . Just $ groups g return g { groups = fromMaybe defaultGroups g', seed = seed' } @@ -218,12 +218,12 @@ modifyGroupsX f g = do -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z - (seed', id:_) = gen $ seed g + (seed', ids) = gen $ seed g g' = g { seed = seed' } in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z) >>> filterKeepLast (isJust . gZipper) >>> findNewWindows (W.integrate' z) - >>> addWindows (ID id $ baseLayout g) + >>> addWindows (ID (head ids) $ baseLayout g) >>> focusGroup mf >>> onFocusedZ (onZipper $ focusWindow mf) where filterKeepLast _ Nothing = Nothing @@ -379,10 +379,10 @@ type ModifySpecX = forall l. WithID l Window -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window) applySpec f g = - let (seed', id:ids) = gen $ seed g - g' = flip modifyGroups g $ f (ID id $ baseLayout g) + let (seed', ids) = gen $ seed g + g' = flip modifyGroups g $ f (ID (head ids) $ baseLayout g) >>> toTags - >>> foldr (reID g) ((ids, []), []) + >>> foldr (reID g) ((tail ids, []), []) >>> snd >>> fromTags in if groups g == groups g' @@ -391,10 +391,10 @@ applySpec f g = applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window)) applySpecX f g = do - let (seed', id:ids) = gen $ seed g - g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g) + let (seed', ids) = gen $ seed g + g' <- flip modifyGroupsX g $ f (ID (head ids) $ baseLayout g) >>> fmap toTags - >>> fmap (foldr (reID g) ((ids, []), [])) + >>> fmap (foldr (reID g) ((tail ids, []), [])) >>> fmap snd >>> fmap fromTags return $ if groups g == groups g' diff --git a/XMonad/Layout/Groups/Helpers.hs b/XMonad/Layout/Groups/Helpers.hs index 9ab3df4e..5d750d63 100644 --- a/XMonad/Layout/Groups/Helpers.hs +++ b/XMonad/Layout/Groups/Helpers.hs @@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-} +{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -155,7 +155,7 @@ focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'. -> X () focusHelper f g = withFocused $ \w -> do ws <- getWindows - let (before, _:after) = span (/=w) ws + let (before, tail -> after) = span (/=w) ws let toFocus = g $ after ++ before floats <- getFloats case filter (f . flip elem floats) toFocus of diff --git a/XMonad/Layout/LayoutScreens.hs b/XMonad/Layout/LayoutScreens.hs index bb86ed5b..2d0ff158 100644 --- a/XMonad/Layout/LayoutScreens.hs +++ b/XMonad/Layout/LayoutScreens.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | @@ -22,6 +23,7 @@ module XMonad.Layout.LayoutScreens ( ) where import XMonad +import XMonad.Prelude import qualified XMonad.StackSet as W -- $usage @@ -64,8 +66,9 @@ layoutScreens nscr l = do rtrect <- asks theRoot >>= getWindowRectangle (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } -> - let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs - s:ss = map snd wss + let x = W.workspace v + (xs, ys) = splitAt (nscr - 1) $ map W.workspace vs ++ hs + (notEmpty -> s :| ss) = map snd wss in ws { W.current = W.Screen x 0 (SD s) , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss , W.hidden = ys } @@ -77,8 +80,9 @@ layoutSplitScreen nscr l = do rect <- gets $ screenRect . W.screenDetail . W.current . windowset (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect windows $ \ws@W.StackSet{ W.current = c, W.visible = vs, W.hidden = hs } -> - let (x:xs, ys) = splitAt nscr $ W.workspace c : hs - s:ss = map snd wss + let x = W.workspace c + (xs, ys) = splitAt (nscr - 1) hs + (notEmpty -> s :| ss) = map snd wss in ws { W.current = W.Screen x (W.screen c) (SD s) , W.visible = zipWith3 W.Screen xs [(W.screen c+1) ..] (map SD ss) ++ map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs index 2eb5f72f..b93d656d 100644 --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -330,8 +330,7 @@ borderIncrementBy i (Border t b r l) = let bl = [t,b,r,l] o = maximum bl o' = max i $ negate o - [t',b',r',l'] = map (+o') bl - in Border t' b' r' l' + in Border (t + o') (b + o') (r + o') (l + o') -- | Interface to 'XMonad.Util.Rectangle.withBorder'. withBorder' :: Border -> Integer -> Rectangle -> Rectangle diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index f390da41..a8454a99 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} +{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.SubLayouts @@ -211,7 +211,7 @@ defaultSublMap XConfig{ modMask = modm } = M.fromList ] where -- should these go into XMonad.StackSet? - focusMaster' st = let (f:fs) = W.integrate st + focusMaster' st = let (notEmpty -> f :| fs) = W.integrate st in W.Stack f [] fs swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d @@ -444,7 +444,7 @@ fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate -- outdated) Groups. toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a toGroupStack gs st@(W.Stack f ls rs) = - W.Stack (let Just f' = lu f in f') (mapMaybe lu ls) (mapMaybe lu rs) + W.Stack (fromJust (lu f)) (mapMaybe lu ls) (mapMaybe lu rs) where wset = S.fromList (W.integrate st) dead = W.filter (`S.member` wset) -- drop dead windows or entire groups diff --git a/XMonad/Layout/TallMastersCombo.hs b/XMonad/Layout/TallMastersCombo.hs index 9c13fb1c..aaa2bc0d 100644 --- a/XMonad/Layout/TallMastersCombo.hs +++ b/XMonad/Layout/TallMastersCombo.hs @@ -317,19 +317,10 @@ differentiate [] xs = W.differentiate xs -- | Swap a given window with the focused window. swapWindow :: (Eq a) => a -> Stack a -> Stack a -swapWindow w s = - let upLst = up s - foc = focus s - downLst = down s - in if w `elem` downLst - then let us = takeWhile (/= w) downLst - d:ds = dropWhile (/= w) downLst - us' = reverse us ++ d : upLst - in Stack foc us' ds - else let ds = takeWhile (/= w) upLst - u:us = dropWhile (/= w) upLst - ds' = reverse ds ++ u : downLst - in Stack foc us ds' +swapWindow w (Stack foc upLst downLst) + | (us, d:ds) <- break (== w) downLst = Stack foc (reverse us ++ d : upLst) ds + | (ds, u:us) <- break (== w) upLst = Stack foc us (reverse ds ++ u : downLst) + | otherwise = Stack foc upLst downLst -- | Focus a given window. diff --git a/XMonad/Layout/WindowSwitcherDecoration.hs b/XMonad/Layout/WindowSwitcherDecoration.hs index f046eb73..e2babbea 100644 --- a/XMonad/Layout/WindowSwitcherDecoration.hs +++ b/XMonad/Layout/WindowSwitcherDecoration.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ViewPatterns #-} ---------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.WindowSwitcherDecoration @@ -129,7 +129,7 @@ performWindowSwitching win = -- do a little double check to be sure when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do let allWindowsSwitched = map (switchEntries win selWin) allWindows - let (ls, t:rs) = break (win ==) allWindowsSwitched + let (ls, notEmpty -> t :| rs) = break (win ==) allWindowsSwitched let newStack = S.Stack t (reverse ls) rs windows $ S.modify' $ const newStack where diff --git a/XMonad/Prelude.hs b/XMonad/Prelude.hs index 53ab24d1..2643faf6 100644 --- a/XMonad/Prelude.hs +++ b/XMonad/Prelude.hs @@ -18,6 +18,8 @@ module XMonad.Prelude ( chunksOf, (.:), (!?), + NonEmpty((:|)), + notEmpty, ) where import Control.Applicative as Exports @@ -32,6 +34,9 @@ import Data.Maybe as Exports import Data.Monoid as Exports import Data.Traversable as Exports +import Data.List.NonEmpty (NonEmpty((:|))) +import GHC.Stack + -- | Short for 'fromIntegral'. fi :: (Integral a, Num b) => a -> b fi = fromIntegral @@ -55,3 +60,11 @@ chunksOf i xs = chunk : chunksOf i rest -- > f .: g ≡ (f .) . g ≡ \c d -> f (g c d) (.:) :: (a -> b) -> (c -> d -> a) -> c -> d -> b (.:) = (.) . (.) + +-- | 'Data.List.NonEmpty.fromList' with a better error message. Useful to +-- silence GHC's Pattern match(es) are non-exhaustive warning in places where +-- the programmer knows it's always non-empty, but it's infeasible to express +-- that in the type system. +notEmpty :: HasCallStack => [a] -> NonEmpty a +notEmpty [] = error "unexpected empty list" +notEmpty (x:xs) = x :| xs diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs index c2a666ed..0162fa11 100644 --- a/XMonad/Prompt/FuzzyMatch.hs +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -20,6 +20,7 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage ) where import XMonad.Prelude +import qualified Data.List.NonEmpty as NE -- $usage -- @@ -84,12 +85,12 @@ rankMatch q s = (if null matches then (maxBound, maxBound) else minimum matches, rankMatches :: String -> String -> [(Int, Int)] rankMatches [] _ = [(0, 0)] -rankMatches q s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s +rankMatches (q:qs) s = map (\(l, r) -> (r - l, l)) $ findShortestMatches (q :| qs) s -findShortestMatches :: String -> String -> [(Int, Int)] +findShortestMatches :: NonEmpty Char -> String -> [(Int, Int)] findShortestMatches q s = foldl' extendMatches spans oss - where (os:oss) = map (findOccurrences s) q - spans = [(o, o) | o <- os] + where (os :| oss) = NE.map (findOccurrences s) q + spans = [(o, o) | o <- os] findOccurrences :: String -> Char -> [Int] findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..] diff --git a/XMonad/Util/Rectangle.hs b/XMonad/Util/Rectangle.hs index 978310a5..6f20cc54 100644 --- a/XMonad/Util/Rectangle.hs +++ b/XMonad/Util/Rectangle.hs @@ -30,6 +30,7 @@ module XMonad.Util.Rectangle ) where import XMonad +import XMonad.Prelude (fi) import qualified XMonad.StackSet as W import Data.Ratio @@ -202,6 +203,6 @@ center (Rectangle x y w h) = (cx,cy) -- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5) toRatio :: Rectangle -> Rectangle -> W.RationalRect toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = - let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2] - [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2] - in W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n) + W.RationalRect ((fi x1 - fi x2) / fi w2) + ((fi y1 - fi y2) / fi h2) + (fi w1 / fi w2) (fi h1 / fi h2)