From 13599ae83c91c96debaa10e2fa8276cc8e7cc986 Mon Sep 17 00:00:00 2001 From: Dale Wijnand <dale.wijnand@gmail.com> Date: Tue, 5 Nov 2019 09:53:28 +0000 Subject: [PATCH] Replace Prelude.head/tail/init/last with NonEmpty --- .../Distribution/Backpack/ComponentsGraph.hs | 5 +- Cabal/Distribution/Compat/Prelude.hs | 3 +- .../Distribution/PackageDescription/Check.hs | 10 ++-- Cabal/Distribution/Simple.hs | 6 +-- Cabal/Distribution/Simple/Build.hs | 9 ++-- Cabal/Distribution/Simple/Configure.hs | 28 ++++++---- Cabal/Distribution/Simple/GHC.hs | 14 ++--- Cabal/Distribution/Simple/GHCJS.hs | 11 ++-- Cabal/Distribution/Simple/HaskellSuite.hs | 11 ++-- Cabal/Distribution/Simple/Program/HcPkg.hs | 42 +++++++-------- Cabal/Distribution/Simple/Program/Run.hs | 14 ++--- Cabal/Distribution/Simple/UHC.hs | 4 +- Cabal/Distribution/Types/VersionInterval.hs | 8 +-- Cabal/Distribution/Types/VersionRange.hs | 7 ++- Cabal/Distribution/Utils/Generic.hs | 54 +++++++++++++++---- Cabal/Language/Haskell/Extension.hs | 4 +- Cabal/tests/UnitTests/Distribution/Version.hs | 19 ++++--- .../Distribution/Client/CmdInstall.hs | 7 +-- cabal-install/Distribution/Client/CmdRepl.hs | 6 ++- .../Distribution/Client/HttpUtils.hs | 9 ++-- .../Distribution/Client/Init/Heuristics.hs | 8 +-- cabal-install/Distribution/Client/Outdated.hs | 12 +++-- .../Distribution/Client/SetupWrapper.hs | 7 ++- .../Deprecated/ViewAsFieldDescr.hs | 7 +-- cabal-install/main/Main.hs | 13 +++-- .../Distribution/Solver/Modular/DSL.hs | 9 ++-- 26 files changed, 197 insertions(+), 130 deletions(-) diff --git a/Cabal/Distribution/Backpack/ComponentsGraph.hs b/Cabal/Distribution/Backpack/ComponentsGraph.hs index a3b9737ab5..aab90dd6e0 100644 --- a/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -8,7 +8,7 @@ module Distribution.Backpack.ComponentsGraph ( componentCycleMsg ) where -import Prelude (head) +import Prelude () import Distribution.Compat.Prelude import Distribution.Package @@ -19,6 +19,7 @@ import Distribution.Types.ComponentRequestedSpec import Distribution.Types.UnqualComponentName import Distribution.Compat.Graph (Graph, Node(..)) import qualified Distribution.Compat.Graph as Graph +import Distribution.Utils.Generic import Distribution.Pretty (pretty) import Text.PrettyPrint @@ -94,4 +95,4 @@ componentCycleMsg cnames = text $ "Components in the package depend on each other in a cyclic way:\n " ++ intercalate " depends on " [ "'" ++ showComponentName cname ++ "'" - | cname <- cnames ++ [head cnames] ] + | cname <- cnames ++ maybeToList (safeHead cnames) ] diff --git a/Cabal/Distribution/Compat/Prelude.hs b/Cabal/Distribution/Compat/Prelude.hs index 0c8f15e131..e71ec19acd 100644 --- a/Cabal/Distribution/Compat/Prelude.hs +++ b/Cabal/Distribution/Compat/Prelude.hs @@ -64,6 +64,7 @@ module Distribution.Compat.Prelude ( -- * Data.List.NonEmpty NonEmpty((:|)), foldl1, foldr1, + head, tail, last, init, -- * Data.Foldable Foldable, foldMap, foldr, @@ -154,7 +155,7 @@ import Data.Char import Data.List (intercalate, intersperse, isPrefixOf, isSuffixOf, nub, nubBy, sort, sortBy, unfoldr) -import Data.List.NonEmpty (NonEmpty((:|))) +import Data.List.NonEmpty (NonEmpty((:|)), head, tail, init, last) import Data.Maybe import Data.String (IsString (..)) import Data.Int diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 8774d6dc93..81d6ece979 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -34,7 +34,7 @@ module Distribution.PackageDescription.Check ( ) where import Distribution.Compat.Prelude -import Prelude (last, init) +import Prelude () import Control.Monad (mapM) import Data.List (group) @@ -56,7 +56,7 @@ import Distribution.Types.CondTree import Distribution.Types.ExeDependency import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName -import Distribution.Utils.Generic (isAscii) +import Distribution.Utils.Generic (isAscii, safeInit) import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension @@ -1591,8 +1591,8 @@ checkPackageVersions pkg = boundedAbove :: VersionRange -> Bool boundedAbove vr = case asVersionIntervals vr of - [] -> True -- this is the inconsistent version range. - intervals -> case last intervals of + [] -> True -- this is the inconsistent version range. + (x:xs) -> case last (x:|xs) of (_, UpperBound _ _) -> True (_, NoUpperBound ) -> False @@ -2145,7 +2145,7 @@ checkTarPath path Right (_:_) -> Just noSplit where -- drop the '/' between the name and prefix: - remainder = init h : rest + remainder = safeInit h : rest where nameMax, prefixMax :: Int diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 065409b140..d6e221f323 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -57,7 +57,7 @@ module Distribution.Simple ( import Control.Exception (try) -import Prelude (head) +import Prelude () import Distribution.Compat.Prelude -- local @@ -524,9 +524,9 @@ sanityCheckHookedBuildInfo verbosity ++ "but the package does not have a library." sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes) - | not (null nonExistant) + | exe1 : _ <- nonExistant = die' verbosity $ "The buildinfo contains info for an executable called '" - ++ prettyShow (head nonExistant) ++ "' but the package does not have a " + ++ prettyShow exe1 ++ "' but the package does not have a " ++ "executable with that name." where pkgExeNames = nub (map exeName (executables pkg_descr)) diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 24c9f6a4d1..17c6066da0 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -28,8 +28,9 @@ module Distribution.Simple.Build ( writeAutogenFiles, ) where -import Prelude (head, init) +import Prelude () import Distribution.Compat.Prelude +import Distribution.Utils.Generic import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec @@ -154,7 +155,9 @@ repl pkg_descr lbi flags suffixes args = do target <- readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of -- This seems DEEPLY questionable. - [] -> return (head (allTargetsInBuildOrder' pkg_descr lbi)) + [] -> case allTargetsInBuildOrder' pkg_descr lbi of + (target:_) -> return target + [] -> die' verbosity $ "Failed to determine target." [target] -> return target _ -> die' verbosity $ "The 'repl' command does not support multiple targets at once." let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target] @@ -180,7 +183,7 @@ repl pkg_descr lbi flags suffixes args = do componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity buildComponent verbosity NoFlag pkg_descr lbi' suffixes comp clbi distPref - | subtarget <- init componentsToBuild ] + | subtarget <- safeInit componentsToBuild ] -- REPL for target components let clbi = targetCLBI target diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 19df06f89f..5f439fa229 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -54,7 +54,7 @@ module Distribution.Simple.Configure , platformDefines, ) where -import Prelude (head, tail, last) +import qualified Prelude (tail) import Distribution.Compat.Prelude import Distribution.Compiler @@ -102,6 +102,7 @@ import Distribution.Backpack.DescribeUnitId import Distribution.Backpack.PreExistingComponent import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour) import Distribution.Backpack.Id +import Distribution.Utils.Generic import Distribution.Utils.LogProgress import qualified Distribution.Simple.GHC as GHC @@ -112,6 +113,7 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite import Control.Exception ( ErrorCall, Exception, evaluate, throw, throwIO, try ) import Control.Monad ( forM, forM_ ) +import Data.List.NonEmpty ( nonEmpty ) import Distribution.Compat.Binary ( decodeOrFailIO, encode ) import Distribution.Compat.Directory ( listDirectory ) import Data.ByteString.Lazy ( ByteString ) @@ -1313,18 +1315,21 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap -- It's an external package, normal situation do_external_external = - case PackageIndex.lookupDependency installedIndex dep_pkgname vr of - [] -> Left (DependencyNotExists dep_pkgname) - pkgs -> Right $ head $ snd $ last pkgs + case pickLastIPI $ PackageIndex.lookupDependency installedIndex dep_pkgname vr of + Nothing -> Left (DependencyNotExists dep_pkgname) + Just pkg -> Right pkg -- It's an internal library, being looked up externally do_external_internal :: LibraryName -> Either FailedDependency InstalledPackageInfo do_external_internal ln = - case PackageIndex.lookupInternalDependency installedIndex + case pickLastIPI $ PackageIndex.lookupInternalDependency installedIndex (packageName pkgid) vr ln of - [] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) - pkgs -> Right $ head $ snd $ last pkgs + Nothing -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) + Just pkg -> Right pkg + + pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo + pickLastIPI pkgs = safeHead . snd . last =<< nonEmpty pkgs reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () @@ -1773,7 +1778,7 @@ checkForeignDeps pkg lbi verbosity = findOffendingHdr = ifBuildsWith allHeaders ccArgs (return Nothing) - (go . tail . inits $ allHeaders) + (go . Prelude.tail . inits $ allHeaders) -- inits always contains at least [] where go [] = return Nothing -- cannot happen go (hdrs:hdrsInits) = @@ -1782,8 +1787,9 @@ checkForeignDeps pkg lbi verbosity = -- If that works, try compiling too (ifBuildsWith hdrs ccArgs (go hdrsInits) - (return . Just . Right . last $ hdrs)) - (return . Just . Left . last $ hdrs) + (return . fmap Right . safeLast $ hdrs)) + (return . fmap Left . safeLast $ hdrs) + cppArgs = "-E":commonCppArgs -- preprocess only ccArgs = "-c":commonCcArgs -- don't try to link @@ -2004,7 +2010,7 @@ checkRelocatable verbosity pkg lbi -- database to which the package is installed are relative to the -- prefix of the package depsPrefixRelative = do - pkgr <- GHC.pkgRoot verbosity lbi (last (withPackageDB lbi)) + pkgr <- GHC.pkgRoot verbosity lbi (registrationPackageDB (withPackageDB lbi)) traverse_ (doCheck pkgr) ipkgs where doCheck pkgr ipkg diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 4bb36a5d92..d5057d1432 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -69,7 +69,7 @@ module Distribution.Simple.GHC ( GhcImplInfo(..) ) where -import Prelude (head, tail) +import Prelude () import Distribution.Compat.Prelude import qualified Distribution.Simple.GHC.Internal as Internal @@ -1074,24 +1074,26 @@ exeMainModuleName Executable{buildInfo = bnfo} = -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. decodeMainIsArg :: String -> Maybe ModuleName decodeMainIsArg arg - | not (null main_fn) && isLower (head main_fn) + | headOf main_fn isLower -- The arg looked like "Foo.Bar.baz" = Just (ModuleName.fromString main_mod) - | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" = Just (ModuleName.fromString arg) | otherwise -- The arg looked like "baz" = Nothing where + headOf :: String -> (Char -> Bool) -> Bool + headOf str pred' = any pred' (safeHead str) + (main_mod, main_fn) = splitLongestPrefix arg (== '.') splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) splitLongestPrefix str pred' | null r_pre = (str, []) - | otherwise = (reverse (tail r_pre), reverse r_suf) - -- 'tail' drops the char satisfying 'pred' + | otherwise = (reverse (safeTail r_pre), reverse r_suf) + -- 'safeTail' drops the char satisfying 'pred' where (r_suf, r_pre) = break pred' (reverse str) - -- | A collection of: -- * C input files -- * C++ input files diff --git a/Cabal/Distribution/Simple/GHCJS.hs b/Cabal/Distribution/Simple/GHCJS.hs index b8cff1176d..83713e5d94 100644 --- a/Cabal/Distribution/Simple/GHCJS.hs +++ b/Cabal/Distribution/Simple/GHCJS.hs @@ -37,7 +37,7 @@ module Distribution.Simple.GHCJS ( GhcImplInfo(..) ) where -import Prelude (head) +import Prelude () import Distribution.Compat.Prelude import qualified Distribution.Simple.GHC.Internal as Internal @@ -926,21 +926,24 @@ exeMainModuleName Executable{buildInfo = bnfo} = -- https://github.com/haskell/cabal/pull/4539#discussion_r118981753. decodeMainIsArg :: String -> Maybe ModuleName decodeMainIsArg arg - | not (null main_fn) && isLower (head main_fn) + | headOf main_fn isLower -- The arg looked like "Foo.Bar.baz" = Just (ModuleName.fromString main_mod) - | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + | headOf arg isUpper -- The arg looked like "Foo" or "Foo.Bar" = Just (ModuleName.fromString arg) | otherwise -- The arg looked like "baz" = Nothing where + headOf :: String -> (Char -> Bool) -> Bool + headOf str pred' = any pred' (safeHead str) + (main_mod, main_fn) = splitLongestPrefix arg (== '.') splitLongestPrefix :: String -> (Char -> Bool) -> (String,String) splitLongestPrefix str pred' | null r_pre = (str, []) | otherwise = (reverse (safeTail r_pre), reverse r_suf) - -- 'tail' drops the char satisfying 'pred' + -- 'safeTail' drops the char satisfying 'pred' where (r_suf, r_pre) = break pred' (reverse str) diff --git a/Cabal/Distribution/Simple/HaskellSuite.hs b/Cabal/Distribution/Simple/HaskellSuite.hs index 54ab1781e2..3f4010f8c8 100644 --- a/Cabal/Distribution/Simple/HaskellSuite.hs +++ b/Cabal/Distribution/Simple/HaskellSuite.hs @@ -3,7 +3,7 @@ module Distribution.Simple.HaskellSuite where -import Prelude (last, init) +import Prelude () import Distribution.Compat.Prelude import Data.Either (partitionEithers) @@ -26,6 +26,7 @@ import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo import Distribution.System (Platform) import Distribution.Compat.Exception +import Distribution.Utils.Generic import Language.Haskell.Extension import Distribution.Simple.Program.Builtin @@ -92,15 +93,15 @@ hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version) hstoolVersion = findProgramVersion "--hspkg-version" id numericVersion :: Verbosity -> FilePath -> IO (Maybe Version) -numericVersion = findProgramVersion "--compiler-version" (last . words) +numericVersion = findProgramVersion "--compiler-version" (fromMaybe "" . safeLast . words) getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version) getCompilerVersion verbosity prog = do output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"] let parts = words output - name = concat $ init parts -- there shouldn't be any spaces in the name anyway - versionStr = last parts + name = concat $ safeInit parts -- there shouldn't be any spaces in the name anyway + versionStr = fromMaybe "" $ safeLast parts version <- maybe (die' verbosity "haskell-suite: couldn't determine compiler version") return $ simpleParsec versionStr @@ -217,7 +218,7 @@ registerPackage verbosity progdb packageDbs installedPkgInfo = do runProgramInvocation verbosity $ (programInvocation hspkg - ["update", packageDbOpt $ last packageDbs]) + ["update", packageDbOpt $ registrationPackageDB packageDbs]) { progInvokeInput = Just $ showInstalledPackageInfo installedPkgInfo } initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO () diff --git a/Cabal/Distribution/Simple/Program/HcPkg.hs b/Cabal/Distribution/Simple/Program/HcPkg.hs index c3146b4129..fa60101606 100644 --- a/Cabal/Distribution/Simple/Program/HcPkg.hs +++ b/Cabal/Distribution/Simple/Program/HcPkg.hs @@ -42,8 +42,8 @@ module Distribution.Simple.Program.HcPkg ( listInvocation, ) where -import Prelude (last) -import Distribution.Compat.Prelude +import Prelude () +import Distribution.Compat.Prelude hiding (init) import Data.Either (partitionEithers) import qualified Data.List.NonEmpty as NE @@ -162,7 +162,7 @@ register hpi verbosity packagedbs pkgInfo registerOptions -- | registerMultiInstance registerOptions , recacheMultiInstance hpi - = do let pkgdb = last packagedbs + = do let pkgdb = registrationPackageDB packagedbs writeRegistrationFileDirectly verbosity hpi pkgdb pkgInfo recache hpi verbosity pkgdb @@ -386,9 +386,7 @@ registerInvocation hpi verbosity packagedbs pkgInfo registerOptions = | otherwise = "register" args file = [cmdname, file] - ++ (if noPkgDbStack hpi - then [packageDbOpts hpi (last packagedbs)] - else packageDbStackOpts hpi packagedbs) + ++ packageDbStackOpts hpi packagedbs ++ [ "--enable-multi-instance" | registerMultiInstance registerOptions ] ++ [ "--force-files" @@ -423,9 +421,7 @@ describeInvocation :: HcPkgInfo -> Verbosity -> PackageDBStack -> PackageId describeInvocation hpi verbosity packagedbs pkgid = programInvocation (hcPkgProgram hpi) $ ["describe", prettyShow pkgid] - ++ (if noPkgDbStack hpi - then [packageDbOpts hpi (last packagedbs)] - else packageDbStackOpts hpi packagedbs) + ++ packageDbStackOpts hpi packagedbs ++ verbosityOpts hpi verbosity hideInvocation :: HcPkgInfo -> Verbosity -> PackageDB -> PackageId @@ -460,19 +456,21 @@ listInvocation hpi _verbosity packagedb = packageDbStackOpts :: HcPkgInfo -> PackageDBStack -> [String] -packageDbStackOpts hpi dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) -> "--global" - : "--user" - : map specific dbs - (GlobalPackageDB:dbs) -> "--global" - : ("--no-user-" ++ packageDbFlag hpi) - : map specific dbs - _ -> ierror - where - specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db - specific _ = ierror - ierror :: a - ierror = error ("internal error: unexpected package db stack: " ++ show dbstack) +packageDbStackOpts hpi dbstack + | noPkgDbStack hpi = [packageDbOpts hpi (registrationPackageDB dbstack)] + | otherwise = case dbstack of + (GlobalPackageDB:UserPackageDB:dbs) -> "--global" + : "--user" + : map specific dbs + (GlobalPackageDB:dbs) -> "--global" + : ("--no-user-" ++ packageDbFlag hpi) + : map specific dbs + _ -> ierror + where + specific (SpecificPackageDB db) = "--" ++ packageDbFlag hpi ++ "=" ++ db + specific _ = ierror + ierror :: a + ierror = error ("internal error: unexpected package db stack: " ++ show dbstack) packageDbFlag :: HcPkgInfo -> String packageDbFlag hpi diff --git a/Cabal/Distribution/Simple/Program/Run.hs b/Cabal/Distribution/Simple/Program/Run.hs index dca40c03b8..2525601d37 100644 --- a/Cabal/Distribution/Simple/Program/Run.hs +++ b/Cabal/Distribution/Simple/Program/Run.hs @@ -27,13 +27,14 @@ module Distribution.Simple.Program.Run ( getEffectiveEnvironment, ) where -import Prelude (last, init) +import Prelude () import Distribution.Compat.Prelude import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.Verbosity import Distribution.Compat.Environment +import Distribution.Utils.Generic import qualified Data.Map as Map import System.FilePath @@ -243,13 +244,14 @@ multiStageProgramInvocation simple (initial, middle, final) args = chunkSize = maxCommandLineSize - fixedArgSize in case splitChunks chunkSize args of - [] -> [ simple ] + [] -> [ simple ] - [c] -> [ simple `appendArgs` c ] + [c] -> [ simple `appendArgs` c ] - (c:cs) -> [ initial `appendArgs` c ] - ++ [ middle `appendArgs` c'| c' <- init cs ] - ++ [ final `appendArgs` c'| let c' = last cs ] + (c:c2:cs) | (xs, x) <- unsnocNE (c2:|cs) -> + [ initial `appendArgs` c ] + ++ [ middle `appendArgs` c'| c' <- xs ] + ++ [ final `appendArgs` x ] where appendArgs :: ProgramInvocation -> [String] -> ProgramInvocation diff --git a/Cabal/Distribution/Simple/UHC.hs b/Cabal/Distribution/Simple/UHC.hs index 183cb65618..8ac068e6a0 100644 --- a/Cabal/Distribution/Simple/UHC.hs +++ b/Cabal/Distribution/Simple/UHC.hs @@ -22,7 +22,7 @@ module Distribution.Simple.UHC ( buildLib, buildExe, installLib, registerPackage, inplacePackageDbPath ) where -import Prelude (last) +import Prelude () import Distribution.Compat.Prelude import Distribution.InstalledPackageInfo @@ -277,7 +277,7 @@ registerPackage -> InstalledPackageInfo -> IO () registerPackage verbosity comp progdb packageDbs installedPkgInfo = do - dbdir <- case last packageDbs of + dbdir <- case registrationPackageDB packageDbs of GlobalPackageDB -> getGlobalPackageDir verbosity progdb UserPackageDB -> getUserPackageDir SpecificPackageDB dir -> return dir diff --git a/Cabal/Distribution/Types/VersionInterval.hs b/Cabal/Distribution/Types/VersionInterval.hs index 3226c59cc6..ebb2178fc5 100644 --- a/Cabal/Distribution/Types/VersionInterval.hs +++ b/Cabal/Distribution/Types/VersionInterval.hs @@ -21,7 +21,7 @@ module Distribution.Types.VersionInterval ( Bound(..), ) where -import Prelude (tail) +import Prelude () import Distribution.Compat.Prelude import Control.Exception (assert) @@ -118,9 +118,9 @@ invariant (VersionIntervals intervals) = all validInterval intervals doesNotTouch' ((_,u), (l',_)) = doesNotTouch u l' adjacentIntervals :: [(VersionInterval, VersionInterval)] - adjacentIntervals - | null intervals = [] - | otherwise = zip intervals (tail intervals) + adjacentIntervals = case intervals of + [] -> [] + (_:tl) -> zip intervals tl checkInvariant :: VersionIntervals -> VersionIntervals checkInvariant is = assert (invariant is) is diff --git a/Cabal/Distribution/Types/VersionRange.hs b/Cabal/Distribution/Types/VersionRange.hs index 82410d386f..e069d8eb88 100644 --- a/Cabal/Distribution/Types/VersionRange.hs +++ b/Cabal/Distribution/Types/VersionRange.hs @@ -39,7 +39,8 @@ module Distribution.Types.VersionRange ( import Distribution.Compat.Prelude import Distribution.Types.Version import Distribution.Types.VersionRange.Internal -import Prelude (last, init) +import Distribution.Utils.Generic +import Prelude () -- | Fold over the basic syntactic structure of a 'VersionRange'. -- @@ -130,7 +131,9 @@ withinRange v = foldVersionRange -- | @since 2.2 wildcardUpperBound :: Version -> Version wildcardUpperBound = alterVersion $ - \lowerBound -> init lowerBound ++ [last lowerBound + 1] + \lowerBound -> case unsnoc lowerBound of + Nothing -> [] + Just (xs, x) -> xs ++ [x + 1] isWildcardRange :: Version -> Version -> Bool isWildcardRange ver1 ver2 = check (versionNumbers ver1) (versionNumbers ver2) diff --git a/Cabal/Distribution/Utils/Generic.hs b/Cabal/Distribution/Utils/Generic.hs index 692dadfa32..11da74d198 100644 --- a/Cabal/Distribution/Utils/Generic.hs +++ b/Cabal/Distribution/Utils/Generic.hs @@ -74,13 +74,15 @@ module Distribution.Utils.Generic ( unfoldrM, spanMaybe, breakMaybe, + unsnoc, + unsnocNE, -- * FilePath stuff isAbsoluteOnAnyPlatform, isRelativeOnAnyPlatform, ) where -import Prelude (head, tail, last, init) +import Prelude () import Distribution.Compat.Prelude import Distribution.Utils.String @@ -283,11 +285,11 @@ normaliseLineEndings ( c :s) = c : normaliseLineEndings s -- -- Example: -- --- >>> tail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] +-- >>> safeTail $ Data.List.dropWhileEnd (<3) [undefined, 5, 4, 3, 2, 1] -- *** Exception: Prelude.undefined -- ... -- --- >>> tail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1] +-- >>> safeTail $ dropWhileEndLE (<3) [undefined, 5, 4, 3, 2, 1] -- [5,4,3] -- -- >>> take 3 $ Data.List.dropWhileEnd (<3) [5, 4, 3, 2, 1, undefined] @@ -368,23 +370,24 @@ listUnionRight a b = ordNubRight (filter (`Set.notMember` bSet) a) ++ b -- | A total variant of 'head'. safeHead :: [a] -> Maybe a -safeHead [] = Nothing -safeHead xs = Just (head xs) +safeHead [] = Nothing +safeHead (x:_) = Just x -- | A total variant of 'tail'. safeTail :: [a] -> [a] -safeTail [] = [] -safeTail xs = tail xs +safeTail [] = [] +safeTail (_:xs) = xs -- | A total variant of 'last'. safeLast :: [a] -> Maybe a -safeLast [] = Nothing -safeLast xs = Just (last xs) +safeLast [] = Nothing +safeLast (x:xs) = Just (foldl (\_ a -> a) x xs) -- | A total variant of 'init'. safeInit :: [a] -> [a] -safeInit [] = [] -safeInit xs = init xs +safeInit [] = [] +safeInit [_] = [] +safeInit (x:xs) = x : safeInit xs equating :: Eq a => (b -> a) -> b -> b -> Bool equating p x y = p x == p y @@ -472,6 +475,35 @@ unfoldrM f = go where Nothing -> return [] Just (a, b') -> liftM (a :) (go b') +-- | The opposite of 'snoc', which is the reverse of 'cons' +-- +-- Example: +-- +-- >>> unsnoc [1, 2, 3] +-- Just ([1,2],3) +-- +-- >>> unsnoc [] +-- Nothing +-- +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc (x:xs) = Just (unsnocNE (x :| xs)) + +-- | Like 'unsnoc', but for 'NonEmpty' so without the 'Maybe' +-- +-- Example: +-- +-- >>> unsnocNE (1 :| [2, 3]) +-- ([1,2],3) +-- +-- >>> unsnocNE (1 :| []) +-- ([],1) +-- +unsnocNE :: NonEmpty a -> ([a], a) +unsnocNE (x:|xs) = go x xs where + go y [] = ([], y) + go y (z:zs) = let ~(ws, w) = go z zs in (y : ws, w) + -- ------------------------------------------------------------ -- * FilePath stuff -- ------------------------------------------------------------ diff --git a/Cabal/Language/Haskell/Extension.hs b/Cabal/Language/Haskell/Extension.hs index 87a53a631a..8dff715ae7 100644 --- a/Cabal/Language/Haskell/Extension.hs +++ b/Cabal/Language/Haskell/Extension.hs @@ -23,7 +23,7 @@ module Language.Haskell.Extension ( classifyExtension, ) where -import Prelude (head) +import qualified Prelude (head) import Distribution.Compat.Prelude import Data.Array (Array, accumArray, bounds, Ix(inRange), (!)) @@ -889,6 +889,6 @@ classifyKnownExtension string@(c : _) knownExtensionTable :: Array Char [(String, KnownExtension)] knownExtensionTable = accumArray (flip (:)) [] ('A', 'Z') - [ (head str, (str, extension)) + [ (Prelude.head str, (str, extension)) -- assume KnownExtension's Show returns a non-empty string | extension <- [toEnum 0 ..] , let str = show extension ] diff --git a/Cabal/tests/UnitTests/Distribution/Version.hs b/Cabal/tests/UnitTests/Distribution/Version.hs index 351338c07e..4551145e84 100644 --- a/Cabal/tests/UnitTests/Distribution/Version.hs +++ b/Cabal/tests/UnitTests/Distribution/Version.hs @@ -6,12 +6,13 @@ module UnitTests.Distribution.Version (versionTests) where import Distribution.Compat.Prelude.Internal -import Prelude (tail, last, init) +import Prelude () import Distribution.Version import Distribution.Types.VersionRange.Internal import Distribution.Parsec (simpleParsec) import Distribution.Pretty +import Distribution.Utils.Generic import Data.Typeable (typeOf) import Math.NumberTheory.Logarithms (intLog2) @@ -317,7 +318,9 @@ prop_withinVersion v v' = withinRange v' (withinVersion v) == (v' >= v && v' < upper v) where - upper = alterVersion $ \numbers -> init numbers ++ [last numbers + 1] + upper = alterVersion $ \numbers -> case unsnoc numbers of + Nothing -> [] + Just (xs, x) -> xs ++ [x + 1] prop_foldVersionRange :: VersionRange -> Property prop_foldVersionRange range = @@ -342,7 +345,9 @@ prop_foldVersionRange range = expandVR (VersionRangeParens v) = expandVR v expandVR v = v - upper = alterVersion $ \numbers -> init numbers ++ [last numbers + 1] + upper = alterVersion $ \numbers -> case unsnoc numbers of + Nothing -> [] + Just (xs, x) -> xs ++ [x + 1] prop_isAnyVersion1 :: VersionRange -> Version -> Property prop_isAnyVersion1 range version = @@ -362,11 +367,11 @@ prop_isNoVersion range version = prop_isSpecificVersion1 :: VersionRange -> NonEmptyList Version -> Property prop_isSpecificVersion1 range (NonEmpty versions) = isJust version && not (null versions') ==> - allEqual (fromJust version : versions') + allEqual (fromJust version) versions' where - version = isSpecificVersion range - versions' = filter (`withinRange` range) versions - allEqual xs = and (zipWith (==) xs (tail xs)) + version = isSpecificVersion range + versions' = filter (`withinRange` range) versions + allEqual x xs = and (zipWith (==) (x:xs) xs) prop_isSpecificVersion2 :: VersionRange -> Property prop_isSpecificVersion2 range = diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 9d0f7d5f20..ff6e29f616 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -18,7 +18,7 @@ module Distribution.Client.CmdInstall ( establishDummyProjectBaseContext ) where -import Prelude (head) +import Prelude () import Distribution.Client.Compat.Prelude import Distribution.Compat.Directory ( doesPathExist ) @@ -116,7 +116,7 @@ import Distribution.Simple.Utils , withTempDirectory, createDirectoryIfMissingVerbose , ordNub ) import Distribution.Utils.Generic - ( writeFileAtomic ) + ( safeHead, writeFileAtomic ) import Distribution.Deprecated.Text ( simpleParse ) import Distribution.Pretty @@ -679,7 +679,8 @@ installLibraries verbosity buildCtx compiler if supportsPkgEnvFiles $ getImplInfo compiler then do let - getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst)) + getLatest :: PackageName -> [InstalledPackageInfo] + getLatest = (=<<) (maybeToList . safeHead . snd) . take 1 . sortBy (comparing (Down . fst)) . PI.lookupPackageName installedIndex globalLatest = concat (getLatest <$> globalPackages) diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 1e950c088b..a3586aaf93 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -17,7 +17,7 @@ module Distribution.Client.CmdRepl ( selectComponentTarget ) where -import Prelude (head) +import Prelude () import Distribution.Client.Compat.Prelude import Distribution.Compat.Lens @@ -91,6 +91,8 @@ import Distribution.Types.VersionRange ( anyVersion ) import Distribution.Deprecated.Text ( display ) +import Distribution.Utils.Generic + ( safeHead ) import Distribution.Verbosity ( Verbosity, normal, lessVerbose ) import Distribution.Simple.Utils @@ -256,7 +258,7 @@ replAction ( configFlags, configExFlags, installFlags targets <- validatedTargets elaboratedPlan targetSelectors let - (unitId, _) = head $ Map.toList targets + Just (unitId, _) = safeHead $ Map.toList targets originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId oci = OriginalComponentInfo unitId originalDeps Just pkgId = packageId <$> InstallPlan.lookup elaboratedPlan unitId diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index 9bba06c96f..eed05ac2a2 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -14,8 +14,9 @@ module Distribution.Client.HttpUtils ( isOldHackageURI ) where -import Prelude (head) +import Prelude () import Distribution.Client.Compat.Prelude hiding (Proxy (..)) +import Distribution.Utils.Generic import Network.HTTP ( Request (..), Response (..), RequestMethod (..) @@ -38,7 +39,7 @@ import qualified Paths_cabal_install (version) import Distribution.Verbosity (Verbosity) import Distribution.Pretty (prettyShow) import Distribution.Simple.Utils - ( die', info, warn, debug, notice, writeFileAtomic + ( die', info, warn, debug, notice , copyFileVerbose, withTempFile ) import Distribution.Client.Utils ( withTempFileName ) @@ -305,8 +306,8 @@ configureTransport verbosity extraPath Nothing = do [ (name, transport) | (name, _, _, mkTrans) <- supportedTransports , transport <- maybeToList (mkTrans progdb) ] - -- there's always one because the plain one is last and never fails - let (name, transport) = head availableTransports + let (name, transport) = + fromMaybe ("plain-http", plainHttpTransport) (safeHead availableTransports) debug verbosity $ "Selected http transport implementation: " ++ name return transport { transportManuallySelected = False } diff --git a/cabal-install/Distribution/Client/Init/Heuristics.hs b/cabal-install/Distribution/Client/Init/Heuristics.hs index b0611c0973..e890d2415a 100644 --- a/cabal-install/Distribution/Client/Init/Heuristics.hs +++ b/cabal-install/Distribution/Client/Init/Heuristics.hs @@ -20,9 +20,9 @@ module Distribution.Client.Init.Heuristics ( knownCategories, ) where -import Prelude (head, last) +import Prelude () import Distribution.Client.Compat.Prelude -import Distribution.Utils.Generic (safeHead, safeTail) +import Distribution.Utils.Generic (safeHead, safeTail, safeLast) import Distribution.Parsec (simpleParsec) import Distribution.Simple.Setup (Flag(..), flagToMaybe) @@ -87,7 +87,7 @@ guessMainFileCandidates flags = do -- | Guess the package name based on the given root directory. guessPackageName :: FilePath -> IO P.PackageName -guessPackageName = liftM (P.mkPackageName . repair . last . splitDirectories) +guessPackageName = liftM (P.mkPackageName . repair . fromMaybe "" . safeLast . splitDirectories) . tryCanonicalizePath where -- Treat each span of non-alphanumeric characters as a hyphen. Each @@ -346,7 +346,7 @@ maybeReadFile f = do -- |Get list of categories used in Hackage. NOTE: Very slow, needs to be cached knownCategories :: SourcePackageDb -> [String] knownCategories (SourcePackageDb sourcePkgIndex _) = nubSet - [ cat | pkg <- map head (allPackagesByName sourcePkgIndex) + [ cat | pkg <- maybeToList . safeHead =<< (allPackagesByName sourcePkgIndex) , let catList = (PD.category . PD.packageDescription . packageDescription) pkg , cat <- splitString ',' catList ] diff --git a/cabal-install/Distribution/Client/Outdated.hs b/cabal-install/Distribution/Client/Outdated.hs index accc3be576..7450ed7e58 100644 --- a/cabal-install/Distribution/Client/Outdated.hs +++ b/cabal-install/Distribution/Client/Outdated.hs @@ -13,7 +13,7 @@ module Distribution.Client.Outdated ( outdated , ListOutdatedSettings(..), listOutdated ) where -import Prelude (last) +import Prelude () import Distribution.Client.Config import Distribution.Client.IndexUtils as IndexUtils import Distribution.Client.Compat.Prelude @@ -26,6 +26,7 @@ import Distribution.Client.Types import Distribution.Solver.Types.PackageConstraint import Distribution.Solver.Types.PackageIndex import Distribution.Client.Sandbox.PackageEnvironment +import Distribution.Utils.Generic import Distribution.Package (PackageName, packageVersion) import Distribution.PackageDescription (allBuildDepends) @@ -204,7 +205,8 @@ listOutdated deps pkgIndex (ListOutdatedSettings ignorePred minorPred) = relaxMinor :: VersionRange -> VersionRange relaxMinor vr = let vis = asVersionIntervals vr - (LowerBound v0 _,upper) = last vis - in case upper of - NoUpperBound -> vr - UpperBound _v1 _ -> majorBoundVersion v0 + in maybe vr relax (safeLast vis) + where relax (LowerBound v0 _, upper) = + case upper of + NoUpperBound -> vr + UpperBound _v1 _ -> majorBoundVersion v0 diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index f8e5e4ca34..79dccc6679 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -22,7 +22,7 @@ module Distribution.Client.SetupWrapper ( defaultSetupScriptOptions, ) where -import Prelude (head) +import Prelude () import Distribution.Client.Compat.Prelude import qualified Distribution.Make as Make @@ -81,6 +81,8 @@ import Distribution.Client.JobControl ( Lock, criticalSection ) import Distribution.Simple.Setup ( Flag(..) ) +import Distribution.Utils.Generic + ( safeHead ) import Distribution.Simple.Utils ( die', debug, info, infoNoWrap , cabalVersion, tryFindPackageDesc, comparing @@ -726,7 +728,8 @@ getExternalSetupMethod verbosity options pkg bt = do ++ "' requires Cabal library version " ++ display (useCabalVersion options) ++ " but no suitable version is installed." - pkgs -> let ipkginfo = head . snd . bestVersion fst $ pkgs + pkgs -> let ipkginfo = fromMaybe err $ safeHead . snd . bestVersion fst $ pkgs + err = error "Distribution.Client.installedCabalVersion: empty version list" in return (packageVersion ipkginfo ,Just . IPI.installedComponentId $ ipkginfo, options'') diff --git a/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs b/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs index f175b3b09d..88357ac876 100644 --- a/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs +++ b/cabal-install/Distribution/Deprecated/ViewAsFieldDescr.hs @@ -3,8 +3,9 @@ module Distribution.Deprecated.ViewAsFieldDescr ( ) where import Distribution.Client.Compat.Prelude hiding (get) -import Prelude (head) +import Prelude () +import qualified Data.List.NonEmpty as NE import Distribution.Parsec (parsec) import Distribution.Pretty import Distribution.ReadE (parsecToReadE) @@ -19,10 +20,10 @@ import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError) viewAsFieldDescr :: OptionField a -> FieldDescr a viewAsFieldDescr (OptionField _n []) = error "Distribution.command.viewAsFieldDescr: unexpected" -viewAsFieldDescr (OptionField n dd) = FieldDescr n get set +viewAsFieldDescr (OptionField n (d:dd)) = FieldDescr n get set where - optDescr = head $ sortBy cmp dd + optDescr = head $ NE.sortBy cmp (d:|dd) cmp :: OptDescr a -> OptDescr a -> Ordering ReqArg{} `cmp` ReqArg{} = EQ diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 7d4efc7c36..5b4e9d468c 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -67,7 +67,7 @@ import Distribution.Simple.Setup , configAbsolutePaths ) -import Prelude (head, tail) +import Prelude () import Distribution.Solver.Compat.Prelude hiding (get) import Distribution.Client.SetupWrapper @@ -236,9 +236,9 @@ main' = do mainWorker :: [String] -> IO () mainWorker args = do - hasScript <- if not (null args) - then CmdRun.validScript (head args) - else return False + maybeScriptAndArgs <- case args of + [] -> return Nothing + (h:tl) -> (\b -> if b then Just (h:|tl) else Nothing) <$> CmdRun.validScript h topHandler $ case commandsRun (globalCommand commands) commands args of @@ -253,9 +253,8 @@ mainWorker args = do -> printNumericVersion CommandHelp help -> printCommandHelp help CommandList opts -> printOptionsList opts - CommandErrors errs - | hasScript -> CmdRun.handleShebang (head args) (tail args) - | otherwise -> printErrors errs + CommandErrors errs -> maybe (printErrors errs) go maybeScriptAndArgs where + go (script:|scriptArgs) = CmdRun.handleShebang script scriptArgs CommandReadyToGo action -> do globalFlags' <- updateSandboxConfigFileFlag globalFlags action globalFlags' diff --git a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs index 3b7f4acf37..7a656c80cc 100644 --- a/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/solver-dsl/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -37,8 +37,9 @@ module UnitTests.Distribution.Solver.Modular.DSL ( , mkVersionRange ) where -import Prelude (head) +import Prelude () import Distribution.Solver.Compat.Prelude +import Distribution.Utils.Generic -- base import Control.Arrow (second) @@ -719,13 +720,13 @@ extractInstallPlan :: CI.SolverInstallPlan.SolverInstallPlan extractInstallPlan = catMaybes . map confPkg . CI.SolverInstallPlan.toList where confPkg :: CI.SolverInstallPlan.SolverPlanPackage -> Maybe (String, Int) - confPkg (CI.SolverInstallPlan.Configured pkg) = Just $ srcPkg pkg + confPkg (CI.SolverInstallPlan.Configured pkg) = srcPkg pkg confPkg _ = Nothing - srcPkg :: SolverPackage UnresolvedPkgLoc -> (String, Int) + srcPkg :: SolverPackage UnresolvedPkgLoc -> Maybe (String, Int) srcPkg cpkg = let C.PackageIdentifier pn ver = packageInfoId (solverPkgSource cpkg) - in (C.unPackageName pn, head (C.versionNumbers ver)) + in (\vn -> (C.unPackageName pn, vn)) <$> safeHead (C.versionNumbers ver) {------------------------------------------------------------------------------- Auxiliary -- GitLab