Fix partial uses of head

Fixes: #830
Related: #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 = concatMap diamondLayer [0..]
+diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
+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]
-              _ -> reverse (key:events)
+              Raw a -> replicate a (NE.head events) ++ [key]
+              _ -> 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))
-         (whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
+    if | mtyp == a, Just dh <- listToMaybe d ->
+           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,8 +241,8 @@ 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
-                     in  const $ w : delete w ch
+                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
     -- Any floating master windows will be added to the history when 'windows'

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
-                              windows $ W.shift ws
+                              case workspaces (a !! wscrId) of
+                                []      -> pure ()
+                                (w : _) -> windows $ W.shift w

XMonad/Actions/WorkspaceCursors.hs

@@ -95,10 +95,10 @@ 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
-    where x = end $ map return $ head a
-          xs = map (map return) $ drop 1 a
+makeCursors []       = error "Workspace Cursors cannot be empty"
+makeCursors (a : as) = concat . reverse <$> foldl addDim x xs
+    where x = end $ map return 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,10 +43,12 @@ minimizeEventHook ClientMessageEvent{ev_window = w,
     a_cs <- getAtom "WM_CHANGE_STATE"
 
     when (mt == a_aw) $ maximizeWindow w
-    when (mt == a_cs) $ do
-      let message = fromIntegral . head $ dt
-      when (message == normalState) $ maximizeWindow w
-      when (message == iconicState) $ minimizeWindow w
+    when (mt == a_cs) $ case listToMaybe dt of
+      Nothing  -> pure ()
+      Just dth -> do
+        let message = fromIntegral dth
+        when (message == normalState) $ maximizeWindow w
+        when (message == iconicState) $ minimizeWindow w
 
     return (All True)
 minimizeEventHook _ = return (All True)

XMonad/Hooks/Place.hs

@@ -186,21 +186,22 @@ 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)
-
-                      let (workspace, screen) = head infos
-                          rs = mapMaybe (`M.lookup` allRs)
-                               $ organizeClients workspace window floats
-                          r' = purePlaceWindow p screen rs pointer r
-                          newRect = r2rr screen r'
-                          newFloats = M.insert window newRect (S.floating theWS)
-
-                      return $ theWS { S.floating = newFloats }
+                      case infos of
+                        Nothing   -> empty
+                        Just info -> do
+                          let (workspace, screen) = info
+                              rs = mapMaybe (`M.lookup` allRs)
+                                   $ organizeClients workspace window floats
+                              r' = purePlaceWindow p screen rs pointer r
+                              newRect = r2rr screen r'
+                              newFloats = M.insert window newRect (S.floating theWS)
+
+                          return $ theWS { S.floating = newFloats }
 
 
 placeWindow :: Placement -> Window

XMonad/Hooks/ServerMode.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.ServerMode
@@ -89,13 +90,14 @@ serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_
 --
 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
-         let atom = fromIntegral (head dt)
+  d <- asks display
+  atm <- io $ internAtom d key False
+  if | mt == atm, Just dth <- listToMaybe dt -> do
+         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)
-        return (All True)
+           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
-    in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ drop 1 xs
+converge f a
+  = 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')
-                                                 (maybe l1 head ml1')
-                                                 (maybe l2 head ml2')
+                                                 (fromMaybe super (listToMaybe =<< msuper'))
+                                                 (fromMaybe l1    (listToMaybe =<< ml1'))
+                                                 (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,23 +55,25 @@ 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)]
-                                      ++ divideBottom bottomRect bottomWs
-                                      ++ divideRight rightRect rightWs
-      where ws = W.integrate stack
-            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
-            bottomRect = cbottom cy rect
-            rightRect  = cright cx cy rect
+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
+      ht (Rectangle _ _ _ hh) = hh
+      wd (Rectangle _ _ ww _) = ww
+      h' = round (fromIntegral (ht rect)*cy)
+      w = wd rect
+      m = calcBottomWs n w h'
+      bottomWs = take m other
+      rightWs = drop m other
+      masterRect = cmaster n m cx cy rect
+      bottomRect = cbottom cy rect
+      rightRect  = cright cx cy rect
 
 -- | Calculate how many windows must be placed at bottom
 calcBottomWs :: Int -> Dimension -> Dimension -> Int