Commit 30eecc60 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Make 'ComponentId' type opaque

parent 4c96e80d
......@@ -252,7 +252,7 @@ basicFieldDescrs =
installedUnitId (\pk pkg -> pkg{installedUnitId=pk})
-- NB: parse these as component IDs
, simpleField "key"
(disp . ComponentId) (fmap (\(ComponentId s) -> s) parse)
(disp . mkComponentId) (fmap unComponentId parse)
compatPackageKey (\pk pkg -> pkg{compatPackageKey=pk})
, simpleField "license"
disp parseLicenseQ
......
......@@ -23,7 +23,7 @@ module Distribution.Package (
PackageId,
-- * Package keys/installed package IDs (used for linker symbols)
ComponentId(..),
ComponentId, unComponentId, mkComponentId,
UnitId(..),
mkUnitId,
mkLegacyUnitId,
......@@ -167,27 +167,49 @@ instance NFData Module where
-- code closure of a component. For non-Backpack components, it also
-- serves as the basis for install paths, symbols, etc.
--
-- Use 'mkComponentId' and 'unComponentId' to convert from/to a
-- 'String'.
--
-- This type is opaque since @Cabal-2.0@
--
-- @since 2.0
data ComponentId
= ComponentId String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
-- | Construct a 'ComponentId' from a 'String'
--
-- 'mkComponentId' is the inverse to 'unComponentId'
--
-- Note: No validations are performed to ensure that the resulting
-- 'ComponentId' is valid
--
-- @since 2.0
mkComponentId :: String -> ComponentId
mkComponentId = ComponentId
-- | Convert 'ComponentId' to 'String'
unComponentId :: ComponentId -> String
unComponentId (ComponentId s) = s
{-# DEPRECATED InstalledPackageId "Use UnitId instead" #-}
type InstalledPackageId = UnitId
instance Binary ComponentId
instance Text ComponentId where
disp (ComponentId str) = text str
disp = text . unComponentId
parse = ComponentId `fmap` Parse.munch1 abi_char
parse = mkComponentId `fmap` Parse.munch1 abi_char
where abi_char c = isAlphaNum c || c `elem` "-_."
instance NFData ComponentId where
rnf (ComponentId pk) = rnf pk
rnf = rnf . unComponentId
-- | Returns library name prefixed with HS, suitable for filenames
getHSLibraryName :: UnitId -> String
getHSLibraryName (SimpleUnitId (ComponentId s)) = "HS" ++ s
getHSLibraryName (SimpleUnitId cid) = "HS" ++ unComponentId cid
-- | For now, there is no distinction between component IDs
-- and unit IDs in Cabal.
......@@ -196,11 +218,11 @@ newtype UnitId = SimpleUnitId ComponentId
-- | Makes a simple-style UnitId from a string.
mkUnitId :: String -> UnitId
mkUnitId = SimpleUnitId . ComponentId
mkUnitId = SimpleUnitId . mkComponentId
-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = SimpleUnitId . ComponentId . display
mkLegacyUnitId = mkUnitId . display
-- | Extract 'ComponentId' from 'UnitId'.
unitIdComponentId :: UnitId -> ComponentId
......
......@@ -1672,7 +1672,7 @@ computeComponentId mb_ipid mb_cid pid cname dep_ipids flagAssignment =
NoFlag -> generated_base
in case mb_cid of
Flag cid -> cid
NoFlag -> ComponentId $ actual_base
NoFlag -> mkComponentId $ actual_base
++ (case componentNameString cname of
Nothing -> ""
Just s -> "-" ++ s)
......@@ -1781,7 +1781,7 @@ computeCompatPackageKey
-> Version
-> UnitId
-> String
computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str))
computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId cid)
| not (packageKeySupported comp) =
display pkg_name ++ "-" ++ display pkg_version
| not (unifiedIPIDRequired comp) =
......@@ -1800,6 +1800,8 @@ computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str
rehashed_key = hashToBase62 str
in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key)
| otherwise = str
where
str = unComponentId cid
mkComponentsLocalBuildInfo :: ConfigFlags
-> UseExternalInternalDeps
......
......@@ -315,9 +315,9 @@ mungePackagePaths pkgroot pkginfo =
-- field, so if it is missing then we fill it as the source package ID.
setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
setUnitId pkginfo@InstalledPackageInfo {
installedUnitId = SimpleUnitId (ComponentId ""),
installedUnitId = SimpleUnitId cid,
sourcePackageId = pkgid
}
} | cid == mkComponentId ""
= pkginfo {
installedUnitId = mkLegacyUnitId pkgid
}
......
......@@ -734,7 +734,7 @@ configureOptions showOrParseArgs =
,option "" ["cid"]
"Installed component ID to compile this component as"
(fmap display . configCID) (\v flags -> flags {configCID = fmap ComponentId v})
(fmap display . configCID) (\v flags -> flags {configCID = fmap mkComponentId v})
(reqArgFlag "CID")
,option "" ["extra-lib-dirs"]
......
......@@ -29,7 +29,7 @@ module Distribution.Client.PackageHash (
) where
import Distribution.Package
( PackageId, PackageName, PackageIdentifier(..), ComponentId(..) )
( PackageId, PackageName, PackageIdentifier(..), mkComponentId )
import Distribution.System
( Platform, OS(Windows), buildOS )
import Distribution.PackageDescription
......@@ -89,7 +89,7 @@ hashedInstalledPackageId
--
hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} =
ComponentId $
mkComponentId $
display pkgHashPkgId -- to be a bit user friendly
++ "-"
++ showHashValue (hashPackageHashInputs pkghashinputs)
......@@ -114,7 +114,7 @@ hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} =
--
hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
ComponentId $
mkComponentId $
intercalate "-"
-- max length now 64
[ truncateStr 14 (display name)
......
......@@ -674,7 +674,7 @@ getInstalledStorePackages :: FilePath -- ^ store directory
-> Rebuild (Set UnitId)
getInstalledStorePackages storeDirectory = do
paths <- getDirectoryContentsMonitored storeDirectory
return $ Set.fromList [ SimpleUnitId (ComponentId path)
return $ Set.fromList [ SimpleUnitId (mkComponentId path)
| path <- paths, valid path ]
where
valid ('.':_) = False
......@@ -1108,7 +1108,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
cid :: ComponentId
cid = case elabBuildStyle of
BuildInplaceOnly ->
ComponentId $
mkComponentId $
display elabPkgSourceId ++ "-inplace" ++
(case Cabal.componentNameString cname of
Nothing -> ""
......@@ -1283,7 +1283,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
requires_reg = PD.hasPublicLib elabPkgDescription
pkgInstalledId
| shouldBuildInplaceOnly pkg
= ComponentId (display pkgid ++ "-inplace")
= mkComponentId (display pkgid ++ "-inplace")
| otherwise
= assert (isJust elabPkgSourceHash) $
......
......@@ -22,7 +22,7 @@ module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..)
, UnitId(..), ComponentId(..), HasUnitId(..)
, UnitId(..), ComponentId, HasUnitId(..)
, PackageInstalled(..), unitIdComponentId )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
......
......@@ -57,10 +57,10 @@ showI (I v InRepo) = showVer v
showI (I v (Inst uid)) = showVer v ++ "/installed" ++ shortId uid
where
-- A hack to extract the beginning of the package ABI hash
shortId (SimpleUnitId (ComponentId i))
shortId (SimpleUnitId cid)
= snip (splitAt 4) (++ "...")
. snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
$ i
$ unComponentId cid
snip p f xs = case p xs of
(ys, zs) -> (if L.null zs then id else f) ys
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment