From a53339da10d7d4707f38f052b1bf6b0bf770b5cd Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@well-typed.com>
Date: Fri, 7 Feb 2025 10:11:38 -0500
Subject: [PATCH] hadrian: Drop uses of head/tail
To silence warnings with GHC 9.10
(cherry picked from commit a7e23f01226fb690e0951edfe3c26d0cd96a3843)
(cherry picked from commit 1078f402c0187533bee012589728eb3bd82e2143)
---
hadrian/src/Hadrian/Utilities.hs | 8 ++++++--
hadrian/src/Oracles/ModuleFiles.hs | 10 ++++++----
hadrian/src/Settings/Parser.hs | 13 +++++--------
3 files changed, 17 insertions(+), 14 deletions(-)
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 7d901c46023..ef06209b946 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -138,7 +138,10 @@ unifyPath = toStandard . normaliseEx
-- | Combine paths with a forward slash regardless of platform.
(-/-) :: FilePath -> FilePath -> FilePath
-_ -/- b | isAbsolute b && not (isAbsolute $ tail b) = b
+_ -/- b
+ | isAbsolute b
+ , _:b' <- b
+ , not (isAbsolute b') = b
"" -/- b = b
a -/- b
| last a == '/' = a ++ b
@@ -615,7 +618,8 @@ renderLibrary name lib synopsis = renderBox $
-- | ipsum |
-- \----------/
renderBox :: [String] -> String
-renderBox ls = tail $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot])
+renderBox ls =
+ drop 1 $ concatMap ('\n' :) (boxTop : map renderLine ls ++ [boxBot])
where
-- Minimum total width of the box in characters
minimumBoxWidth = 32
diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs
index 41a3141f652..f42de97af09 100644
--- a/hadrian/src/Oracles/ModuleFiles.hs
+++ b/hadrian/src/Oracles/ModuleFiles.hs
@@ -170,10 +170,12 @@ moduleFilesOracle = void $ do
let pairs = sort $ mainpairs ++ [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]
- unless (null multi) $ do
- let (m, f1, f2) = head multi
- error $ "Module " ++ m ++ " has more than one source file: "
- ++ f1 ++ " and " ++ f2 ++ "."
+
+ case multi of
+ [] -> return ()
+ (m, f1, f2) : _ ->
+ fail $ "Module " ++ m ++ " has more than one source file: "
+ ++ f1 ++ " and " ++ f2 ++ "."
return $ lookupAll modules pairs
-- Optimisation: we discard Haskell files here, because they are never used
diff --git a/hadrian/src/Settings/Parser.hs b/hadrian/src/Settings/Parser.hs
index d93f71ae06e..f1493cd60d9 100644
--- a/hadrian/src/Settings/Parser.hs
+++ b/hadrian/src/Settings/Parser.hs
@@ -184,14 +184,11 @@ instance Match SettingsM where
matchStringSettingsM :: String -> SettingsM ()
matchStringSettingsM s = do
ks <- State.get
- if null ks
- then throwError $ "expected " ++ show s ++ ", got nothing"
- else go (head ks)
-
- where go k
- | k == s = State.modify tail
- | otherwise = throwError $
- "expected " ++ show s ++ ", got " ++ show k
+ case ks of
+ [] -> throwError $ "expected " ++ show s ++ ", got nothing"
+ k:_
+ | k == s -> State.modify (drop 1)
+ | otherwise -> throwError $ "expected " ++ show s ++ ", got " ++ show k
matchOneOfSettingsM :: [SettingsM a] -> SettingsM a
matchOneOfSettingsM acts = StateT $ \k -> do
--
GitLab