Fix -Wincomplete-uni-patterns warnings

I am not proud of this.

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

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 _ []     []     -> c
-                   Stack t [] (x:rs) -> Stack x [] (t:rs)
+                   Stack t []     (r:rs) -> Stack r [] (t:rs)
-                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
+                   Stack t (l:ls) rs     -> Stack t [] (ys ++ y : rs) where (y :| ys) = NE.reverse (l :| ls)

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
 

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

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
+focusNth' n s | n >= 0, (ls, t:rs) <- splitAt n (integrate s) = Stack t (reverse ls) rs
-                              | otherwise = listToStack n (integrate s)
+              | 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
+  | n < length l = let (nl, notEmpty -> 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)
+  | otherwise    = let (nl, notEmpty -> 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)

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
+    getKey   char = fromJust $ (layoutUsKey   !?) =<< elemIndex char layoutUs
-                    in layoutUsKey !! index
+    getShift char = fromJust $ (layoutUsShift !?) =<< elemIndex char layoutUs
-    getShift char = let Just index = elemIndex char layoutUs
-                    in layoutUsShift !! index
     charToMask char = if [char] == "0" then 0 else shiftMask

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
+    let pivot = maybe op snd stx
-        (~(Just od), pivot) = case stx of
+    when (significant np pivot) $ do
-            Nothing -> (Nothing, op)
+        let d' = dir pivot np
-            Just (d, zp) -> (Just d, zp)
+        when ((fst <$> stx) /= Just d') $ hook d'
-        cont = do
+        io $ writeIORef st (Just (d', np))
-            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
     where
     significant a b = delta a b >= 10
 

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]
+    rotateToR d = fromJust . lookup d . zip [R, D, L, U] . iterate rHalfPiCC
-                  in  foldr (const $ (.) rHalfPiCC) id l
 
     transform = rotateToR dir . translate . toSR
 

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
+    where  (notEmpty -> master :| ws)      = integrate s
-           (revls',t':rs') = splitAt (length ls) (master:f ws)
+           (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))

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

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
+                                , Just mpid <- [lookup ppid pids] ]
-                                , isJust mpid
-                                , let (Just mh) = mpid ]
     case known_window_handlers of
         [] -> idHook
         (mh:_)  -> do

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

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
+    Just w | w `elem` ws ->
-                            in windows $ focusFn y
+        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,

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

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")
     }
 -- }}}

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

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)

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)

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)

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)
+modifyGroups f g = let (seed', ids) = gen (seed g)
-                       defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
+                       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)
+  let (seed', ids) = gen (seed g)
-      defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
+      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
+    let (seed', ids) =  gen $ seed g
-        g' = flip modifyGroups g $ f (ID id $ baseLayout 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
+    let (seed', ids) = gen $ seed g
-    g' <- flip modifyGroupsX g $ f (ID id $ baseLayout 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'

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

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
+           let x = W.workspace v
-               s:ss = map snd wss
+               (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
+           let x = W.workspace c
-               s:ss = map snd wss
+               (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

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 + o') (b + o') (r + o') (l + o')
-    in  Border t' b' r' l'
 
 -- | Interface to 'XMonad.Util.Rectangle.withBorder'.
 withBorder' :: Border -> Integer -> Rectangle -> Rectangle

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

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 =
+swapWindow w (Stack foc upLst downLst)
-  let upLst   = up s
+    | (us, d:ds) <- break (== w) downLst = Stack foc (reverse us ++ d : upLst) ds
-      foc     = focus s
+    | (ds, u:us) <- break (== w)   upLst = Stack foc us (reverse ds ++ u : downLst)
-      downLst = down s
+    | otherwise = Stack foc upLst downLst
-  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'
 
 
 -- | Focus a given window.

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

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

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
+  where (os :| oss) = NE.map (findOccurrences s) q
-        spans    = [(o, o) | o <- os]
+        spans       = [(o, o) | o <- os]
 
 findOccurrences :: String -> Char -> [Int]
 findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]

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]
+    W.RationalRect ((fi x1 - fi x2) / fi w2)
-        [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]
+                   ((fi y1 - fi y2) / fi h2)
-    in  W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)
+                   (fi w1 / fi w2) (fi h1 / fi h2)