Commit 1a6e2732 authored by Oleg Grenrus's avatar Oleg Grenrus

Change MungedPackageName to be non-opaque type.

i.e. strict pair of PackageName and LibraryName
the legacy conversion is done via Pretty/Parsec instances.

Change of `Maybe UnqualComponentName` to `LibraryName` caused
a cascade of other changes, but they all seem to be good changes.
In the sense, they made many comments not-so-necessary.

Add Distribution.Types.PackageName.Magic for special package names.

Updates in cabal-install are mostly trivial type error driven changes.
I removed few (deprecated) `Text` instances: `MungedPackageId`,
`MungedPackageName` and `LibraryName`. Turns out only a `Pretty`
part was used, so it was easy to update. Note: `LibraryName`
doesn't have `Pretty` / `Parsec` instances as it's either parsed/printed
as a `ComponentName` or `UnqualComponentName`, never stand alone.
parent 92e9ccd2
......@@ -370,6 +370,7 @@ library
Distribution.Types.LibraryName
Distribution.Types.MungedPackageName
Distribution.Types.PackageName
Distribution.Types.PackageName.Magic
Distribution.Types.PkgconfigName
Distribution.Types.UnqualComponentName
Distribution.Types.IncludeRenaming
......
......@@ -73,8 +73,9 @@ mkComponentsGraph enabled pkg_descr =
where
bi = componentBuildInfo component
internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)
conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr
conv (Just s) = s
conv LMainLibName = packageNameToUnqualComponentName $ packageName pkg_descr
conv (LSubLibName s) = s
-- | Given the package description and a 'PackageDescription' (used
-- to determine if a package name is internal or not), sort the
......
......@@ -41,6 +41,7 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ComponentInclude
import Distribution.Types.MungedPackageName
import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..))
......@@ -277,7 +278,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
Right instc -> [ (m, OpenModule (DefiniteUnitId uid') m')
| (m, Module uid' m') <- instc_insts instc ]
compat_name = computeCompatPackageName (packageName rc) (libName lib)
compat_name = MungedPackageName (packageName rc) (libName lib)
compat_key = computeCompatPackageKey comp compat_name (packageVersion rc) this_uid
in LibComponentLocalBuildInfo {
......
......@@ -315,4 +315,4 @@ fixFakePkgName pkg_descr pn =
else (pn, CLibName LMainLibName )
where
subLibName = packageNameToUnqualComponentName pn
internalLibraries = mapMaybe libName (allLibraries pkg_descr)
internalLibraries = mapMaybe (libraryNameString . libName) (allLibraries pkg_descr)
......@@ -5,7 +5,6 @@
module Distribution.Backpack.Id(
computeComponentId,
computeCompatPackageKey,
computeCompatPackageName,
) where
import Prelude ()
......
......@@ -46,7 +46,7 @@ ipiToPreExistingComponent :: InstalledPackageInfo -> PreExistingComponent
ipiToPreExistingComponent ipi =
PreExistingComponent {
pc_pkgname = packageName ipi,
pc_compname = libraryComponentName $ Installed.sourceLibName ipi,
pc_compname = CLibName $ Installed.sourceLibName ipi,
pc_munged_id = mungedId ipi,
pc_uid = Installed.installedUnitId ipi,
pc_cid = Installed.installedComponentId ipi,
......
......@@ -25,14 +25,15 @@ import Distribution.Types.Component
import Distribution.Types.ComponentInclude
import Distribution.Types.ComponentId
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.Types.PackageId
import Distribution.Types.PackageName.Magic
import Distribution.Types.UnitId
import Distribution.Compat.Graph (IsNode(..))
import Distribution.Types.Module
import Distribution.Types.MungedPackageId
import Distribution.Types.MungedPackageName
import Distribution.Types.Library
import Distribution.Types.LibraryName
import Distribution.ModuleName
import Distribution.Package
......@@ -140,8 +141,7 @@ rc_depends rc = ordNub $
computeCompatPackageId
(ci_pkgid ci)
(case ci_cname ci of
CLibName LMainLibName -> Nothing
CLibName (LSubLibName uqn) -> Just uqn
CLibName name -> name
_ -> error $ prettyShow (rc_cid rc) ++
" depends on non-library " ++ prettyShow (ci_id ci))
......@@ -275,7 +275,7 @@ toReadyComponents pid_map subst0 comps
fmap rc_munged_id (join (Map.lookup dep_uid s)))]
where
err_pid = MungedPackageId
(mkMungedPackageName "nonexistent-package-this-is-a-cabal-bug")
(MungedPackageName nonExistentPackageThisIsCabalBug LMainLibName)
(mkVersion [0])
instc = InstantiatedComponent {
instc_insts = Map.toList insts,
......
......@@ -52,7 +52,6 @@ import Distribution.FieldGrammar.FieldDescrs
import Distribution.ModuleName
import Distribution.Package hiding (installedPackageId, installedUnitId)
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.Utils.Generic (toUTF8BS)
import qualified Data.Map as Map
......@@ -97,10 +96,7 @@ installedPackageId = installedUnitId
-- Munging
sourceComponentName :: InstalledPackageInfo -> ComponentName
sourceComponentName ipi =
case sourceLibName ipi of
Nothing -> CLibName LMainLibName
Just qn -> CLibName $ LSubLibName qn
sourceComponentName = CLibName . sourceLibName
-- -----------------------------------------------------------------------------
-- Parsing
......
......@@ -54,6 +54,7 @@ import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.CondTree
import Distribution.Types.ExeDependency
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName
import Distribution.Utils.Generic (isAscii)
import Distribution.Verbosity
......@@ -195,7 +196,7 @@ checkSanity pkg =
PackageBuildImpossible
"No executables, libraries, tests, or benchmarks found. Nothing to do."
, check (any isNothing (map libName $ subLibraries pkg)) $
, check (any (== LMainLibName) (map libName $ subLibraries pkg)) $
PackageBuildImpossible $ "Found one or more unnamed internal libraries. "
++ "Only the non-internal library can have the same name as the package."
......@@ -236,7 +237,7 @@ checkSanity pkg =
-- The public 'library' gets special dispensation, because it
-- is common practice to export a library and name the executable
-- the same as the package.
subLibNames = catMaybes . map libName $ subLibraries pkg
subLibNames = mapMaybe (libraryNameString . libName) $ subLibraries pkg
exeNames = map exeName $ executables pkg
testNames = map testName $ testSuites pkg
bmNames = map benchmarkName $ benchmarks pkg
......@@ -254,10 +255,7 @@ checkLibrary pkg lib =
-- TODO: This check is bogus if a required-signature was passed through
, check (null (explicitLibModules lib) && null (reexportedModules lib)) $
PackageDistSuspiciousWarn $
"Library " ++ (case libName lib of
Nothing -> ""
Just n -> prettyShow n
) ++ "does not expose any modules"
showLibraryName (libName lib) ++ " does not expose any modules"
-- check use of signatures sections
, checkVersion [1,25] (not (null (signatures lib))) $
......@@ -589,7 +587,7 @@ checkFields pkg =
, isNoVersion vr ]
internalLibraries =
map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libName)
map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libraryNameString . libName)
(allLibraries pkg)
internalExecutables = map exeName $ executables pkg
......
......@@ -455,7 +455,7 @@ finalizePD userflags enabled satisfyDep
(mb_lib, comps) = flattenTaggedTargets targetSet
mb_lib' = fmap libFillInDefaults mb_lib
comps' = flip map comps $ \(n,c) -> foldComponent
(\l -> CLib (libFillInDefaults l) { libName = Just n
(\l -> CLib (libFillInDefaults l) { libName = LSubLibName n
, libExposed = False })
(\l -> CFLib (flibFillInDefaults l) { foreignLibName = n })
(\e -> CExe (exeFillInDefaults e) { exeName = n })
......@@ -541,14 +541,14 @@ flattenPackageDescription
}
where
mlib = f <$> mlib0
where f lib = (libFillInDefaults . fst . ignoreConditions $ lib) { libName = Nothing }
where f lib = (libFillInDefaults . fst . ignoreConditions $ lib) { libName = LMainLibName }
sub_libs = flattenLib <$> sub_libs0
flibs = flattenFLib <$> flibs0
exes = flattenExe <$> exes0
tests = flattenTst <$> tests0
bms = flattenBm <$> bms0
flattenLib (n, t) = libFillInDefaults $ (fst $ ignoreConditions t)
{ libName = Just n, libExposed = False }
{ libName = LSubLibName n, libExposed = False }
flattenFLib (n, t) = flibFillInDefaults $ (fst $ ignoreConditions t)
{ foreignLibName = n }
flattenExe (n, t) = exeFillInDefaults $ (fst $ ignoreConditions t)
......
......@@ -123,7 +123,7 @@ packageDescriptionFieldGrammar = PackageDescription
libraryFieldGrammar
:: (FieldGrammar g, Applicative (g Library), Applicative (g BuildInfo))
=> Maybe UnqualComponentName
=> LibraryName
-> g Library Library
libraryFieldGrammar n = Library n
<$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules
......@@ -134,16 +134,16 @@ libraryFieldGrammar n = Library n
<*> visibilityField
<*> blurFieldGrammar L.libBuildInfo buildInfoFieldGrammar
where
visibilityField
visibilityField = case n of
-- nameless/"main" libraries are public
| isNothing n = pure LibraryVisibilityPublic
LMainLibName -> pure LibraryVisibilityPublic
-- named libraries have the field
| otherwise =
LSubLibName _ ->
optionalFieldDef "visibility" L.libVisibility LibraryVisibilityPrivate
^^^ availableSince CabalSpecV3_0 LibraryVisibilityPrivate
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> ParsecFieldGrammar' Library #-}
{-# SPECIALIZE libraryFieldGrammar :: Maybe UnqualComponentName -> PrettyFieldGrammar' Library #-}
{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> ParsecFieldGrammar' Library #-}
{-# SPECIALIZE libraryFieldGrammar :: LibraryName -> PrettyFieldGrammar' Library #-}
-------------------------------------------------------------------------------
-- Foreign library
......
......@@ -267,8 +267,10 @@ goSections specVer = traverse_ process
"Multiple main libraries; have you forgotten to specify a name for an internal library?"
commonStanzas <- use stateCommonStanzas
lib <- lift $ parseCondTree' (libraryFieldGrammar Nothing) (libraryFromBuildInfo Nothing) commonStanzas fields
let name'' = LMainLibName
lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields
--
-- TODO check that not set
stateGpd . L.condLibrary ?= lib
-- Sublibraries
......@@ -276,7 +278,7 @@ goSections specVer = traverse_ process
| name == "library" = do
commonStanzas <- use stateCommonStanzas
name' <- parseUnqualComponentName pos args
let name'' = Just name'
let name'' = LSubLibName name'
lib <- lift $ parseCondTree' (libraryFieldGrammar name'') (libraryFromBuildInfo name'') commonStanzas fields
-- TODO check duplicate name here?
stateGpd . L.condSubLibraries %= snoc (name', lib)
......@@ -545,10 +547,12 @@ type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo
class L.HasBuildInfo a => FromBuildInfo a where
fromBuildInfo' :: BuildInfo -> a
libraryFromBuildInfo :: Maybe UnqualComponentName -> BuildInfo -> Library
libraryFromBuildInfo :: LibraryName -> BuildInfo -> Library
libraryFromBuildInfo n bi = emptyLibrary
{ libName = n
, libVisibility = if isNothing n then LibraryVisibilityPublic else LibraryVisibilityPrivate
, libVisibility = case n of
LMainLibName -> LibraryVisibilityPublic
LSubLibName _ -> LibraryVisibilityPrivate
, libBuildInfo = bi
}
......@@ -726,7 +730,7 @@ data Syntax = OldSyntax | NewSyntax
-- TODO:
libFieldNames :: [FieldName]
libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar Nothing)
libFieldNames = fieldGrammarKnownFieldList (libraryFieldGrammar LMainLibName)
-------------------------------------------------------------------------------
-- Suplementary build information
......
......@@ -34,6 +34,7 @@ import Prelude ()
import Distribution.Types.CondTree
import Distribution.Types.Dependency
import Distribution.Types.ForeignLib (ForeignLib (foreignLibName))
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName
import Distribution.PackageDescription
......@@ -133,12 +134,12 @@ ppCondTree2 grammar = go
ppCondLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> [PrettyField]
ppCondLibrary Nothing = mempty
ppCondLibrary (Just condTree) = pure $ PrettySection "library" [] $
ppCondTree2 (libraryFieldGrammar Nothing) condTree
ppCondTree2 (libraryFieldGrammar LMainLibName) condTree
ppCondSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [PrettyField]
ppCondSubLibraries libs =
[ PrettySection "library" [pretty n]
$ ppCondTree2 (libraryFieldGrammar $ Just n) condTree
$ ppCondTree2 (libraryFieldGrammar $ LSubLibName n) condTree
| (n, condTree) <- libs
]
......@@ -216,7 +217,7 @@ pdToGpd pd = GenericPackageDescription
-- We set CondTree's [Dependency] to an empty list, as it
-- is not pretty printed anyway.
mkCondTree x = CondNode x [] []
mkCondTreeL l = (fromMaybe (mkUnqualComponentName "") (libName l), CondNode l [] [])
mkCondTreeL l = (fromMaybe (mkUnqualComponentName "") (libraryNameString (libName l)), CondNode l [] [])
mkCondTree'
:: (a -> UnqualComponentName)
......
......@@ -454,7 +454,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
where
bi = testBuildInfo test
lib = Library {
libName = Nothing,
libName = LMainLibName,
exposedModules = [ m ],
reexportedModules = [],
signatures = [],
......@@ -465,7 +465,8 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
PackageIdentifier pkg_name pkg_ver = package pkg_descr
compat_name = computeCompatPackageName pkg_name (Just (testName test))
-- Note: we do make internal library from the test!
compat_name = MungedPackageName pkg_name (LSubLibName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
......@@ -483,7 +484,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
, componentExposedModules = [IPI.ExposedModule m Nothing]
}
pkg = pkg_descr {
package = (package pkg_descr) { pkgName = mkPackageName $ unMungedPackageName compat_name }
package = (package pkg_descr) { pkgName = mkPackageName $ prettyShow compat_name }
, executables = []
, testSuites = []
, subLibraries = [lib]
......@@ -505,7 +506,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- | The stub executable needs a new 'ComponentLocalBuildInfo'
-- that exposes the relevant test suite library.
deps = (IPI.installedUnitId ipi, mungedId ipi)
: (filter (\(_, x) -> let name = unMungedPackageName $ mungedName x
: (filter (\(_, x) -> let name = prettyShow $ mungedName x
in name == "Cabal" || name == "base")
(componentPackageDeps clbi))
exeClbi = ExeComponentLocalBuildInfo {
......
......@@ -82,13 +82,11 @@ generate pkg_descr lbi clbi =
generateComponentIdMacro lbi clbi ++
generateCurrentPackageVersion pkg_descr
where
getPid (_, MungedPackageId mpn v) =
PackageIdentifier pn v
where
-- NB: Drop the component name! We're just reporting package versions.
getPid (_, MungedPackageId (MungedPackageName pn _) v) =
-- NB: Drop the library name! We're just reporting package versions.
-- This would have to be revisited if you are allowed to depend
-- on different versions of the same package
pn = fst (decodeCompatPackageName mpn)
PackageIdentifier pn v
-- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
-- macros for a list of package ids (usually used with the specific deps of
......
......@@ -39,7 +39,6 @@ module Distribution.Simple.Configure (configure,
getInternalPackages,
computeComponentId,
computeCompatPackageKey,
computeCompatPackageName,
localBuildInfoFile,
getInstalledPackages,
getInstalledPackagesMonitorFiles,
......@@ -82,8 +81,8 @@ import Distribution.Simple.LocalBuildInfo
import Distribution.Types.ExeDependency
import Distribution.Types.LegacyExeDependency
import Distribution.Types.PkgconfigDependency
import Distribution.Types.MungedPackageName
import Distribution.Types.LocalBuildInfo
import Distribution.Types.LibraryName
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
......@@ -858,8 +857,8 @@ getInternalPackages pkg_descr0 =
-- TODO: some day, executables will be fair game here too!
let pkg_descr = flattenPackageDescription pkg_descr0
f lib = case libName lib of
Nothing -> (packageName pkg_descr, Nothing)
Just n' -> (unqualComponentNameToPackageName n', Just n')
LMainLibName -> (packageName pkg_descr, Nothing)
LSubLibName n' -> (unqualComponentNameToPackageName n', Just n')
in Map.fromList (map f (allLibraries pkg_descr))
-- | Returns true if a dependency is satisfiable. This function may
......@@ -929,11 +928,11 @@ dependencySatisfiable
installedPackageSet pn vr cn
where
cn | pn == depName
= Nothing
= LMainLibName
| otherwise
-- Reinterpret the "package name" as an unqualified component
-- name
= Just $ packageNameToUnqualComponentName depName
= LSubLibName $ packageNameToUnqualComponentName depName
-- | Finalize a generic package description. The workhorse is
-- 'finalizePD' but there's a bit of other nattering
......@@ -1230,7 +1229,7 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
-- even if there is a newer installed library "MyLibrary-0.2".
case Map.lookup dep_pkgname internalIndex of
Just cname -> if use_external_internal_deps
then do_external (Just cname) <$> Set.toList libs
then do_external (Just $ maybeToLibraryName cname) <$> Set.toList libs
else do_internal
_ -> do_external Nothing <$> Set.toList libs
where
......@@ -1240,7 +1239,7 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
$ PackageIdentifier dep_pkgname $ packageVersion pkgid]
-- We have to look it up externally
do_external :: Maybe (Maybe UnqualComponentName) -> LibraryName -> Either FailedDependency DependencyResolution
do_external :: Maybe LibraryName -> LibraryName -> Either FailedDependency DependencyResolution
do_external is_internal lib = do
ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of
-- If we know the exact pkg to use, then use it.
......@@ -1248,8 +1247,8 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
-- Otherwise we just pick an arbitrary instance of the latest version.
Nothing ->
case is_internal of
Nothing -> do_external_external
Just mb_uqn -> do_external_internal mb_uqn
Nothing -> do_external_external
Just ln -> do_external_internal ln
return $ ExternalDependency $ ipiToPreExistingComponent ipi
-- It's an external package, normal situation
......@@ -1259,9 +1258,10 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
pkgs -> Right $ head $ snd $ last pkgs
-- It's an internal library, being looked up externally
do_external_internal mb_uqn =
do_external_internal :: LibraryName -> Either FailedDependency InstalledPackageInfo
do_external_internal ln =
case PackageIndex.lookupInternalDependency installedIndex
(packageName pkgid) vr mb_uqn of
(packageName pkgid) vr ln of
[] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid))
pkgs -> Right $ head $ snd $ last pkgs
......
......@@ -274,7 +274,9 @@ haddock pkg_descr lbi suffixes flags' = do
runHaddock verbosity tmpFileOpts comp platform haddockProg libArgs'
case libName lib of
Just _ -> do
LMainLibName ->
pure index
LSubLibName _ -> do
pwd <- getCurrentDirectory
let
......@@ -292,8 +294,6 @@ haddock pkg_descr lbi suffixes flags' = do
}
return $ PackageIndex.insert ipi index
Nothing ->
pure index
CFLib flib -> (when (flag haddockForeignLibs) $ do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi') "tmp" $
......
......@@ -165,8 +165,8 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
buildPref = componentBuildDir lbi clbi
case libName lib of
Nothing -> noticeNoWrap verbosity ("Installing library in " ++ libPref)
Just n -> noticeNoWrap verbosity ("Installing internal library " ++ prettyShow n ++ " in " ++ libPref)
LMainLibName -> noticeNoWrap verbosity ("Installing library in " ++ libPref)
LSubLibName n -> noticeNoWrap verbosity ("Installing internal library " ++ prettyShow n ++ " in " ++ libPref)
-- install include files for all compilers - they may be needed to compile
-- haskell files (using the CPP extension)
......
......@@ -109,7 +109,7 @@ import Distribution.ModuleName
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Version
import Distribution.Simple.Utils
import Distribution.Types.UnqualComponentName
import Distribution.Types.LibraryName
import Control.Exception (assert)
import Data.Array ((!))
......@@ -143,7 +143,7 @@ data PackageIndex a = PackageIndex {
--
-- FIXME: Clarify what "preference order" means. Check that this invariant is
-- preserved. See #1463 for discussion.
packageIdIndex :: !(Map (PackageName, Maybe UnqualComponentName) (Map Version [a]))
packageIdIndex :: !(Map (PackageName, LibraryName) (Map Version [a]))
} deriving (Eq, Generic, Show, Read)
......@@ -195,7 +195,7 @@ invariant (PackageIndex pids pnames) =
--
mkPackageIndex :: WithCallStack (Map UnitId IPI.InstalledPackageInfo
-> Map (PackageName, Maybe UnqualComponentName)
-> Map (PackageName, LibraryName)
(Map Version [IPI.InstalledPackageInfo])
-> InstalledPackageIndex)
mkPackageIndex pids pnames = assert (invariant index) index
......@@ -314,7 +314,7 @@ deleteSourcePackageId :: PackageId -> InstalledPackageIndex
-> InstalledPackageIndex
deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
-- NB: Doesn't delete internal packages
case Map.lookup (packageName pkgid, Nothing) pnames of
case Map.lookup (packageName pkgid, LMainLibName) pnames of
Nothing -> original
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> original
......@@ -323,7 +323,7 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
(deletePkgName pnames)
where
deletePkgName =
Map.update deletePkgVersion (packageName pkgid, Nothing)
Map.update deletePkgVersion (packageName pkgid, LMainLibName)
deletePkgVersion =
(\m -> if Map.null m then Nothing else Just m)
......@@ -337,12 +337,12 @@ deleteSourcePackageId pkgid original@(PackageIndex pids pnames) =
deletePackageName :: PackageName -> InstalledPackageIndex
-> InstalledPackageIndex
deletePackageName name original@(PackageIndex pids pnames) =
case Map.lookup (name, Nothing) pnames of
case Map.lookup (name, LMainLibName) pnames of
Nothing -> original
Just pvers -> mkPackageIndex
(foldl' (flip (Map.delete . installedUnitId)) pids
(concat (Map.elems pvers)))
(Map.delete (name, Nothing) pnames)
(Map.delete (name, LMainLibName) pnames)
{-
-- | Removes all packages satisfying this dependency from the index.
......@@ -370,7 +370,7 @@ allPackages = Map.elems . unitIdIndex
allPackagesByName :: PackageIndex a -> [(PackageName, [a])]
allPackagesByName index =
[ (pkgname, concat (Map.elems pvers))
| ((pkgname, Nothing), pvers) <- Map.toList (packageIdIndex index) ]
| ((pkgname, LMainLibName), pvers) <- Map.toList (packageIdIndex index) ]
-- | Get all the packages from the index.
--
......@@ -382,7 +382,7 @@ allPackagesBySourcePackageId :: HasUnitId a => PackageIndex a
-> [(PackageId, [a])]
allPackagesBySourcePackageId index =
[ (packageId ipkg, ipkgs)
| ((_, Nothing), pvers) <- Map.toList (packageIdIndex index)
| ((_, LMainLibName), pvers) <- Map.toList (packageIdIndex index)
, ipkgs@(ipkg:_) <- Map.elems pvers ]
-- | Get all the packages from the index.
......@@ -391,7 +391,7 @@ allPackagesBySourcePackageId index =
--
-- This DOES include internal libraries.
allPackagesBySourcePackageIdAndLibName :: HasUnitId a => PackageIndex a
-> [((PackageId, Maybe UnqualComponentName), [a])]
-> [((PackageId, LibraryName), [a])]
allPackagesBySourcePackageIdAndLibName index =
[ ((packageId ipkg, ln), ipkgs)
| ((_, ln), pvers) <- Map.toList (packageIdIndex index)
......@@ -434,7 +434,7 @@ lookupInstalledPackageId = lookupUnitId
lookupSourcePackageId :: PackageIndex a -> PackageId -> [a]
lookupSourcePackageId index pkgid =
-- Do not lookup internal libraries
case Map.lookup (packageName pkgid, Nothing) (packageIdIndex index) of
case Map.lookup (packageName pkgid, LMainLibName) (packageIdIndex index) of
Nothing -> []
Just pvers -> case Map.lookup (packageVersion pkgid) pvers of
Nothing -> []
......@@ -454,7 +454,7 @@ lookupPackageName :: PackageIndex a -> PackageName
-> [(Version, [a])]
lookupPackageName index name =
-- Do not match internal libraries
case Map.lookup (name, Nothing) (packageIdIndex index) of
case Map.lookup (name, LMainLibName) (packageIdIndex index) of
Nothing -> []
Just pvers -> Map.toList pvers
......@@ -473,7 +473,7 @@ lookupDependency :: InstalledPackageIndex -> PackageName -> VersionRange
-> [(Version, [IPI.InstalledPackageInfo])]
lookupDependency index pn vr =
-- Yes, a little bit of a misnomer here!
lookupInternalDependency index pn vr Nothing
lookupInternalDependency index pn vr LMainLibName
-- | Does a lookup by source package name and a range of versions.
--
......@@ -483,7 +483,7 @@ lookupDependency index pn vr =
-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.
--
lookupInternalDependency :: InstalledPackageIndex -> PackageName -> VersionRange
-> Maybe UnqualComponentName
-> LibraryName
-> [(Version, [IPI.InstalledPackageInfo])]
lookupInternalDependency index name versionRange libn =
case Map.lookup (name, libn) (packageIdIndex index) of
......@@ -522,7 +522,7 @@ lookupInternalDependency index name versionRange libn =
searchByName :: PackageIndex a -> String -> SearchResult [a]
searchByName index name =
-- Don't match internal packages
case [ pkgs | pkgs@((pname, Nothing),_) <- Map.toList (packageIdIndex index)
case [ pkgs | pkgs@((pname, LMainLibName),_) <- Map.toList (packageIdIndex index)
, lowercase (unPackageName pname) == lname ] of
[] -> None
[(_,pvers)] -> Unambiguous (concat (Map.elems pvers))
......@@ -541,7 +541,7 @@ searchByNameSubstring :: PackageIndex a -> String -> [a]
searchByNameSubstring index searchterm =
[ pkg
-- Don't match internal packages
| ((pname, Nothing), pvers) <- Map.toList (packageIdIndex index)
| ((pname, LMainLibName), pvers) <- Map.toList (packageIdIndex index)