Commit dabd9d98 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺 Committed by GitHub

Make `PackageName` type opaque (#3896)

When looking at heap-profiles of `cabal-install`, the `(:)` constructor
stands out as the most-allocated constructor on the heap.

Having to handle 10k+ package names contributes to the allocation
numbers, especially on 64bit archs where ASCII `String`s have a 24 byte
per character footprint.

This commit is a preparatory commit to pave the way for changing
`PackageName`'s internal representation to something like
`ShortByteString` (which is essentially a thin wrapper around primitive
`ByteArray#`s which themselves have have an overhead of 2 words + one
byte per ASCII character rounded up to nearest word) which would allow
to reduce the memory footprint by a full order of magnitude, as well as
reduce pointer chasing and GC overhead.
parent 2ccfce17
......@@ -133,7 +133,7 @@ instance IsNode InstalledPackageInfo where
emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId = PackageIdentifier (PackageName "") (Version [] []),
sourcePackageId = PackageIdentifier (mkPackageName "") (Version [] []),
installedUnitId = mkUnitId "",
compatPackageKey = "",
license = UnspecifiedLicense,
......
......@@ -18,7 +18,7 @@
module Distribution.Package (
-- * Package ids
PackageName(..),
PackageName, unPackageName, mkPackageName,
PackageIdentifier(..),
PackageId,
......@@ -65,16 +65,39 @@ import Distribution.ModuleName
import Text.PrettyPrint ((<+>), text)
newtype PackageName = PackageName { unPackageName :: String }
-- | A package name.
--
-- Use 'mkPackageName' and 'unPackageName' to convert from/to a
-- 'String'.
--
-- This type is opaque since @Cabal-2.0@
--
-- @since 2.0
newtype PackageName = PackageName String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
-- | Convert 'PackageName' to 'String'
unPackageName :: PackageName -> String
unPackageName (PackageName s) = s
-- | Construct a 'PackageName' from a 'String'
--
-- 'mkPackageName' is the inverse to 'unPackageName'
--
-- Note: No validations are performed to ensure that the resulting
-- 'PackageName' is valid
--
-- @since 2.0
mkPackageName :: String -> PackageName
mkPackageName = PackageName
instance Binary PackageName
instance Text PackageName where
disp (PackageName n) = Disp.text n
disp = Disp.text . unPackageName
parse = do
ns <- Parse.sepBy1 component (Parse.char '-')
return (PackageName (intercalate "-" ns))
return (mkPackageName (intercalate "-" ns))
where
component = do
cs <- Parse.munch1 isAlphaNum
......
......@@ -166,7 +166,7 @@ checkSanity :: PackageDescription -> [PackageCheck]
checkSanity pkg =
catMaybes [
check (null . (\(PackageName n) -> n) . packageName $ pkg) $
check (null . unPackageName . packageName $ pkg) $
PackageBuildImpossible "No 'name' field."
, check (null . versionBranch . packageVersion $ pkg) $
......@@ -536,7 +536,7 @@ checkFields pkg =
, name `elem` map display knownLanguages ]
testedWithImpossibleRanges =
[ Dependency (PackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr
| (compiler, vr) <- testedWith pkg
, isNoVersion vr ]
......@@ -1199,7 +1199,7 @@ checkCabalVersion pkg =
, usesNewVersionRangeSyntax vr ]
testedWithVersionRangeExpressions =
[ Dependency (PackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr
| (compiler, vr) <- testedWith pkg
, usesNewVersionRangeSyntax vr ]
......@@ -1249,7 +1249,7 @@ checkCabalVersion pkg =
, (name, _) <- Map.toList (targetBuildRenaming bi) ]
testedWithUsingWildcardSyntax =
[ Dependency (PackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr
| (compiler, vr) <- testedWith pkg
, usesWildcardSyntax vr ]
......@@ -1432,7 +1432,8 @@ checkPackageVersions pkg =
foldr intersectVersionRanges anyVersion baseDeps
where
baseDeps =
[ vr | Dependency (PackageName "base") vr <- buildDepends pkg' ]
[ vr | Dependency pname vr <- buildDepends pkg'
, pname == mkPackageName "base" ]
-- Just in case finalizePD fails for any reason,
-- or if the package doesn't depend on the base package at all,
......
......@@ -636,7 +636,7 @@ parseBuildToolNameQ = parseQuoted parseBuildToolName <++ parseBuildToolName
-- like parsePackageName but accepts symbols in components
parseBuildToolName :: ReadP r PackageName
parseBuildToolName = do ns <- sepBy1 component (ReadP.char '-')
return (PackageName (intercalate "-" ns))
return (mkPackageName (intercalate "-" ns))
where component = do
cs <- munch1 (\c -> isAlphaNum c || c == '+' || c == '_')
if all isDigit cs then pfail else return cs
......@@ -649,7 +649,7 @@ parsePkgconfigDependency = do name <- munch1
(\c -> isAlphaNum c || c `elem` "+-._")
ver <- betweenSpaces $
parseVersionRangeQ <++ return anyVersion
return $ Dependency (PackageName name) ver
return $ Dependency (mkPackageName name) ver
parsePackageNameQ :: ReadP r PackageName
parsePackageNameQ = parseQuoted parse <++ parse
......
......@@ -461,7 +461,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- | The stub executable needs a new 'ComponentLocalBuildInfo'
-- that exposes the relevant test suite library.
deps = (IPI.installedUnitId ipi, packageId ipi)
: (filter (\(_, x) -> let PackageName name = pkgName x
: (filter (\(_, x) -> let name = unPackageName $ pkgName x
in name == "Cabal" || name == "base")
(componentPackageDeps clbi))
exeClbi = ExeComponentLocalBuildInfo {
......@@ -512,7 +512,7 @@ addInternalBuildTools pkg lbi bi progs =
internalExeNames = map exeName (executables pkg)
buildToolNames = map buildToolName (buildTools bi)
where
buildToolName (Dependency (PackageName name) _ ) = name
buildToolName (Dependency pname _ ) = unPackageName pname
-- TODO: build separate libs in separate dirs so that we can build
......
......@@ -244,11 +244,11 @@ writePersistBuildConfig distPref lbi = do
-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion
currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
currentCompilerId = PackageIdentifier (mkPackageName System.Info.compilerName)
System.Info.compilerVersion
-- | Parse the @setup-config@ file header, returning the package identifiers
......@@ -614,10 +614,10 @@ configure (pkg_descr0', pbi) cfg = do
[ buildTool
| let exeNames = map exeName (executables pkg_descr)
, bi <- enabledBuildInfos pkg_descr enabled
, buildTool@(Dependency (PackageName toolName) reqVer)
, buildTool@(Dependency toolPName reqVer)
<- buildTools bi
, let isInternal =
toolName `elem` exeNames
unPackageName toolPName `elem` exeNames
-- we assume all internal build-tools are
-- versioned with the package:
&& packageVersion pkg_descr `withinRange` reqVer
......@@ -855,7 +855,7 @@ getInternalPackages pkg_descr0 =
let pkg_descr = flattenPackageDescription pkg_descr0
f lib = case libName lib of
Nothing -> (packageName pkg_descr, CLibName)
Just n' -> (PackageName n', CSubLibName n')
Just n' -> (mkPackageName n', CSubLibName n')
in Map.fromList (map f (allLibraries pkg_descr))
-- | Returns true if a dependency is satisfiable. This function
......@@ -1427,7 +1427,7 @@ configureRequiredPrograms verbosity deps progdb =
configureRequiredProgram :: Verbosity -> ProgramDb -> Dependency
-> IO ProgramDb
configureRequiredProgram verbosity progdb
(Dependency (PackageName progName) verRange) =
(Dependency progPkgName verRange) =
case lookupKnownProgram progName progdb of
Nothing ->
-- Try to configure it as a 'simpleProgram' automatically
......@@ -1442,6 +1442,8 @@ configureRequiredProgram verbosity progdb
| otherwise -> do
(_, _, progdb') <- requireProgramVersion verbosity prog verRange progdb
return progdb'
where
progName = unPackageName progPkgName
-- -----------------------------------------------------------------------------
-- Configuring pkg-config package dependencies
......@@ -1471,7 +1473,7 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled
pkgconfig = getDbProgramOutput (lessVerbose verbosity)
pkgConfigProgram progdb
requirePkg dep@(Dependency (PackageName pkg) range) = do
requirePkg dep@(Dependency pkgn range) = do
version <- pkgconfig ["--modversion", pkg]
`catchIO` (\_ -> die notFound)
`catchExit` (\_ -> die notFound)
......@@ -1494,6 +1496,8 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled
| isAnyVersion range = ""
| otherwise = " version " ++ display range
pkg = unPackageName pkgn
-- Adds pkgconfig dependencies to the build info for a component
addPkgConfigBI compBI setCompBI comp = do
bi <- pkgconfigBuildInfo (pkgconfigDepends (compBI comp))
......@@ -1617,11 +1621,9 @@ mkComponentsGraph enabled pkg_descr internalPackageSet =
where
-- The dependencies for the given component
componentDeps component =
[ CExeName toolname | Dependency (PackageName toolname) _
<- buildTools bi
, toolname `elem` map exeName
(executables pkg_descr) ]
[ CExeName (unPackageName toolpname)
| Dependency toolpname _ <- buildTools bi
, unPackageName toolpname `elem` map exeName (executables pkg_descr) ]
++ [ cname
| Dependency pkgname _ <- targetBuildDepends bi
, cname <- Maybe.maybeToList (Map.lookup pkgname internalPackageSet) ]
......@@ -1721,8 +1723,8 @@ computeCompatPackageName pkg_name cname
go ('-':z) _ r = go z (Just 0) ('-':r)
go ('z':z) (Just n) r = go z (Just (n+1)) ('z':r)
go (c:z) _ r = go z Nothing (c:r)
in PackageName $ "z-" ++ zdashcode (display pkg_name)
++ "-z-" ++ zdashcode cname_str
in mkPackageName $ "z-" ++ zdashcode (display pkg_name)
++ "-z-" ++ zdashcode cname_str
| otherwise
= pkg_name
......
......@@ -292,7 +292,7 @@ getInstalledPackages verbosity comp packagedbs progdb = do
where
hackRtsPackage index =
case PackageIndex.lookupPackageName index (PackageName "rts") of
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_,[rts])]
-> PackageIndex.insert (removeMingwIncludeDir rts) index
_ -> index -- No (or multiple) ghc rts package is registered!!
......
......@@ -32,7 +32,7 @@ data PackageIdentifier = PackageIdentifier {
convertPackageId :: PackageIdentifier -> Current.PackageIdentifier
convertPackageId PackageIdentifier { pkgName = n, pkgVersion = v } =
Current.PackageIdentifier (Current.PackageName n) v
Current.PackageIdentifier (Current.mkPackageName n) v
data License = GPL | LGPL | BSD3 | BSD4
| PublicDomain | AllRightsReserved | OtherLicense
......
......@@ -593,7 +593,7 @@ haddockPackagePaths ipkgs mkHtmlPath = do
where
-- Don't warn about missing documentation for these packages. See #1231.
noHaddockWhitelist = map PackageName [ "rts" ]
noHaddockWhitelist = map mkPackageName [ "rts" ]
-- Actually extract interface and HTML paths from an 'InstalledPackageInfo'.
interfaceAndHtmlPath :: InstalledPackageInfo
......
......@@ -467,11 +467,11 @@ lookupDependency index (Dependency name versionRange) =
--
searchByName :: PackageIndex a -> String -> SearchResult [a]
searchByName index name =
case [ pkgs | pkgs@(PackageName name',_) <- Map.toList (packageIdIndex index)
, lowercase name' == lname ] of
case [ pkgs | pkgs@(pname,_) <- Map.toList (packageIdIndex index)
, lowercase (unPackageName pname) == lname ] of
[] -> None
[(_,pvers)] -> Unambiguous (concat (Map.elems pvers))
pkgss -> case find ((PackageName name==) . fst) pkgss of
pkgss -> case find ((mkPackageName name ==) . fst) pkgss of
Just (_,pvers) -> Unambiguous (concat (Map.elems pvers))
Nothing -> Ambiguous (map (concat . Map.elems . snd) pkgss)
where lname = lowercase name
......@@ -485,8 +485,8 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a]
searchByNameSubstring :: PackageIndex a -> String -> [a]
searchByNameSubstring index searchterm =
[ pkg
| (PackageName name, pvers) <- Map.toList (packageIdIndex index)
, lsearchterm `isInfixOf` lowercase name
| (pname, pvers) <- Map.toList (packageIdIndex index)
, lsearchterm `isInfixOf` lowercase (unPackageName pname)
, pkgs <- Map.elems pvers
, pkg <- pkgs ]
where lsearchterm = lowercase searchterm
......
......@@ -450,7 +450,7 @@ ppHsc2hs bi lbi clbi =
-- OS X (it's ld is a tad stricter than gnu ld). Thus we remove the
-- ldOptions for GHC's rts package:
hackRtsPackage index =
case PackageIndex.lookupPackageName index (PackageName "rts") of
case PackageIndex.lookupPackageName index (mkPackageName "rts") of
[(_, [rts])]
-> PackageIndex.insert rts { Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!"
......
......@@ -171,7 +171,7 @@ descCabalVersion pkg = case specVersionRaw pkg of
emptyPackageDescription :: PackageDescription
emptyPackageDescription
= PackageDescription {
package = PackageIdentifier (PackageName "")
package = PackageIdentifier (mkPackageName "")
(Version [] []),
license = UnspecifiedLicense,
licenseFiles = [],
......
......@@ -46,6 +46,9 @@
If you only need to test if a component is buildable
(i.e., it is marked buildable in the Cabal file)
use the new function 'componentBuildable'.
* Backwards incompatible change to 'PackageName' (#3896):
'PackageName' is now opaque; conversion to/from 'String' now works
via (old) 'unPackageName' and (new) 'mkPackageName' functions.
* Add support for `--allow-older` (dual to `--allow-newer`) (#3466)
* Improved an error message for process output decoding errors
(#3408).
......
......@@ -19,7 +19,7 @@ suite = do
"dummy.hs"
, benchmarkBuildInfo = emptyBuildInfo
{ targetBuildDepends =
[ Dependency (PackageName "base") anyVersion ]
[ Dependency (mkPackageName "base") anyVersion ]
, hsSourceDirs = ["."]
}
}
......
......@@ -20,9 +20,9 @@ suite = do
{ libBuildInfo = emptyBuildInfo
{ defaultLanguage = Just Haskell2010
, targetBuildDepends =
[ Dependency (PackageName{unPackageName = "base"})
[ Dependency (mkPackageName "base")
(withinVersion (Version [4] []))
, Dependency (PackageName{unPackageName = "pretty"})
, Dependency (mkPackageName "pretty")
(majorBoundVersion (Version [1,1,1,0] []))
]
, hsSourceDirs = ["."]
......
......@@ -18,7 +18,7 @@ suite = do
, testInterface = TestSuiteExeV10 (Version [1,0] []) "dummy.hs"
, testBuildInfo = emptyBuildInfo
{ targetBuildDepends =
[ Dependency (PackageName "base") anyVersion ]
[ Dependency (mkPackageName "base") anyVersion ]
, hsSourceDirs = ["."]
}
}
......
......@@ -34,7 +34,7 @@ import Distribution.Client.Utils
import qualified Paths_cabal_install (version)
import Distribution.Package
( PackageIdentifier(..), PackageName(..) )
( PackageIdentifier(..), mkPackageName )
import Distribution.PackageDescription
( FlagName(..), FlagAssignment )
--import Distribution.Version
......@@ -159,7 +159,7 @@ new os' arch' comp pkgid flags deps result =
cabalInstallID :: PackageIdentifier
cabalInstallID =
PackageIdentifier (PackageName "cabal-install") Paths_cabal_install.version
PackageIdentifier (mkPackageName "cabal-install") Paths_cabal_install.version
-- ------------------------------------------------------------
-- * External format
......
......@@ -74,7 +74,7 @@ import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )
import Distribution.Client.Targets
import Distribution.Package
( PackageName(..), PackageIdentifier(PackageIdentifier), PackageId
( PackageName, mkPackageName, PackageIdentifier(PackageIdentifier), PackageId
, Package(..), packageName, packageVersion
, Dependency(Dependency))
import qualified Distribution.PackageDescription as PD
......@@ -347,9 +347,9 @@ dontUpgradeNonUpgradeablePackages params =
[ LabeledPackageConstraint
(PackageConstraintInstalled pkgname)
ConstraintSourceNonUpgradeablePackage
| Set.notMember (PackageName "base") (depResolverTargets params)
, pkgname <- map PackageName [ "base", "ghc-prim", "integer-gmp"
, "integer-simple" ]
| Set.notMember (mkPackageName "base") (depResolverTargets params)
, pkgname <- map mkPackageName [ "base", "ghc-prim", "integer-gmp"
, "integer-simple" ]
, isInstalled pkgname ]
isInstalled = not . null
......@@ -520,7 +520,7 @@ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
-- Force Cabal >= 1.24 dep when the package is affected by #3199.
mkDefaultSetupDeps :: UnresolvedSourcePackage -> Maybe [Dependency]
mkDefaultSetupDeps srcpkg | affected =
Just [Dependency (PackageName "Cabal")
Just [Dependency (mkPackageName "Cabal")
(orLaterVersion $ Version [1,24] [])]
| otherwise = Nothing
where
......
......@@ -25,7 +25,7 @@ import Distribution.Client.Sandbox.Types
import Distribution.Client.Setup
( GlobalFlags(..), FreezeFlags(..), RepoContext )
import Distribution.Package
( Package(..), Dependency(..), PackageName(..)
( Package(..), Dependency(..), unPackageName
, packageName, packageVersion )
import Distribution.PackageDescription
( buildDepends )
......@@ -139,7 +139,7 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
mapM_ (putStrLn . (++",") . showBounds padTo) thePkgs
depName :: Dependency -> String
depName (Dependency (PackageName nm) _) = nm
depName (Dependency pn _) = unPackageName pn
depVersion :: Dependency -> VersionRange
depVersion (Dependency _ vr) = vr
......
......@@ -47,7 +47,7 @@ import Distribution.Client.IndexUtils.Timestamp
import Distribution.Client.Types
import Distribution.Package
( PackageId, PackageIdentifier(..), PackageName(..)
( PackageId, PackageIdentifier(..), mkPackageName
, Package(..), packageVersion, packageName
, Dependency(Dependency) )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
......@@ -434,7 +434,7 @@ extractPkg entry blockNo = case Tar.entryContent entry of
[pkgname,vers,_] -> case simpleParse vers of
Just ver -> Just . return $ Just (NormalPackage pkgid descr content blockNo)
where
pkgid = PackageIdentifier (PackageName pkgname) ver
pkgid = PackageIdentifier (mkPackageName pkgname) ver
parsed = parsePackageDescription . ignoreBOM . fromUTF8 . BS.Char8.unpack
$ content
descr = case parsed of
......@@ -871,7 +871,7 @@ read00IndexCacheEntry = \line ->
where
parseName str
| BSS.all (\c -> isAlphaNum c || c == '-') str
= Just (PackageName (BSS.unpack str))
= Just (mkPackageName (BSS.unpack str))
| otherwise = Nothing
parseVer str vs =
......
......@@ -86,7 +86,7 @@ guessMainFileCandidates flags = do
-- | Guess the package name based on the given root directory.
guessPackageName :: FilePath -> IO P.PackageName
guessPackageName = liftM (P.PackageName . repair . last . splitDirectories)
guessPackageName = liftM (P.mkPackageName . repair . last . splitDirectories)
. tryCanonicalizePath
where
-- Treat each span of non-alphanumeric characters as a hyphen. Each
......
......@@ -14,7 +14,7 @@ module Distribution.Client.List (
) where
import Distribution.Package
( PackageName(..), Package(..), packageName, packageVersion
( PackageName, Package(..), packageName, packageVersion
, Dependency(..), simplifyDependency
, UnitId )
import Distribution.ModuleName (ModuleName)
......
......@@ -15,7 +15,7 @@ module Distribution.Client.PackageUtils (
) where
import Distribution.Package
( packageVersion, packageName, Dependency(..), PackageName(..) )
( packageVersion, packageName, Dependency(..), unPackageName )
import Distribution.PackageDescription
( PackageDescription(..), libName )
import Distribution.Version
......
......@@ -1160,7 +1160,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
(internal_exe_deps, internal_exe_paths)
= unzip $
[ (confInstId confid', path)
| Dependency (PackageName toolname) _ <- PD.buildTools bi
| Dependency (unPackageName -> toolname) _ <- PD.buildTools bi
, toolname `elem` map PD.exeName (PD.executables elabPkgDescription)
, Just (confid', path) <- [Map.lookup toolname exe_map]
]
......@@ -1169,7 +1169,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
CLibName
-> Map.insert (packageName elabPkgSourceId) confid internal_map
CSubLibName libname
-> Map.insert (PackageName libname) confid internal_map
-> Map.insert (mkPackageName libname) confid internal_map
_ -> internal_map
exe_map' = case cname of
CExeName exename
......@@ -2238,13 +2238,13 @@ packageSetupScriptSpecVersion _ pkg deps =
cabalPkgname, basePkgname :: PackageName
cabalPkgname = PackageName "Cabal"
basePkgname = PackageName "base"
cabalPkgname = mkPackageName "Cabal"
basePkgname = mkPackageName "base"
legacyCustomSetupPkgs :: Compiler -> Platform -> [PackageName]
legacyCustomSetupPkgs compiler (Platform _ os) =
map PackageName $
map mkPackageName $
[ "array", "base", "binary", "bytestring", "containers"
, "deepseq", "directory", "filepath", "old-time", "pretty"
, "process", "time", "transformers" ]
......
......@@ -31,9 +31,8 @@ import Distribution.Version
, intersectVersionRanges, orLaterVersion
, withinRange )
import Distribution.Package
( UnitId(..), ComponentId, PackageIdentifier(..), PackageId,
PackageName(..), packageName
, packageVersion, Dependency(..) )
( UnitId(..), ComponentId, PackageId, mkPackageName
, PackageIdentifier(..), packageVersion, packageName, Dependency(..) )
import Distribution.PackageDescription
( GenericPackageDescription(packageDescription)
, PackageDescription(..), specVersion
......@@ -534,7 +533,7 @@ getExternalSetupMethod verbosity options pkg bt = do
cabalLibVersionToUse :: IO (Version, Maybe ComponentId
,SetupScriptOptions)
cabalLibVersionToUse =
case find (hasCabal . snd) (useDependencies options) of
case find (isCabalPkgId . snd) (useDependencies options) of
Just (unitId, pkgId) -> do
let version = pkgVersion pkgId
updateSetupScript version bt
......@@ -577,9 +576,6 @@ getExternalSetupMethod verbosity options pkg bt = do
writeSetupVersionFile version =
writeFile setupVersionFile (show version ++ "\n")
hasCabal (PackageIdentifier (PackageName "Cabal") _) = True
hasCabal _ = False
installedVersion :: IO (Version, Maybe InstalledPackageId
,SetupScriptOptions)
installedVersion = do
......@@ -631,7 +627,7 @@ getExternalSetupMethod verbosity options pkg bt = do
,SetupScriptOptions)
installedCabalVersion options' compiler progdb = do
index <- maybeGetInstalledPackages options' compiler progdb
let cabalDep = Dependency (PackageName "Cabal") (useCabalVersion options')
let cabalDep = Dependency (mkPackageName "Cabal") (useCabalVersion options')
options'' = options' { usePackageIndex = Just index }
case PackageIndex.lookupDependency index cabalDep of
[] -> die $ "The package '" ++ display (packageName pkg)
......@@ -758,7 +754,7 @@ getExternalSetupMethod verbosity options pkg bt = do
when (outOfDate || forceCompile) $ do
debug verbosity "Setup executable needs to be updated, compiling..."
(compiler, progdb, options'') <- configureCompiler options'
let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion
let cabalPkgid = PackageIdentifier (mkPackageName "Cabal") cabalLibVersion
(program, extraOpts)
= case compilerFlavor compiler of
GHCJS -> (ghcjsProgram, ["-build-runner"])
......@@ -776,13 +772,10 @@ getExternalSetupMethod verbosity options pkg bt = do
-- Both of these options should be enabled for packages that have
-- opted-in and declared a custom-settup stanza.
--
hasCabal (_, PackageIdentifier (PackageName "Cabal") _) = True
hasCabal _ = False
selectedDeps | useDependenciesExclusive options'
= useDependencies options'
| otherwise = useDependencies options' ++
if any hasCabal (useDependencies options')
if any (isCabalPkgId . snd) (useDependencies options')
then []
else cabalDep
addRenaming (ipid, _) = (SimpleUnitId ipid, defaultRenaming)
......@@ -820,3 +813,7 @@ getExternalSetupMethod verbosity options pkg bt = do
progdb ghcCmdLine
hPutStr logHandle output