Fix partial uses of head

Fixes: https://github.com/xmonad/xmonad-contrib/issues/830
Related: https://github.com/xmonad/xmonad-contrib/pull/836

XMonad/Actions/GridSelect.hs

@@ -97,6 +97,7 @@ import XMonad.Actions.WindowBringer (bringWindow)
 import Text.Printf
 import System.Random (mkStdGen, randomR)
 import Data.Word (Word8)
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 --
@@ -302,14 +303,14 @@ diamondLayer n =
       r  = tr ++ map (\(x,y) -> (y,-x)) tr
   in r ++ map (negate *** negate) r
 
-diamond :: (Enum a, Num a, Eq a) => [(a, a)]
+diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
-diamond = concatMap diamondLayer [0..]
+diamond = fromList $ concatMap diamondLayer [0..]
 
 diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
 diamondRestrict x y originX originY =
   L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
   map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
-  take 1000 $ diamond
+  takeS 1000 $ diamond
 
 findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
 findInElementMap pos = find ((== pos) . fst)
@@ -658,7 +659,7 @@ gridselect gsconfig elements =
                                 originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
                                 originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
                                 coords = diamondRestrict restrictX restrictY originPosX originPosY
-                                s = TwoDState { td_curpos = head coords,
+                                s = TwoDState { td_curpos = NE.head (notEmpty coords),
                                                 td_availSlots = coords,
                                                 td_elements = elements,
                                                 td_gsconfig = gsconfig,

XMonad/Actions/Navigation2D.hs

@@ -66,6 +66,7 @@ import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
 import XMonad.Util.Types
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 -- #Usage#
@@ -883,7 +884,7 @@ swap win winset = W.focusWindow cur
     -- Reconstruct the workspaces' window stacks to reflect the swap.
     newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
     newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
-    newwinset = winset { W.current = head newscrs
+    newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen.
                        , W.visible = drop 1 newscrs
                        }
 

XMonad/Actions/Prefix.hs

@@ -41,6 +41,8 @@ import XMonad.Util.ExtensibleState as XS
 import XMonad.Util.Paste (sendKey)
 import XMonad.Actions.Submap (submapDefaultWithKey)
 import XMonad.Util.EZConfig (readKeySequence)
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty ((<|))
 
 {- $usage
 
@@ -129,7 +131,7 @@ usePrefixArgument :: LayoutClass l Window
                   -> XConfig l
                   -> XConfig l
 usePrefixArgument prefix conf =
-  conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf }
+  conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }
  where
   binding = case readKeySequence conf prefix of
     Just (key :| []) -> key
@@ -141,7 +143,7 @@ useDefaultPrefixArgument :: LayoutClass l Window
                          -> XConfig l
 useDefaultPrefixArgument = usePrefixArgument "C-u"
 
-handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
+handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()
 handlePrefixArg events = do
   ks <- asks keyActions
   logger <- asks (logHook . config)
@@ -162,12 +164,12 @@ handlePrefixArg events = do
               Raw _ -> XS.put $ Numeric x
               Numeric a -> XS.put $ Numeric $ a * 10 + x
               None -> return () -- should never happen
-            handlePrefixArg (key:events)
+            handlePrefixArg (key <| events)
           else do
             prefix <- XS.get
             mapM_ (uncurry sendKey) $ case prefix of
-              Raw a -> replicate a (head events) ++ [key]
+              Raw a -> replicate a (NE.head events) ++ [key]
-              _ -> reverse (key:events)
+              _ -> reverse (key : toList events)
         keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
 
 -- | Turn a prefix-aware X action into an X-action.

XMonad/Actions/ShowText.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.ShowText
@@ -26,7 +27,7 @@ module XMonad.Actions.ShowText
 import Data.Map (Map,empty,insert,lookup)
 import Prelude hiding (lookup)
 import XMonad
-import XMonad.Prelude (All, fi, when)
+import XMonad.Prelude (All, fi, listToMaybe)
 import XMonad.StackSet (current,screen)
 import XMonad.Util.Font (Align(AlignCenter)
                        , initXMF
@@ -87,8 +88,9 @@ handleTimerEvent :: Event -> X All
 handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
     (ShowText m) <- ES.get :: X ShowText
     a <- io $ internAtom dis "XMONAD_TIMER" False
-    when (mtyp == a && not (null d))
+    if | mtyp == a, Just dh <- listToMaybe d ->
-         (whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
+           whenJust (lookup (fromIntegral dh) m) deleteWindow
+       | otherwise -> pure ()
     mempty
 handleTimerEvent _ = mempty
 

XMonad/Actions/SwapPromote.hs

@@ -63,6 +63,7 @@ import qualified XMonad.Util.ExtensibleState    as XS
 import qualified Data.Map                       as M
 import qualified Data.Set                       as S
 import           Control.Arrow
+import qualified Data.List.NonEmpty             as NE
 
 
 -- $usage
@@ -240,7 +241,7 @@ swapApply ignoreFloats swapFunction = do
                 (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
                 (b,s3) = swapFunction pm s2
                 s4 = stackMerge s3 r
-                mh = let w = head . W.integrate $ s3
+                mh = let w = NE.head . notEmpty . W.integrate $ s3
                      in const $ w : delete w ch
             in (b,Just s4,mh)
         (x,y,z) = maybe (False,Nothing,id) swapApply' st

XMonad/Actions/WindowGo.hs

@@ -48,6 +48,8 @@ import XMonad.Operations (windows)
 import XMonad.Prompt.Shell (getBrowser, getEditor)
 import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
 import XMonad.Util.Run (safeSpawnProg)
+import qualified Data.List.NonEmpty as NE
+
 {- $usage
 
 Import the module into your @~\/.xmonad\/xmonad.hs@:
@@ -90,7 +92,10 @@ ifWindows qry f el = withWindowSet $ \wins -> do
 -- | The same as ifWindows, but applies a ManageHook to the first match
 -- instead and discards the other matches
 ifWindow :: Query Bool -> ManageHook -> X () -> X ()
-ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
+ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty)
+-- ifWindows guarantees that the list given to the function is
+-- non-empty. This should really use Data.List.NonEmpty, but, alas,
+-- that would be a breaking change.
 
 {- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
    Presumably this executable is the same one that you were looking for.
@@ -165,7 +170,8 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
         let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws
             -- cannot fail to match
         in windows $ focusFn y
-    _ -> windows . focusFn . head $ ws
+    _ -> windows . focusFn . NE.head . notEmpty $ ws
+         -- ws is non-empty by ifWindows's definition.
 
 -- | Given a function which gets us a String, we try to raise a window with that classname,
 --   or we then interpret that String as a executable name.

XMonad/Actions/Workscreen.hs

@@ -109,5 +109,6 @@ shiftWs a = drop 1 a ++ take 1 a
 -- @WorkscreenId@.
 shiftToWorkscreen :: WorkscreenId -> X ()
 shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
-                              let ws = head . workspaces $ a !! wscrId
+                              case workspaces (a !! wscrId) of
-                              windows $ W.shift ws
+                                []      -> pure ()
+                                (w : _) -> windows $ W.shift w

XMonad/Actions/WorkspaceCursors.hs

@@ -96,9 +96,9 @@ import XMonad.Prelude
 -- | makeCursors requires a nonempty string, and each sublist must be nonempty
 makeCursors ::  [[String]] -> Cursors String
 makeCursors []       = error "Workspace Cursors cannot be empty"
-makeCursors a = concat . reverse <$> foldl addDim x xs
+makeCursors (a : as) = concat . reverse <$> foldl addDim x xs
-    where x = end $ map return $ head a
+    where x = end $ map return a
-          xs = map (map return) $ drop 1 a
+          xs = map (map return) as
           -- this could probably be simplified, but this true:
           -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
           -- the strange order is used because it makes the regular M-1..9

XMonad/Hooks/Minimize.hs

@@ -43,8 +43,10 @@ minimizeEventHook ClientMessageEvent{ev_window = w,
     a_cs <- getAtom "WM_CHANGE_STATE"
 
     when (mt == a_aw) $ maximizeWindow w
-    when (mt == a_cs) $ do
+    when (mt == a_cs) $ case listToMaybe dt of
-      let message = fromIntegral . head $ dt
+      Nothing  -> pure ()
+      Just dth -> do
+        let message = fromIntegral dth
         when (message == normalState) $ maximizeWindow w
         when (message == iconicState) $ minimizeWindow w
 

XMonad/Hooks/Place.hs

@@ -186,14 +186,15 @@ placeHook p = do window <- ask
                         -- spawned. Each of them also needs an associated screen
                         -- rectangle; for hidden workspaces, we use the current
                         -- workspace's screen.
-                      let infos = filter ((window `elem`) . stackContents . S.stack . fst)
+                      let infos = find ((window `elem`) . stackContents . S.stack . fst)
                                      $ [screenInfo $ S.current theWS]
                                         ++ map screenInfo (S.visible theWS)
                                         ++ map (, currentRect) (S.hidden theWS)
 
-                      guard(not $ null infos)
+                      case infos of
-
+                        Nothing   -> empty
-                      let (workspace, screen) = head infos
+                        Just info -> do
+                          let (workspace, screen) = info
                               rs = mapMaybe (`M.lookup` allRs)
                                    $ organizeClients workspace window floats
                               r' = purePlaceWindow p screen rs pointer r

XMonad/Hooks/ServerMode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.ServerMode
@@ -91,11 +92,12 @@ serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
 serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do
   d <- asks display
   atm <- io $ internAtom d key False
-        when (mt == atm && dt /= []) $ do
+  if | mt == atm, Just dth <- listToMaybe dt -> do
-         let atom = fromIntegral (head dt)
+         let atom = fromIntegral dth
          cmd <- io $ getAtomName d atom
          case cmd of
            Just command -> func command
            Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)
+     | otherwise -> pure ()
   return (All True)
 serverModeEventHookF _ _ _ = return (All True)

XMonad/Hooks/StatusBar/PP.hs

@@ -57,6 +57,7 @@ module XMonad.Hooks.StatusBar.PP (
 
 import Control.Monad.Reader
 import Control.DeepSeq
+import qualified Data.List.NonEmpty as NE
 
 import XMonad
 import XMonad.Prelude
@@ -463,8 +464,12 @@ xmobarStrip :: String -> String
 xmobarStrip = converge (xmobarStripTags ["fc","icon","action"])
 
 converge :: (Eq a) => (a -> a) -> a -> a
-converge f a = let xs = iterate f a
+converge f a
-    in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ drop 1 xs
+  = fst . NE.head . notEmpty -- If this function terminates, we will find a match.
+  . dropWhile (uncurry (/=))
+  . zip xs
+  $ drop 1 xs
+ where xs = iterate f a
 
 xmobarStripTags :: [String] -- ^ tags
         -> String -> String -- ^ with all \<tag\>...\</tag\> removed

XMonad/Layout/Combo.hs

@@ -28,7 +28,7 @@ module XMonad.Layout.Combo (
 
 import XMonad hiding (focus)
 import XMonad.Layout.WindowNavigation (MoveWindowToWindow (..))
-import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\))
+import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\), listToMaybe)
 import XMonad.StackSet (Stack (..), Workspace (..), integrate')
 import XMonad.Util.Stack (zipperFocusedAtFirstOf)
 
@@ -124,9 +124,9 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
                          msuper' <- broadcastPrivate m [super]
                          if isJust msuper' || isJust ml1' || isJust ml2'
                             then return $ Just $ C2 f ws2
-                                                 (maybe super head msuper')
+                                                 (fromMaybe super (listToMaybe =<< msuper'))
-                                                 (maybe l1 head ml1')
+                                                 (fromMaybe l1    (listToMaybe =<< ml1'))
-                                                 (maybe l2 head ml2')
+                                                 (fromMaybe l2    (listToMaybe =<< ml2'))
                             else return Nothing
     description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++
                                        description l2 ++" with "++ description super

XMonad/Layout/MultiColumns.hs

@@ -97,7 +97,7 @@ instance LayoutClass MultiCol a where
             where resize Shrink = l { multiColSize = max (-0.5) $ s-ds }
                   resize Expand = l { multiColSize = min 1 $ s+ds }
                   incmastern (IncMasterN x) = l { multiColNWin = take a n ++ [newval] ++ drop 1 r }
-                      where newval =  max 0 $ head r + x
+                      where newval = max 0 $ maybe 0 (x +) (listToMaybe r)
                             r = drop a n
                   n = multiColNWin l
                   ds = multiColDeltaSize l

XMonad/Layout/OneBig.hs

@@ -55,18 +55,20 @@ oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m)
 
 -- | Main layout function
 oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)]
-oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)]
+oneBigLayout (OneBig cx cy) rect stack =
+  let ws = W.integrate stack
+      n  = length ws
+   in case ws of
+    []               -> []
+    (master : other) -> [(master,masterRect)]
                      ++ divideBottom bottomRect bottomWs
                      ++ divideRight rightRect rightWs
-      where ws = W.integrate stack
+     where
-            n = length ws
       ht (Rectangle _ _ _ hh) = hh
       wd (Rectangle _ _ ww _) = ww
       h' = round (fromIntegral (ht rect)*cy)
       w = wd rect
       m = calcBottomWs n w h'
-            master = head ws
-            other  = drop 1 ws
       bottomWs = take m other
       rightWs = drop m other
       masterRect = cmaster n m cx cy rect

XMonad/Layout/TallMastersCombo.hs

@@ -1,5 +1,9 @@
 -- {-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+
 ---------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.TallMastersCombo
@@ -45,7 +49,7 @@ import XMonad hiding (focus, (|||))
 import qualified XMonad.Layout as LL
 import XMonad.Layout.Decoration
 import XMonad.Layout.Simplest (Simplest (..))
-import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust)
+import XMonad.Prelude (delete, find, foldM, fromMaybe, isJust, listToMaybe)
 import XMonad.StackSet (Stack (..), Workspace (..), integrate')
 import qualified XMonad.StackSet as W
 import XMonad.Util.Stack (zipperFocusedAtFirstOf)
@@ -245,14 +249,14 @@ instance (GetFocused l1 Window, GetFocused l2 Window) => LayoutClass (TMSCombine
                return $ mergeSubLayouts  mlayout1 mlayout2 (TMSCombineTwo f w1 w2 (not vsp) nmaster delta frac layout1 layout2) True
     | Just SwapSubMaster <- fromMessage m =
         -- first get the submaster window
-        let subMaster = if null w2 then Nothing else Just $ head w2
+        let subMaster = listToMaybe w2
         in case subMaster of
             Just mw -> do windows $ W.modify' $ swapWindow mw
                           return Nothing
             Nothing -> return Nothing
     | Just FocusSubMaster <- fromMessage m =
         -- first get the submaster window
-        let subMaster = if null w2 then Nothing else Just $ head w2
+        let subMaster = listToMaybe w2
         in case subMaster of
             Just mw -> do windows $ W.modify' $ focusWindow mw
                           return Nothing

XMonad/Prompt.hs

@@ -113,11 +113,13 @@ import           Control.Monad.State
 import           Data.Bifunctor               (bimap)
 import           Data.Bits
 import           Data.IORef
+import qualified Data.List.NonEmpty           as NE
 import qualified Data.Map                     as M
 import           Data.Set                     (fromList, toList)
 import           System.IO
 import           System.IO.Unsafe             (unsafePerformIO)
 import           System.Posix.Files
+import Data.List.NonEmpty (nonEmpty)
 
 -- $usage
 -- For usage examples see "XMonad.Prompt.Shell",
@@ -536,11 +538,11 @@ mkXPrompt t conf compl action = void $ mkXPromptWithReturn t conf compl action
 -- The argument supplied to the action to execute is always the current highlighted item,
 -- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.
 mkXPromptWithModes :: [XPType] -> XPConfig -> X ()
-mkXPromptWithModes modes conf = do
+mkXPromptWithModes [] _ = pure ()
-  let defaultMode = head modes
+mkXPromptWithModes (defaultMode : modes) conf = do
-      modeStack = W.Stack { W.focus = defaultMode -- Current mode
+  let modeStack = W.Stack { W.focus = defaultMode -- Current mode
                           , W.up = []
-                          , W.down = drop 1 modes -- Other modes
+                          , W.down = modes -- Other modes
                           }
       om = XPMultipleModes modeStack
   st' <- mkXPromptImplementation (showXPrompt defaultMode) conf { alwaysHighlight = True } om
@@ -649,9 +651,9 @@ eventLoop handle stopAction = do
                                 ks <- keycodeToKeysym d (ev_keycode ev) 0
                                 return (ks, s, ev)
                         else return (noSymbol, "", ev)
-        l   -> do
+        (l : ls) -> do
-                modify $ \s -> s { eventBuffer = drop 1 l }
+                modify $ \s -> s { eventBuffer = ls }
-                return $ head l
+                return l
     handle (keysym,keystr) event
     stopAction >>= \stop -> unless stop (eventLoop handle stopAction)
 
@@ -785,8 +787,10 @@ handleCompletion dir cs = do
 
           | -- We only have one suggestion, so we need to be a little
             -- bit smart in order to avoid a loop.
-            length cs == 1 =
+            Just (ch :| []) <- nonEmpty cs =
-              if command st == hlCompl then put st else replaceCompletion (head cs)
+              if command st == hlCompl
+              then put st
+              else replaceCompletion ch
 
             -- The current suggestion matches the command, so advance
             -- to the next completion and try again.
@@ -1396,11 +1400,11 @@ moveHistory f = do
 -- starting cursor character is not considered, and the cursor is placed over
 -- the matching character.
 toHeadChar :: Direction1D -> String -> XP ()
-toHeadChar d s = unless (null s) $ do
+toHeadChar _ ""      = pure ()
+toHeadChar d (c : _) = do
     cmd <- gets command
     off <- gets offset
-    let c = head s
+    let off' = (if d == Prev then negate . fst else snd)
-        off' = (if d == Prev then negate . fst else snd)
              . join (***) (maybe 0 (+1) . elemIndex c)
              . (reverse *** drop 1)
              $ splitAt off cmd
@@ -1464,9 +1468,7 @@ redrawWindows
 redrawWindows emptyAction compls = do
   d <- gets dpy
   drawWin
-  case compls of
+  maybe emptyAction redrawComplWin (nonEmpty compls)
-    [] -> emptyAction
-    l  -> redrawComplWin l
   io $ sync d False
  where
   -- | Draw the main prompt window.
@@ -1485,14 +1487,14 @@ redrawWindows emptyAction compls = do
     io $ freePixmap dpy pm
 
 -- | Redraw the completion window, if necessary.
-redrawComplWin ::  [String] -> XP ()
+redrawComplWin ::  NonEmpty String -> XP ()
 redrawComplWin compl = do
   XPS{ showComplWin, complWinDim, complWin } <- get
   nwi <- getComplWinDim compl
   let recreate = do destroyComplWin
                     w <- createComplWin nwi
                     drawComplWin w compl
-  if compl /= [] && showComplWin
+  if showComplWin
      then io (readIORef complWin) >>= \case
             Just w -> case complWinDim of
                         Just wi -> if nwi == wi -- complWinDim did not change
@@ -1566,7 +1568,7 @@ destroyComplWin = do
 
 -- | Given the completions that we would like to show, calculate the
 -- required dimensions for the completion windows.
-getComplWinDim :: [String] -> XP ComplWindowDim
+getComplWinDim :: NonEmpty String -> XP ComplWindowDim
 getComplWinDim compl = do
   XPS{ config = cfg, screen = scr, fontS = fs, dpy, winWidth } <- get
   let -- Height of a single completion row
@@ -1607,7 +1609,7 @@ getComplWinDim compl = do
 
   -- Get font ascent and descent.  Coherence condition: we will print
   -- everything using the same font.
-  (asc, desc) <- io $ textExtentsXMF fs $ head compl
+  (asc, desc) <- io $ textExtentsXMF fs $ NE.head compl
   let yp    = fi $ (ht + fi (asc - desc)) `div` 2 -- y position of the first row
       yRows = take (fi rows) [yp, yp + fi ht ..]  -- y positions of all rows
 
@@ -1617,7 +1619,7 @@ getComplWinDim compl = do
   pure $ ComplWindowDim x y winWidth rowHeight xCols yRows
 
 -- | Draw the completion window.
-drawComplWin :: Window -> [String] -> XP ()
+drawComplWin :: Window -> NonEmpty String -> XP ()
 drawComplWin w entries = do
   XPS{ config, color, dpy, gcon } <- get
   let scr = defaultScreenOfDisplay dpy
@@ -1640,7 +1642,7 @@ printComplEntries
   -> GC
   -> String         -- ^ Default foreground color
   -> String         -- ^ Default background color
-  -> [String]       -- ^ Entries to be printed...
+  -> NonEmpty String -- ^ Entries to be printed...
   -> ComplWindowDim -- ^ ...into a window of this size
   -> XP ()
 printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do
@@ -1662,7 +1664,7 @@ printComplEntries dpy drw gc fc bc entries ComplWindowDim{ cwCols, cwRows } = do
  where
   -- | Create the completion matrix to be printed.
   complMat :: [[String]]
-    = chunksOf (length cwRows) (take (length cwCols * length cwRows) entries)
+    = chunksOf (length cwRows) (take (length cwCols * length cwRows) (NE.toList entries))
 
   -- | Find the column and row indexes in which a string appears.
   -- If the string is not in the matrix, the indices default to @(0, 0)@.
@@ -1808,7 +1810,8 @@ uniqSort = toList . fromList
 -- immediately next to each other.
 deleteAllDuplicates, deleteConsecutive :: [String] -> [String]
 deleteAllDuplicates = nub
-deleteConsecutive = map head . group
+deleteConsecutive = map (NE.head . notEmpty) . group
+-- The elements of group will always have at least one element.
 
 newtype HistoryMatches = HistoryMatches (IORef ([String],Maybe (W.Stack String)))
 

XMonad/Prompt/OrgMode.hs

@@ -67,6 +67,7 @@ import XMonad.Util.XSelection (getSelection)
 import XMonad.Util.Run
 
 import Control.DeepSeq (deepseq)
+import qualified Data.List.NonEmpty as NE (head)
 import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian)
 #if MIN_VERSION_time(1, 9, 0)
 import Data.Time.Format.ISO8601 (iso8601Show)
@@ -525,7 +526,7 @@ pInput inp = (`runParser` inp) . choice $
    where
     go :: String -> Parser String
     go consumed = do
-      str  <- munch  (/= head ptn)
+      str  <- munch  (/= NE.head (notEmpty ptn))
       word <- munch1 (/= ' ')
       bool go pure (word == ptn) $ consumed <> str <> word
 

XMonad/Util/ExclusiveScratchpads.hs

@@ -46,6 +46,7 @@ import XMonad.Actions.TagWindows (addTag,delTag)
 import XMonad.Hooks.ManageHelpers (doRectFloat,isInProperty)
 
 import qualified XMonad.StackSet as W
+import qualified Data.List.NonEmpty as NE
 
 -- $usage
 --
@@ -174,8 +175,8 @@ resetExclusiveSp xs = withFocused $ \w -> whenX (isScratchpad xs w) $ do
   let ys = filterM (flip runQuery w . query) xs
 
   unlessX (null <$> ys) $ do
-    mh <- head . map hook <$> ys  -- ys /= [], so `head` is fine
+    mh <- NE.head . notEmpty . map hook <$> ys  -- ys /= [], so `head` is fine
-    n  <- head . map name <$> ys  -- same
+    n  <- NE.head . notEmpty . map name <$> ys  -- same
 
     (windows . appEndo <=< runQuery mh) w
     hideOthers xs n

XMonad/Util/Image.hs

@@ -22,7 +22,8 @@ module XMonad.Util.Image
     ) where
 
 import XMonad
-import XMonad.Util.Font (stringToPixel,fi)
+import XMonad.Prelude
+import XMonad.Util.Font (stringToPixel)
 
 -- | Placement of the icon in the title bar
 data Placement = OffsetLeft Int Int   -- ^ An exact amount of pixels from the upper left corner
@@ -42,7 +43,7 @@ data Placement = OffsetLeft Int Int   -- ^ An exact amount of pixels from the up
 
 -- | Gets the ('width', 'height') of an image
 imageDims :: [[Bool]] -> (Int, Int)
-imageDims img = (length (head img), length img)
+imageDims img = (length (fromMaybe [] (listToMaybe img)), length img)
 
 -- | Return the 'x' and 'y' positions inside a 'Rectangle' to start drawing
 --   the image given its 'Placement'

XMonad/Util/Timer.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Util.Timer
@@ -20,9 +21,10 @@ module XMonad.Util.Timer
     , TimerId
     ) where
 
-import XMonad
 import Control.Concurrent
 import Data.Unique
+import XMonad
+import XMonad.Prelude (listToMaybe)
 
 -- $usage
 -- This module can be used to setup a timer to handle deferred events.
@@ -53,7 +55,6 @@ handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
 handleTimer ti ClientMessageEvent{ev_message_type = mt, ev_data = dt} action = do
   d <- asks display
   a <- io $ internAtom d "XMONAD_TIMER" False
-  if mt == a && dt /= [] && fromIntegral (head dt) == ti
+  if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action
-     then action
+     | otherwise -> return Nothing
-     else return Nothing
 handleTimer _ _ _ = return Nothing