From 0cac1f3a53e099e942d3886075fd5d5475db642c Mon Sep 17 00:00:00 2001
From: Artem Pelenitsyn <a.pelenitsyn@gmail.com>
Date: Sun, 15 Oct 2023 18:27:42 +0000
Subject: [PATCH] GHC 9.8 compat: pacify -Wx-partial
---
cabal-install/src/Distribution/Client/Dependency.hs | 6 ++++--
.../Client/Init/NonInteractive/Command.hs | 12 +++++++++---
.../Client/Init/NonInteractive/Heuristics.hs | 6 +++---
cabal-install/src/Distribution/Client/InstallPlan.hs | 10 +++++-----
cabal-install/src/Distribution/Client/Upload.hs | 10 ++++++----
cabal-install/tests/IntegrationTests2.hs | 8 ++++----
.../UnitTests/Distribution/Client/InstallPlan.hs | 3 +--
.../tests/UnitTests/Distribution/Client/Targets.hs | 5 ++++-
cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +-
9 files changed, 37 insertions(+), 25 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
index 544ad59a34..37e0cbdf1e 100644
--- a/cabal-install/src/Distribution/Client/Dependency.hs
+++ b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -67,7 +67,6 @@ module Distribution.Client.Dependency
) where
import Distribution.Client.Compat.Prelude
-import qualified Prelude as Unsafe (head)
import Distribution.Client.Dependency.Types
( PackagesPreferenceDefault (..)
@@ -950,8 +949,11 @@ planPackagesProblems platform cinfo pkgs =
, let packageProblems = configuredPackageProblems platform cinfo pkg
, not (null packageProblems)
]
- ++ [ DuplicatePackageSolverId (Graph.nodeKey (Unsafe.head dups)) dups
+ ++ [ DuplicatePackageSolverId (Graph.nodeKey aDup) dups
| dups <- duplicatesBy (comparing Graph.nodeKey) pkgs
+ , aDup <- case dups of
+ [] -> []
+ (ad : _) -> [ad]
]
data PackageProblem
diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
index 8c37cad96f..7eee9f82f7 100644
--- a/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
+++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Command.hs
@@ -40,7 +40,7 @@ import Distribution.Client.Init.Types
import Distribution.Client.Compat.Prelude hiding (getLine, head, last, putStr, putStrLn)
import Prelude ()
-import Data.List (head, last)
+import Data.List (last)
import qualified Data.List.NonEmpty as NEL
import Distribution.CabalSpecVersion (CabalSpecVersion (..))
@@ -340,12 +340,18 @@ packageTypeHeuristics flags = getPackageType flags $ guessPackageType flags
-- to a default value.
mainFileHeuristics :: Interactive m => InitFlags -> m HsFilePath
mainFileHeuristics flags = do
- appDir <- head <$> appDirsHeuristics flags
+ appDirs <- appDirsHeuristics flags
+ let appDir = case appDirs of
+ [] -> error "impossible: appDirsHeuristics returned empty list of dirs"
+ (appDir' : _) -> appDir'
getMainFile flags . guessMainFile $ appDir
testMainHeuristics :: Interactive m => InitFlags -> m HsFilePath
testMainHeuristics flags = do
- testDir <- head <$> testDirsHeuristics flags
+ testDirs' <- testDirsHeuristics flags
+ let testDir = case testDirs' of
+ [] -> error "impossible: testDirsHeuristics returned empty list of dirs"
+ (testDir' : _) -> testDir'
guessMainFile testDir
initializeTestSuiteHeuristics :: Interactive m => InitFlags -> m Bool
diff --git a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
index 0fe0129d2c..138f968455 100644
--- a/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
+++ b/cabal-install/src/Distribution/Client/Init/NonInteractive/Heuristics.hs
@@ -54,9 +54,9 @@ guessMainFile pkgDir = do
then do
files <- filter isMain <$> listFilesRecursive pkgDir
return $
- if null files
- then defaultMainIs
- else toHsFilePath $ L.head files
+ case files of
+ [] -> defaultMainIs
+ (f : _) -> toHsFilePath f
else return defaultMainIs
-- | Juggling characters around to guess the desired cabal version based on
diff --git a/cabal-install/src/Distribution/Client/InstallPlan.hs b/cabal-install/src/Distribution/Client/InstallPlan.hs
index 1a8042d6ba..46212baacc 100644
--- a/cabal-install/src/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/src/Distribution/Client/InstallPlan.hs
@@ -72,9 +72,9 @@ module Distribution.Client.InstallPlan
, reverseDependencyClosure
) where
-import Distribution.Client.Compat.Prelude hiding (lookup, tail, toList)
+import Distribution.Client.Compat.Prelude hiding (lookup, toList)
import Distribution.Compat.Stack (WithCallStack)
-import Prelude (tail)
+import Prelude ()
import Distribution.Client.Types hiding (BuildOutcomes)
import qualified Distribution.PackageDescription as PD
@@ -757,13 +757,13 @@ failed
-> ([srcpkg], Processing)
failed plan (Processing processingSet completedSet failedSet) pkgid =
assert (pkgid `Set.member` processingSet) $
- assert (all (`Set.notMember` processingSet) (tail newlyFailedIds)) $
- assert (all (`Set.notMember` completedSet) (tail newlyFailedIds)) $
+ assert (all (`Set.notMember` processingSet) (drop 1 newlyFailedIds)) $
+ assert (all (`Set.notMember` completedSet) (drop 1 newlyFailedIds)) $
-- but note that some newlyFailed may already be in the failed set
-- since one package can depend on two packages that both fail and
-- so would be in the rev-dep closure for both.
assert (processingInvariant plan processing') $
- ( map asConfiguredPackage (tail newlyFailed)
+ ( map asConfiguredPackage (drop 1 newlyFailed)
, processing'
)
where
diff --git a/cabal-install/src/Distribution/Client/Upload.hs b/cabal-install/src/Distribution/Client/Upload.hs
index c7abe8b91e..6e96fa0eaf 100644
--- a/cabal-install/src/Distribution/Client/Upload.hs
+++ b/cabal-install/src/Distribution/Client/Upload.hs
@@ -1,7 +1,7 @@
module Distribution.Client.Upload (upload, uploadDoc, report) where
import Distribution.Client.Compat.Prelude
-import qualified Prelude as Unsafe (head, read, tail)
+import qualified Prelude as Unsafe (read)
import Distribution.Client.HttpUtils
( HttpTransport (..)
@@ -155,11 +155,13 @@ uploadDoc verbosity repoCtxt mToken mUsername mPassword isCandidate path = do
break
(== '-')
(reverse (takeFileName path))
- pkgid = reverse $ Unsafe.tail reversePkgid
+ pkgid = reverse $ drop 1 reversePkgid
when
( reverse reverseSuffix /= "docs.tar.gz"
- || null reversePkgid
- || Unsafe.head reversePkgid /= '-'
+ || ( case reversePkgid of
+ [] -> True
+ (c : _) -> c /= '-'
+ )
)
$ dieWithException verbosity ExpectedMatchingFileName
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index bf6e25c5b8..55ea3747b9 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -80,7 +80,6 @@ import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.Options
import Data.Tagged (Tagged(..))
-import qualified Data.List as L
import qualified Data.ByteString as BS
import Distribution.Client.GlobalFlags (GlobalFlags, globalNix)
@@ -2180,9 +2179,10 @@ testConfigOptionComments = do
where
-- | Find lines containing a target string.
findLineWith :: Bool -> String -> String -> String
- findLineWith isComment target text
- | not . null $ findLinesWith isComment target text = removeCommentValue . L.head $ findLinesWith isComment target text
- | otherwise = text
+ findLineWith isComment target text =
+ case findLinesWith isComment target text of
+ [] -> text
+ (l : _) -> removeCommentValue l
findLinesWith :: Bool -> String -> String -> [String]
findLinesWith isComment target
| isComment = filter (isInfixOf (" " ++ target ++ ":")) . lines
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs
index b708ea8030..39c719f2e1 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs
@@ -5,7 +5,6 @@
module UnitTests.Distribution.Client.InstallPlan (tests) where
import Distribution.Client.Compat.Prelude
-import qualified Prelude as Unsafe (tail)
import Distribution.Client.InstallPlan (GenericInstallPlan, IsUnit)
import qualified Distribution.Client.InstallPlan as InstallPlan
@@ -285,7 +284,7 @@ arbitraryAcyclicGraph genNRanks genNPerRank edgeChance = do
nranks <- genNRanks
rankSizes <- replicateM nranks genNPerRank
let rankStarts = scanl (+) 0 rankSizes
- rankRanges = drop 1 (zip rankStarts (Unsafe.tail rankStarts))
+ rankRanges = drop 1 (zip rankStarts (drop 1 rankStarts))
totalRange = sum rankSizes
rankEdges <- traverse (uncurry genRank) rankRanges
return $ buildG (0, totalRange - 1) (concat rankEdges)
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
index 060dbdffe4..ac6d96cc15 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Targets.hs
@@ -43,7 +43,10 @@ tests =
"readUserConstraints"
(uncurry readUserConstraintsTest)
[ -- First example only.
- (head exampleStrs, take 1 exampleUcs)
+
+ ( case exampleStrs of (e : _) -> e; _ -> error "empty examples"
+ , take 1 exampleUcs
+ )
, -- All examples separated by commas.
(intercalate ", " exampleStrs, exampleUcs)
]
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
index e89481f13d..2c54deaa2a 100644
--- a/cabal-testsuite/src/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -1163,7 +1163,7 @@ findDependencyInStore :: FilePath -- ^store dir
-> String -- ^package name prefix
-> IO FilePath -- ^package dir
findDependencyInStore storeDir pkgName = do
- storeDirForGhcVersion <- head <$> listDirectory storeDir
+ (storeDirForGhcVersion : _) <- listDirectory storeDir
packageDirs <- listDirectory (storeDir </> storeDirForGhcVersion)
-- Ideally, we should call 'hashedInstalledPackageId' from 'Distribution.Client.PackageHash'.
-- But 'PackageHashInputs', especially 'PackageHashConfigInputs', is too hard to construct.
--
GitLab