Assorted fixes to avoid Data.List.{head,tail}

10 files changed, 27 insertions, 20 deletions

diff --git a/libraries/base/GHC/Fingerprint.hs b/libraries/base/GHC/Fingerprint.hs
index 06c4e856e0..cb5e3456c9 100644
--- a/libraries/base/GHC/Fingerprint.hs
+++ b/libraries/base/GHC/Fingerprint.hs
@@ -43,7 +43,7 @@ fingerprint0 = Fingerprint 0 0
 fingerprintFingerprints :: [Fingerprint] -> Fingerprint
 fingerprintFingerprints fs = unsafeDupablePerformIO $
   withArrayLen fs $ \len p ->
-    fingerprintData (castPtr p) (len * sizeOf (head fs))
+    fingerprintData (castPtr p) (len * sizeOf (undefined :: Fingerprint))
 
 fingerprintData :: Ptr Word8 -> Int -> IO Fingerprint
 fingerprintData buf len =
diff --git a/libraries/ghc-boot/GHC/BaseDir.hs b/libraries/ghc-boot/GHC/BaseDir.hs
index 862e7739d2..66ed339e32 100644
--- a/libraries/ghc-boot/GHC/BaseDir.hs
+++ b/libraries/ghc-boot/GHC/BaseDir.hs
@@ -16,7 +16,7 @@ module GHC.BaseDir where
 
 import Prelude -- See Note [Why do we import Prelude here?]
 
-import Data.List (stripPrefix)
+import Data.List (stripPrefix, uncons)
 import System.FilePath
 
 -- Windows
@@ -37,7 +37,7 @@ expandTopDir = expandPathVar "topdir"
 expandPathVar :: String -> FilePath -> String -> String
 expandPathVar var value str
   | Just str' <- stripPrefix ('$':var) str
-  , null str' || isPathSeparator (head str')
+  , maybe True (isPathSeparator . fst) (uncons str')
   = value ++ expandPathVar var value str'
 expandPathVar var value (x:xs) = x : expandPathVar var value xs
 expandPathVar _ _ [] = []
diff --git a/libraries/ghc-boot/GHC/Data/ShortText.hs b/libraries/ghc-boot/GHC/Data/ShortText.hs
index 929b65b481..477d2b9a6d 100644
--- a/libraries/ghc-boot/GHC/Data/ShortText.hs
+++ b/libraries/ghc-boot/GHC/Data/ShortText.hs
@@ -47,6 +47,7 @@ import Control.DeepSeq as DeepSeq
 import Data.Binary
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Short.Internal as SBS
+import Data.List (uncons)
 import GHC.Exts
 import GHC.IO
 import GHC.Utils.Encoding
@@ -100,9 +101,9 @@ splitFilePath st = DeepSeq.force $ map (ShortText . SBS.toShort) $ B8.splitWith
 -- question, this may or may not be the actual first character in the string due to Unicode
 -- non-printable characters.
 head :: ShortText -> Char
-head st
-  | SBS.null $ contents st = error "head: Empty ShortText"
-  | otherwise              = Prelude.head $ unpack st
+head st = case uncons (unpack st) of
+  Nothing      -> error "head: Empty ShortText"
+  Just (hd, _) -> hd
 
 -- | /O(n)/ The 'stripPrefix' function takes two 'ShortText's and returns 'Just' the remainder of
 -- the second iff the first is its prefix, and otherwise Nothing.
diff --git a/libraries/ghc-boot/GHC/Utils/Encoding.hs b/libraries/ghc-boot/GHC/Utils/Encoding.hs
index 183d29946f..044ce06d55 100644
--- a/libraries/ghc-boot/GHC/Utils/Encoding.hs
+++ b/libraries/ghc-boot/GHC/Utils/Encoding.hs
@@ -145,8 +145,10 @@ encode_ch '%'  = "zv"
 encode_ch c    = encode_as_unicode_char c
 
 encode_as_unicode_char :: Char -> EncodedString
-encode_as_unicode_char c = 'z' : if isDigit (head hex_str) then hex_str
-                                                           else '0':hex_str
+encode_as_unicode_char c = 'z' : case hex_str of
+  hd : _
+    | isDigit hd -> hex_str
+  _ -> '0' : hex_str
   where hex_str = showHex (ord c) "U"
   -- ToDo: we could improve the encoding here in various ways.
   -- eg. strings of unicode characters come out as 'z1234Uz5678U', we
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index d92a2f0fbb..ce5aee21fb 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -299,8 +299,8 @@ sizeOfEntryCode tables_next_to_code
   | otherwise = do
      code' <- mkJumpToAddr undefined
      pure $ case code' of
-       Left  xs -> sizeOf (head xs) * length xs
-       Right xs -> sizeOf (head xs) * length xs
+       Left  (xs :: [Word8])  -> sizeOf (undefined :: Word8)  * length xs
+       Right (xs :: [Word32]) -> sizeOf (undefined :: Word32) * length xs
 
 -- Note: Must return proper pointer for use in a closure
 newExecConItbl :: Bool -> StgInfoTable -> ByteString -> IO (FunPtr ())
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 0c74758fa6..37de9717b0 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -1133,8 +1133,9 @@ addrToByteArrayName = helper
   where
     helper :: HasCallStack => Name
     helper =
-      case head (getCallStack ?callStack) of
-        (_, SrcLoc{..}) -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"
+      case getCallStack ?callStack of
+        [] -> error "addrToByteArrayName: empty call stack"
+        (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"
 
 
 addrToByteArray :: Int -> Addr# -> ByteArray
diff --git a/libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs b/libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
index 368f081772..a1e414aa3d 100644
--- a/libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
+++ b/libraries/template-haskell/vendored-filepath/System/FilePath/Posix.hs
@@ -600,7 +600,7 @@ hasTrailingPathSeparator x = isPathSeparator (last x)
 
 hasLeadingPathSeparator :: FilePath -> Bool
 hasLeadingPathSeparator "" = False
-hasLeadingPathSeparator x = isPathSeparator (head x)
+hasLeadingPathSeparator (hd : _) = isPathSeparator hd
 
 
 -- | Add a trailing file path separator if one is not already present.
@@ -824,7 +824,7 @@ makeRelative root path
             where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
 
         -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
+        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = drop 1 x
         dropAbs x = dropDrive x
 
         takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
diff --git a/libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs b/libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
index 52a0cd86c2..2884d06595 100644
--- a/libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
+++ b/libraries/template-haskell/vendored-filepath/System/FilePath/Windows.hs
@@ -600,7 +600,7 @@ hasTrailingPathSeparator x = isPathSeparator (last x)
 
 hasLeadingPathSeparator :: FilePath -> Bool
 hasLeadingPathSeparator "" = False
-hasLeadingPathSeparator x = isPathSeparator (head x)
+hasLeadingPathSeparator (hd : _) = isPathSeparator hd
 
 
 -- | Add a trailing file path separator if one is not already present.
@@ -824,7 +824,7 @@ makeRelative root path
             where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
 
         -- on windows, need to drop '/' which is kind of absolute, but not a drive
-        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x
+        dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = drop 1 x
         dropAbs x = dropDrive x
 
         takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 7bc14094d1..5e91d905e6 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -390,7 +390,7 @@ runit verbosity cli nonopts = do
 
         splitFields fields = unfoldr splitComma (',':fields)
           where splitComma "" = Nothing
-                splitComma fs = Just $ break (==',') (tail fs)
+                splitComma (_ : fs) = Just $ break (==',') fs
 
         -- | Parses a glob into a predicate which tests if a string matches
         -- the glob.  Returns Nothing if the string in question is not a glob.
@@ -1962,10 +1962,11 @@ checkUnitId ipi db_stack update = do
 
 checkDuplicates :: PackageDBStack -> InstalledPackageInfo
                 -> Bool -> Bool-> Validate ()
-checkDuplicates db_stack pkg multi_instance update = do
+checkDuplicates [] _ _ _ = pure ()
+checkDuplicates (hd : _) pkg multi_instance update = do
   let
         pkgid = mungedId pkg
-        pkgs  = packages (head db_stack)
+        pkgs  = packages hd
   --
   -- Check whether this package id already exists in this DB
   --
diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs
index da62f4a364..a5d93fccce 100644
--- a/utils/hpc/HpcUtils.hs
+++ b/utils/hpc/HpcUtils.hs
@@ -13,8 +13,10 @@ dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x:r) []
 grabHpcPos :: Map.Map Int String -> HpcPos -> String
 grabHpcPos hsMap srcspan = 
          case lns of
+           [] -> error "grabHpcPos: invalid source span"
            [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
-           _ -> let lns1 = drop (c1 -1) (head lns) : tail lns
+           hd : tl ->
+                let lns1 = drop (c1 -1) hd : tl
                     lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
                  in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
   where (l1,c1,l2,c2) = fromHpcPos srcspan