Skip to content

Distinguish between component ID and unit ID. #3047

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Jan 17, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion Cabal/Cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -275,7 +275,6 @@ library
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
Distribution.Simple.GHC.IPI641
Distribution.Simple.GHC.IPI642
Distribution.Simple.GHC.IPIConvert
Distribution.Simple.GHC.ImplInfo
Expand Down
65 changes: 23 additions & 42 deletions Cabal/Distribution/InstalledPackageInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@

module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
OriginalModule(..), ExposedModule(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
Expand All @@ -40,7 +41,7 @@ module Distribution.InstalledPackageInfo (

import Distribution.ParseUtils
import Distribution.License
import Distribution.Package hiding (installedComponentId)
import Distribution.Package hiding (installedUnitId)
import qualified Distribution.Package as Package
import Distribution.ModuleName
import Distribution.Version
Expand All @@ -60,9 +61,9 @@ import GHC.Generics (Generic)
data InstalledPackageInfo
= InstalledPackageInfo {
-- these parts are exactly the same as PackageDescription
sourcePackageId :: PackageId,
installedComponentId:: ComponentId,
compatPackageKey :: ComponentId,
sourcePackageId :: PackageId,
installedUnitId :: UnitId,
compatPackageKey :: String,
license :: License,
copyright :: String,
maintainer :: String,
Expand All @@ -77,7 +78,6 @@ data InstalledPackageInfo
abiHash :: AbiHash,
exposed :: Bool,
exposedModules :: [ExposedModule],
installedInstantiatedWith :: [(ModuleName, OriginalModule)],
hiddenModules :: [ModuleName],
trusted :: Bool,
importDirs :: [FilePath],
Expand All @@ -88,7 +88,7 @@ data InstalledPackageInfo
extraGHCiLibraries:: [String], -- overrides extraLibraries for GHCi
includeDirs :: [FilePath],
includes :: [String],
depends :: [ComponentId],
depends :: [UnitId],
ccOptions :: [String],
ldOptions :: [String],
frameworkDirs :: [FilePath],
Expand All @@ -99,23 +99,27 @@ data InstalledPackageInfo
}
deriving (Eq, Generic, Read, Show)

installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi = case installedUnitId ipi of
SimpleUnitId cid -> cid

instance Binary InstalledPackageInfo

instance Package.Package InstalledPackageInfo where
packageId = sourcePackageId

instance Package.HasComponentId InstalledPackageInfo where
installedComponentId = installedComponentId
instance Package.HasUnitId InstalledPackageInfo where
installedUnitId = installedUnitId

instance Package.PackageInstalled InstalledPackageInfo where
installedDepends = depends

emptyInstalledPackageInfo :: InstalledPackageInfo
emptyInstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId = PackageIdentifier (PackageName "") (Version [] []),
installedComponentId = ComponentId "",
compatPackageKey = ComponentId "",
sourcePackageId = PackageIdentifier (PackageName "") (Version [] []),
installedUnitId = mkUnitId "",
compatPackageKey = "",
license = UnspecifiedLicense,
copyright = "",
maintainer = "",
Expand All @@ -130,7 +134,6 @@ emptyInstalledPackageInfo
exposed = False,
exposedModules = [],
hiddenModules = [],
installedInstantiatedWith = [],
trusted = False,
importDirs = [],
libraryDirs = [],
Expand All @@ -155,16 +158,15 @@ emptyInstalledPackageInfo

data OriginalModule
= OriginalModule {
originalPackageId :: ComponentId,
originalPackageId :: UnitId,
originalModuleName :: ModuleName
}
deriving (Generic, Eq, Read, Show)

data ExposedModule
= ExposedModule {
exposedName :: ModuleName,
exposedReexport :: Maybe OriginalModule,
exposedSignature :: Maybe OriginalModule -- This field is unused for now.
exposedReexport :: Maybe OriginalModule
}
deriving (Eq, Generic, Read, Show)

Expand All @@ -178,14 +180,11 @@ instance Text OriginalModule where
return (OriginalModule ipi m)

instance Text ExposedModule where
disp (ExposedModule m reexport signature) =
disp (ExposedModule m reexport) =
Disp.sep [ disp m
, case reexport of
Just m' -> Disp.sep [Disp.text "from", disp m']
Nothing -> Disp.empty
, case signature of
Just m' -> Disp.sep [Disp.text "is", disp m']
Nothing -> Disp.empty
]
parse = do
m <- parseModuleNameQ
Expand All @@ -194,12 +193,7 @@ instance Text ExposedModule where
_ <- Parse.string "from"
Parse.skipSpaces
fmap Just parse
Parse.skipSpaces
signature <- Parse.option Nothing $ do
_ <- Parse.string "is"
Parse.skipSpaces
fmap Just parse
return (ExposedModule m reexport signature)
return (ExposedModule m reexport)


instance Binary OriginalModule
Expand All @@ -215,7 +209,7 @@ showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules xs
| all isExposedModule xs = fsep (map disp xs)
| otherwise = fsep (Disp.punctuate comma (map disp xs))
where isExposedModule (ExposedModule _ Nothing Nothing) = True
where isExposedModule (ExposedModule _ Nothing) = True
isExposedModule _ = False

parseExposedModules :: Parse.ReadP r [ExposedModule]
Expand All @@ -229,14 +223,6 @@ parseInstalledPackageInfo =
parseFieldsFlat (fieldsInstalledPackageInfo ++ deprecatedFieldDescrs)
emptyInstalledPackageInfo

parseInstantiatedWith :: Parse.ReadP r (ModuleName, OriginalModule)
parseInstantiatedWith = do k <- parse
_ <- Parse.char '='
n <- parse
_ <- Parse.char '@'
p <- parse
return (k, OriginalModule p n)

-- -----------------------------------------------------------------------------
-- Pretty-printing

Expand All @@ -249,9 +235,6 @@ showInstalledPackageInfoField = showSingleNamedField fieldsInstalledPackageInfo
showSimpleInstalledPackageInfoField :: String -> Maybe (InstalledPackageInfo -> String)
showSimpleInstalledPackageInfoField = showSimpleSingleNamedField fieldsInstalledPackageInfo

showInstantiatedWith :: (ModuleName, OriginalModule) -> Doc
showInstantiatedWith (k, OriginalModule p m) = disp k <> text "=" <> disp m <> text "@" <> disp p

-- -----------------------------------------------------------------------------
-- Description of the fields, for parsing/printing

Expand All @@ -268,9 +251,10 @@ basicFieldDescrs =
packageVersion (\ver pkg -> pkg{sourcePackageId=(sourcePackageId pkg){pkgVersion=ver}})
, simpleField "id"
disp parse
installedComponentId (\pk pkg -> pkg{installedComponentId=pk})
installedUnitId (\pk pkg -> pkg{installedUnitId=pk})
-- NB: parse these as component IDs
, simpleField "key"
disp parse
(disp . ComponentId) (fmap (\(ComponentId s) -> s) parse)
compatPackageKey (\pk pkg -> pkg{compatPackageKey=pk})
, simpleField "license"
disp parseLicenseQ
Expand Down Expand Up @@ -317,9 +301,6 @@ installedFieldDescrs = [
, simpleField "abi"
disp parse
abiHash (\abi pkg -> pkg{abiHash=abi})
, listField "instantiated-with"
showInstantiatedWith parseInstantiatedWith
installedInstantiatedWith (\xs pkg -> pkg{installedInstantiatedWith=xs})
, boolField "trusted"
trusted (\val pkg -> pkg{trusted=val})
, listField "import-dirs"
Expand Down
31 changes: 24 additions & 7 deletions Cabal/Distribution/Package.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
Expand All @@ -23,6 +24,9 @@ module Distribution.Package (

-- * Package keys/installed package IDs (used for linker symbols)
ComponentId(..),
UnitId(..),
mkUnitId,
mkLegacyUnitId,
getHSLibraryName,
InstalledPackageId, -- backwards compat

Expand All @@ -37,7 +41,7 @@ module Distribution.Package (

-- * Package classes
Package(..), packageName, packageVersion,
HasComponentId(..),
HasUnitId(..),
PackageInstalled(..),
) where

Expand Down Expand Up @@ -132,8 +136,21 @@ instance NFData ComponentId where
rnf (ComponentId pk) = rnf pk

-- | Returns library name prefixed with HS, suitable for filenames
getHSLibraryName :: ComponentId -> String
getHSLibraryName (ComponentId s) = "HS" ++ s
getHSLibraryName :: UnitId -> String
getHSLibraryName (SimpleUnitId (ComponentId s)) = "HS" ++ s

-- | For now, there is no distinction between component IDs
-- and unit IDs in Cabal.
newtype UnitId = SimpleUnitId ComponentId
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, Text, NFData)

-- | Makes a simple-style UnitId from a string.
mkUnitId :: String -> UnitId
mkUnitId = SimpleUnitId . ComponentId

-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = SimpleUnitId . ComponentId . display

-- ------------------------------------------------------------
-- * Package source dependencies
Expand Down Expand Up @@ -194,17 +211,17 @@ instance Package PackageIdentifier where
packageId = id

-- | Packages that have an installed package ID
class Package pkg => HasComponentId pkg where
installedComponentId :: pkg -> ComponentId
class Package pkg => HasUnitId pkg where
installedUnitId :: pkg -> UnitId

-- | Class of installed packages.
--
-- The primary data type which is an instance of this package is
-- 'InstalledPackageInfo', but when we are doing install plans in Cabal install
-- we may have other, installed package-like things which contain more metadata.
-- Installed packages have exact dependencies 'installedDepends'.
class (HasComponentId pkg) => PackageInstalled pkg where
installedDepends :: pkg -> [ComponentId]
class (HasUnitId pkg) => PackageInstalled pkg where
installedDepends :: pkg -> [UnitId]

-- -----------------------------------------------------------------------------
-- ABI hash
Expand Down
2 changes: 1 addition & 1 deletion Cabal/Distribution/Simple/Bench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -118,6 +118,6 @@ benchOption pkg_descr lbi bm template =
fromPathTemplate $ substPathTemplate env template
where
env = initialPathTemplateEnv
(PD.package pkg_descr) (LBI.localComponentId lbi)
(PD.package pkg_descr) (LBI.localUnitId lbi)
(compilerInfo $ LBI.compiler lbi) (LBI.hostPlatform lbi) ++
[(BenchmarkNameVar, toPathTemplate $ PD.benchmarkName bm)]
13 changes: 8 additions & 5 deletions Cabal/Distribution/Simple/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -381,19 +381,22 @@ testSuiteLibV09AsLibAndExe pkg_descr
libExposed = True,
libBuildInfo = bi
}
-- NB: temporary hack; I have a refactor which solves this
cid = computeComponentId (package pkg_descr)
(CTestName (testName test))
(map fst (componentPackageDeps clbi))
(map ((\(SimpleUnitId cid0) -> cid0) . fst)
(componentPackageDeps clbi))
(flagAssignment lbi)
uid = SimpleUnitId cid
(pkg_name, compat_key) = computeCompatPackageKey
(compiler lbi) (package pkg_descr)
(CTestName (testName test)) cid
(CTestName (testName test)) uid
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
, componentPackageRenaming = componentPackageRenaming clbi
, componentId = cid
, componentUnitId = uid
, componentCompatPackageKey = compat_key
, componentExposedModules = [IPI.ExposedModule m Nothing Nothing]
, componentExposedModules = [IPI.ExposedModule m Nothing]
}
pkg = pkg_descr {
package = (package pkg_descr) { pkgName = pkg_name }
Expand All @@ -420,7 +423,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- that exposes the relevant test suite library.
exeClbi = ExeComponentLocalBuildInfo {
componentPackageDeps =
(IPI.installedComponentId ipi, packageId ipi)
(IPI.installedUnitId ipi, packageId ipi)
: (filter (\(_, x) -> let PackageName name = pkgName x
in name == "Cabal" || name == "base")
(componentPackageDeps clbi)),
Expand Down
18 changes: 8 additions & 10 deletions Cabal/Distribution/Simple/Build/Macros.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,8 @@ import Distribution.Version
( Version(versionBranch) )
import Distribution.PackageDescription
( PackageDescription )
import Distribution.Simple.Compiler
( packageKeySupported )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(compiler, withPrograms), externalPackageDeps, localComponentId )
( LocalBuildInfo(withPrograms), externalPackageDeps, localComponentId, localCompatPackageKey )
import Distribution.Simple.Program.Db
( configuredPrograms )
import Distribution.Simple.Program.Types
Expand Down Expand Up @@ -96,14 +94,14 @@ generateMacros prefix name version =
where
(major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)

-- | Generate the @CURRENT_PACKAGE_KEY@ definition for the package key
-- of the current package, if supported by the compiler.
-- NB: this only makes sense for definite packages.
-- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
-- of the current package.
generateComponentIdMacro :: LocalBuildInfo -> String
generateComponentIdMacro lbi
| packageKeySupported (compiler lbi) =
"#define CURRENT_PACKAGE_KEY \"" ++ display (localComponentId lbi) ++ "\"\n\n"
| otherwise = ""
generateComponentIdMacro lbi =
concat
[ "#define CURRENT_COMPONENT_ID \"" ++ display (localComponentId lbi) ++ "\"\n\n"
, "#define CURRENT_PACKAGE_KEY \"" ++ localCompatPackageKey lbi ++ "\"\n\n"
]

fixchar :: Char -> Char
fixchar '-' = '_'
Expand Down
6 changes: 3 additions & 3 deletions Cabal/Distribution/Simple/BuildPaths.hs
Original file line number Diff line number Diff line change
Expand Up @@ -76,16 +76,16 @@ haddockName pkg_descr = display (packageName pkg_descr) <.> "haddock"
-- ---------------------------------------------------------------------------
-- Library file names

mkLibName :: ComponentId -> String
mkLibName :: UnitId -> String
mkLibName lib = "lib" ++ getHSLibraryName lib <.> "a"

mkProfLibName :: ComponentId -> String
mkProfLibName :: UnitId -> String
mkProfLibName lib = "lib" ++ getHSLibraryName lib ++ "_p" <.> "a"

-- Implement proper name mangling for dynamical shared objects
-- libHS<packagename>-<compilerFlavour><compilerVersion>
-- e.g. libHSbase-2.1-ghc6.6.1.so
mkSharedLibName :: CompilerId -> ComponentId -> String
mkSharedLibName :: CompilerId -> UnitId -> String
mkSharedLibName (CompilerId compilerFlavor compilerVersion) lib
= "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> dllExtension
where comp = display compilerFlavor ++ display compilerVersion
Expand Down
5 changes: 5 additions & 0 deletions Cabal/Distribution/Simple/Compiler.hs
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ module Distribution.Simple.Compiler (
renamingPackageFlagsSupported,
unifiedIPIDRequired,
packageKeySupported,
unitIdSupported,

-- * Support for profiling detail levels
ProfDetailLevel(..),
Expand Down Expand Up @@ -286,6 +287,10 @@ unifiedIPIDRequired = ghcSupported "Requires unified installed package IDs"
packageKeySupported :: Compiler -> Bool
packageKeySupported = ghcSupported "Uses package keys"

-- | Does this compiler support unit IDs?
unitIdSupported :: Compiler -> Bool
unitIdSupported = ghcSupported "Uses unit IDs"

-- | Utility function for GHC only features
ghcSupported :: String -> Compiler -> Bool
ghcSupported key comp =
Expand Down
Loading