diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 6d95efd2913..320735ce4d3 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -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 diff --git a/Cabal/Distribution/Backpack/ComponentsGraph.hs b/Cabal/Distribution/Backpack/ComponentsGraph.hs index d69f4a6bf21..8a19180e1f1 100644 --- a/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -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 diff --git a/Cabal/Distribution/Backpack/Configure.hs b/Cabal/Distribution/Backpack/Configure.hs index ade16c84c58..927570f82ea 100644 --- a/Cabal/Distribution/Backpack/Configure.hs +++ b/Cabal/Distribution/Backpack/Configure.hs @@ -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 { diff --git a/Cabal/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/Distribution/Backpack/ConfiguredComponent.hs index 79922758315..75f16c1eaa1 100644 --- a/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -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) diff --git a/Cabal/Distribution/Backpack/Id.hs b/Cabal/Distribution/Backpack/Id.hs index e2995b21e8f..b5e14a60ba5 100644 --- a/Cabal/Distribution/Backpack/Id.hs +++ b/Cabal/Distribution/Backpack/Id.hs @@ -5,7 +5,6 @@ module Distribution.Backpack.Id( computeComponentId, computeCompatPackageKey, - computeCompatPackageName, ) where import Prelude () diff --git a/Cabal/Distribution/Backpack/PreExistingComponent.hs b/Cabal/Distribution/Backpack/PreExistingComponent.hs index b1ed9626a1c..2fcfdf1cc83 100644 --- a/Cabal/Distribution/Backpack/PreExistingComponent.hs +++ b/Cabal/Distribution/Backpack/PreExistingComponent.hs @@ -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, diff --git a/Cabal/Distribution/Backpack/ReadyComponent.hs b/Cabal/Distribution/Backpack/ReadyComponent.hs index 3591e9e1d08..952c9e7d3e2 100644 --- a/Cabal/Distribution/Backpack/ReadyComponent.hs +++ b/Cabal/Distribution/Backpack/ReadyComponent.hs @@ -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, diff --git a/Cabal/Distribution/InstalledPackageInfo.hs b/Cabal/Distribution/InstalledPackageInfo.hs index 127152f8916..acf0d7e04d0 100644 --- a/Cabal/Distribution/InstalledPackageInfo.hs +++ b/Cabal/Distribution/InstalledPackageInfo.hs @@ -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 diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 01bffb23dff..9ce93be61d9 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -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 diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index cdfb9f44714..264c1d4b896 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -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) diff --git a/Cabal/Distribution/PackageDescription/FieldGrammar.hs b/Cabal/Distribution/PackageDescription/FieldGrammar.hs index 80d582d789d..5ff2aa6dc92 100644 --- a/Cabal/Distribution/PackageDescription/FieldGrammar.hs +++ b/Cabal/Distribution/PackageDescription/FieldGrammar.hs @@ -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 diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index fd24a8ff4bf..6cef5468eaf 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -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 diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index 1091c080970..67233a934c4 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -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) diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 30fc3583319..58f01197360 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -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 { diff --git a/Cabal/Distribution/Simple/Build/Macros.hs b/Cabal/Distribution/Simple/Build/Macros.hs index 52c7ffaa75b..88040ea9cb2 100644 --- a/Cabal/Distribution/Simple/Build/Macros.hs +++ b/Cabal/Distribution/Simple/Build/Macros.hs @@ -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 diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 0b8663e53ae..732753d8013 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -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 diff --git a/Cabal/Distribution/Simple/Haddock.hs b/Cabal/Distribution/Simple/Haddock.hs index e7cc4bb7b39..6fdcb1650c0 100644 --- a/Cabal/Distribution/Simple/Haddock.hs +++ b/Cabal/Distribution/Simple/Haddock.hs @@ -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" $ diff --git a/Cabal/Distribution/Simple/Install.hs b/Cabal/Distribution/Simple/Install.hs index b13adfa8f14..264b26fba23 100644 --- a/Cabal/Distribution/Simple/Install.hs +++ b/Cabal/Distribution/Simple/Install.hs @@ -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) diff --git a/Cabal/Distribution/Simple/PackageIndex.hs b/Cabal/Distribution/Simple/PackageIndex.hs index 550f8a79a13..4357d12928b 100644 --- a/Cabal/Distribution/Simple/PackageIndex.hs +++ b/Cabal/Distribution/Simple/PackageIndex.hs @@ -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) , lsearchterm `isInfixOf` lowercase (unPackageName pname) , pkgs <- Map.elems pvers , pkg <- pkgs ] @@ -667,7 +667,7 @@ dependencyGraph index = (graph, vertex_to_pkg, id_to_vertex) -- | We maintain the invariant that, for any 'DepUniqueKey', there -- is only one instance of the package in our database. -type DepUniqueKey = (PackageName, Maybe UnqualComponentName, Map ModuleName OpenModule) +type DepUniqueKey = (PackageName, LibraryName, Map ModuleName OpenModule) -- | Given a package index where we assume we want to use all the packages -- (use 'dependencyClosure' if you need to get such a index subset) find out diff --git a/Cabal/Distribution/Simple/PreProcess.hs b/Cabal/Distribution/Simple/PreProcess.hs index d63dee37385..e003dae21e5 100644 --- a/Cabal/Distribution/Simple/PreProcess.hs +++ b/Cabal/Distribution/Simple/PreProcess.hs @@ -54,6 +54,7 @@ import Distribution.Pretty import Distribution.Version import Distribution.Verbosity import Distribution.Types.ForeignLib +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import System.Directory (doesFileExist) @@ -748,7 +749,7 @@ preprocessExtras verbosity comp lbi = case comp of component_dirs = component_names (localPkgDescr lbi) -- TODO: libify me component_names pkg_descr = fmap unUnqualComponentName $ - mapMaybe libName (subLibraries pkg_descr) ++ + mapMaybe (libraryNameString . libName) (subLibraries pkg_descr) ++ map exeName (executables pkg_descr) ++ map testName (testSuites pkg_descr) ++ map benchmarkName (benchmarks pkg_descr) diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 2eca6c59830..b63bd810579 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -80,7 +80,6 @@ import Distribution.Simple.Utils import Distribution.Utils.MapAccum import Distribution.System import Distribution.Pretty -import Distribution.Types.ComponentName import Distribution.Verbosity as Verbosity import Distribution.Version import Distribution.Compat.Graph (IsNode(nodeKey)) @@ -157,7 +156,7 @@ registerAll pkg lbi regFlags ipis for_ ipis $ \installedPkgInfo -> -- Only print the public library's IPI when (packageId installedPkgInfo == packageId pkg - && IPI.sourceLibName installedPkgInfo == Nothing) $ + && IPI.sourceLibName installedPkgInfo == LMainLibName) $ putStrLn (prettyShow (IPI.installedUnitId installedPkgInfo)) -- Three different modes: @@ -167,7 +166,7 @@ registerAll pkg lbi regFlags ipis | otherwise -> do for_ ipis $ \ipi -> do setupMessage' verbosity "Registering" (packageId pkg) - (libraryComponentName (IPI.sourceLibName ipi)) + (CLibName (IPI.sourceLibName ipi)) (Just (IPI.instantiatedWith ipi)) registerPackage verbosity (compiler lbi) (withPrograms lbi) packageDbs ipi HcPkg.defaultRegisterOptions diff --git a/Cabal/Distribution/Types/Component.hs b/Cabal/Distribution/Types/Component.hs index e8eba2e6313..c45597dd328 100644 --- a/Cabal/Distribution/Types/Component.hs +++ b/Cabal/Distribution/Types/Component.hs @@ -73,7 +73,7 @@ componentBuildable = buildable . componentBuildInfo componentName :: Component -> ComponentName componentName = - foldComponent (libraryComponentName . libName) + foldComponent (CLibName . libName) (CFLibName . foreignLibName) (CExeName . exeName) (CTestName . testName) diff --git a/Cabal/Distribution/Types/ComponentName.hs b/Cabal/Distribution/Types/ComponentName.hs index fdc0f0ab249..76c9a55389c 100644 --- a/Cabal/Distribution/Types/ComponentName.hs +++ b/Cabal/Distribution/Types/ComponentName.hs @@ -3,7 +3,6 @@ module Distribution.Types.ComponentName ( ComponentName(..), - libraryComponentName, showComponentName, componentNameStanza, componentNameString, @@ -32,7 +31,7 @@ instance Binary ComponentName -- Build-target-ish syntax instance Pretty ComponentName where - pretty (CLibName lib) = pretty lib + pretty (CLibName lib) = prettyLibraryNameComponent lib pretty (CFLibName str) = Disp.text "flib:" <<>> pretty str pretty (CExeName str) = Disp.text "exe:" <<>> pretty str pretty (CTestName str) = Disp.text "test:" <<>> pretty str @@ -42,7 +41,7 @@ instance Parsec ComponentName where -- note: this works as lib/flib/... all start with different character! parsec = parseComposite <|> parseLib where - parseLib = CLibName <$> parsec + parseLib = CLibName <$> parsecLibraryNameComponent parseComposite = do ctor <- P.choice [ P.string "flib:" >> return CFLibName @@ -76,9 +75,3 @@ componentNameString (CFLibName n) = Just n componentNameString (CExeName n) = Just n componentNameString (CTestName n) = Just n componentNameString (CBenchName n) = Just n - --- | Convert the 'UnqualComponentName' of a library into a --- 'ComponentName'. -libraryComponentName :: Maybe UnqualComponentName -> ComponentName -libraryComponentName Nothing = CLibName LMainLibName -libraryComponentName (Just n) = CLibName $ LSubLibName n diff --git a/Cabal/Distribution/Types/InstalledPackageInfo.hs b/Cabal/Distribution/Types/InstalledPackageInfo.hs index 9a375f53e9b..ab896c5502d 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo.hs @@ -14,17 +14,17 @@ import Distribution.Compat.Prelude import Prelude () import Distribution.Backpack -import Distribution.Compat.Graph (IsNode (..)) +import Distribution.Compat.Graph (IsNode (..)) import Distribution.License import Distribution.ModuleName -import Distribution.Package hiding (installedUnitId) +import Distribution.Package hiding (installedUnitId) import Distribution.Types.AbiDependency import Distribution.Types.ExposedModule +import Distribution.Types.LibraryName import Distribution.Types.LibraryVisibility import Distribution.Types.MungedPackageId import Distribution.Types.MungedPackageName -import Distribution.Types.UnqualComponentName -import Distribution.Version (nullVersion) +import Distribution.Version (nullVersion) import qualified Distribution.Package as Package import qualified Distribution.SPDX as SPDX @@ -39,7 +39,7 @@ data InstalledPackageInfo -- these parts (sourcePackageId, installedUnitId) are -- exactly the same as PackageDescription sourcePackageId :: PackageId, - sourceLibName :: Maybe UnqualComponentName, + sourceLibName :: LibraryName, installedComponentId_ :: ComponentId, installedUnitId :: UnitId, -- INVARIANT: if this package is definite, OpenModule's @@ -120,16 +120,13 @@ mungedPackageId ipi = -- | Returns the munged package name, which we write into @name@ for -- compatibility with old versions of GHC. mungedPackageName :: InstalledPackageInfo -> MungedPackageName -mungedPackageName ipi = - computeCompatPackageName - (packageName ipi) - (sourceLibName ipi) +mungedPackageName ipi = MungedPackageName (packageName ipi) (sourceLibName ipi) emptyInstalledPackageInfo :: InstalledPackageInfo emptyInstalledPackageInfo = InstalledPackageInfo { sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion, - sourceLibName = Nothing, + sourceLibName = LMainLibName, installedComponentId_ = mkComponentId "", installedUnitId = mkUnitId "", instantiatedWith = [], diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index 57b749ac6d2..e2a27b6a423 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -23,6 +23,7 @@ import Distribution.Parsec.Newtypes import Distribution.Pretty import Distribution.Types.LibraryVisibility import Distribution.Types.MungedPackageName +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName import Distribution.Version @@ -107,10 +108,10 @@ ipiFieldGrammar = mkInstalledPackageInfo -- _basicPkgName is not used -- setMaybePackageId says it can be no-op. (PackageIdentifier pn _basicVersion) - (mb_uqn <|> _basicLibName) + (combineLibraryName ln _basicLibName) (mkComponentId "") -- installedComponentId_, not in use where - (pn, mb_uqn) = decodeCompatPackageName _basicName + MungedPackageName pn ln = _basicName {-# SPECIALIZE ipiFieldGrammar :: FieldDescrs InstalledPackageInfo InstalledPackageInfo #-} {-# SPECIALIZE ipiFieldGrammar :: ParsecFieldGrammar InstalledPackageInfo InstalledPackageInfo #-} {-# SPECIALIZE ipiFieldGrammar :: PrettyFieldGrammar InstalledPackageInfo InstalledPackageInfo #-} @@ -123,6 +124,14 @@ unitedList f s = s <$ f [] -- Helper functions ------------------------------------------------------------------------------- +-- | Combine 'LibraryName'. in parsing we prefer value coming +-- from munged @name@ field over the @lib-name@. +-- +-- /Should/ be irrelevant. +combineLibraryName :: LibraryName -> LibraryName -> LibraryName +combineLibraryName l@(LSubLibName _) _ = l +combineLibraryName _ l = l + -- To maintain backwards-compatibility, we accept both comma/non-comma -- separated variants of this field. You SHOULD use the comma syntax if you -- use any new functions, although actually it's unambiguous due to a quirk @@ -135,30 +144,27 @@ showExposedModules xs where isExposedModule (ExposedModule _ Nothing) = True isExposedModule _ = False --- | Returns @Just@ if the @name@ field of the IPI record would not contain --- the package name verbatim. This helps us avoid writing @package-name@ --- when it's redundant. -maybePackageName :: InstalledPackageInfo -> Maybe PackageName -maybePackageName ipi = - case sourceLibName ipi of - Nothing -> Nothing - Just _ -> Just (packageName ipi) - -- | Setter for the @package-name@ field. It should be acceptable for this -- to be a no-op. setMaybePackageName :: Maybe PackageName -> InstalledPackageInfo -> InstalledPackageInfo -setMaybePackageName Nothing ipi = ipi -setMaybePackageName (Just pn) ipi = ipi { - sourcePackageId=(sourcePackageId ipi){pkgName=pn} +setMaybePackageName Nothing ipi = ipi +setMaybePackageName (Just pn) ipi = ipi + { sourcePackageId = (sourcePackageId ipi) {pkgName=pn} } setMungedPackageName :: MungedPackageName -> InstalledPackageInfo -> InstalledPackageInfo -setMungedPackageName mpn ipi = - let (pn, mb_uqn) = decodeCompatPackageName mpn - in ipi { - sourcePackageId = (sourcePackageId ipi) {pkgName=pn}, - sourceLibName = mb_uqn - } +setMungedPackageName (MungedPackageName pn ln) ipi = ipi + { sourcePackageId = (sourcePackageId ipi) {pkgName=pn} + , sourceLibName = ln + } + +--- | Returns @Just@ if the @name@ field of the IPI record would not contain +--- the package name verbatim. This helps us avoid writing @package-name@ +--- when it's redundant. +maybePackageName :: InstalledPackageInfo -> Maybe PackageName +maybePackageName ipi = case sourceLibName ipi of + LMainLibName -> Nothing + LSubLibName _ -> Just (packageName ipi) ------------------------------------------------------------------------------- -- Auxiliary types @@ -217,12 +223,18 @@ instance Parsec SpecLicenseLenient where instance Pretty SpecLicenseLenient where pretty = either pretty pretty . unpack +------------------------------------------------------------------------------- +-- Basic fields +------------------------------------------------------------------------------- +-- | This type is used to mangle fields as +-- in serialised textual representation +-- to the actual 'InstalledPackageInfo' fields. data Basic = Basic { _basicName :: MungedPackageName , _basicVersion :: Version , _basicPkgName :: Maybe PackageName - , _basicLibName :: Maybe UnqualComponentName + , _basicLibName :: LibraryName } basic :: Lens' InstalledPackageInfo Basic @@ -253,14 +265,17 @@ basicPkgName f b = (\x -> b { _basicPkgName = x }) <$> f (_basicPkgName b) {-# INLINE basicPkgName #-} basicLibName :: Lens' Basic (Maybe UnqualComponentName) -basicLibName f b = (\x -> b { _basicLibName = x }) <$> f (_basicLibName b) +basicLibName f b = (\x -> b { _basicLibName = maybeToLibraryName x }) <$> + f (libraryNameString (_basicLibName b)) {-# INLINE basicLibName #-} basicFieldGrammar :: (FieldGrammar g, Applicative (g Basic)) => g Basic Basic -basicFieldGrammar = Basic +basicFieldGrammar = mkBasic <$> optionalFieldDefAla "name" MQuoted basicName (mungedPackageName emptyInstalledPackageInfo) <*> optionalFieldDefAla "version" MQuoted basicVersion nullVersion <*> optionalField "package-name" basicPkgName <*> optionalField "lib-name" basicLibName + where + mkBasic n v pn ln = Basic n v pn (maybe LMainLibName LSubLibName ln) diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs index 07f5fa8befd..a59c0985313 100644 --- a/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/Cabal/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -12,8 +12,8 @@ import Distribution.License (License) import Distribution.ModuleName (ModuleName) import Distribution.Package (AbiHash, ComponentId, PackageIdentifier, UnitId) import Distribution.Types.InstalledPackageInfo (AbiDependency, ExposedModule, InstalledPackageInfo) +import Distribution.Types.LibraryName (LibraryName) import Distribution.Types.LibraryVisibility (LibraryVisibility) -import Distribution.Types.UnqualComponentName (UnqualComponentName) import qualified Distribution.SPDX as SPDX import qualified Distribution.Types.InstalledPackageInfo as T @@ -34,7 +34,7 @@ instantiatedWith :: Lens' InstalledPackageInfo [(ModuleName,OpenModule)] instantiatedWith f s = fmap (\x -> s { T.instantiatedWith = x }) (f (T.instantiatedWith s)) {-# INLINE instantiatedWith #-} -sourceLibName :: Lens' InstalledPackageInfo (Maybe UnqualComponentName) +sourceLibName :: Lens' InstalledPackageInfo LibraryName sourceLibName f s = fmap (\x -> s { T.sourceLibName = x }) (f (T.sourceLibName s)) {-# INLINE sourceLibName #-} diff --git a/Cabal/Distribution/Types/Library.hs b/Cabal/Distribution/Types/Library.hs index 3a57a9e0375..b7ff72456f4 100644 --- a/Cabal/Distribution/Types/Library.hs +++ b/Cabal/Distribution/Types/Library.hs @@ -16,12 +16,12 @@ import Distribution.ModuleName import Distribution.Types.BuildInfo import Distribution.Types.LibraryVisibility import Distribution.Types.ModuleReexport -import Distribution.Types.UnqualComponentName +import Distribution.Types.LibraryName import qualified Distribution.Types.BuildInfo.Lens as L data Library = Library - { libName :: Maybe UnqualComponentName + { libName :: LibraryName , exposedModules :: [ModuleName] , reexportedModules :: [ModuleReexport] , signatures :: [ModuleName] -- ^ What sigs need implementations? @@ -40,7 +40,7 @@ instance NFData Library where rnf = genericRnf emptyLibrary :: Library emptyLibrary = Library - { libName = mempty + { libName = LMainLibName , exposedModules = mempty , reexportedModules = mempty , signatures = mempty @@ -63,7 +63,7 @@ instance Monoid Library where instance Semigroup Library where a <> b = Library - { libName = combine libName + { libName = combineLibraryName (libName a) (libName b) , exposedModules = combine exposedModules , reexportedModules = combine reexportedModules , signatures = combine signatures @@ -97,3 +97,11 @@ libModulesAutogen lib = autogenModules (libBuildInfo lib) {-# DEPRECATED libModules "If you want all modules that are built with a library, use 'allLibModules'. Otherwise, use 'explicitLibModules' for ONLY the modules explicitly mentioned in the package description. This symbol will be removed in Cabal-3.0 (est. Mar 2019)." #-} libModules :: Library -> [ModuleName] libModules = explicitLibModules + +-- | Combine 'LibraryName'. in parsing we prefer value coming +-- from munged @name@ field over the @lib-name@. +-- +-- /Should/ be irrelevant. +combineLibraryName :: LibraryName -> LibraryName -> LibraryName +combineLibraryName l@(LSubLibName _) _ = l +combineLibraryName _ l = l diff --git a/Cabal/Distribution/Types/Library/Lens.hs b/Cabal/Distribution/Types/Library/Lens.hs index bd40c1a2a65..fefccbdd1a3 100644 --- a/Cabal/Distribution/Types/Library/Lens.hs +++ b/Cabal/Distribution/Types/Library/Lens.hs @@ -7,16 +7,16 @@ import Distribution.Compat.Lens import Distribution.Compat.Prelude import Prelude () -import Distribution.ModuleName (ModuleName) -import Distribution.Types.BuildInfo (BuildInfo) -import Distribution.Types.Library (Library) -import Distribution.Types.LibraryVisibility (LibraryVisibility) -import Distribution.Types.ModuleReexport (ModuleReexport) -import Distribution.Types.UnqualComponentName (UnqualComponentName) +import Distribution.ModuleName (ModuleName) +import Distribution.Types.BuildInfo (BuildInfo) +import Distribution.Types.Library (Library) +import Distribution.Types.LibraryName (LibraryName) +import Distribution.Types.LibraryVisibility (LibraryVisibility) +import Distribution.Types.ModuleReexport (ModuleReexport) import qualified Distribution.Types.Library as T -libName :: Lens' Library (Maybe UnqualComponentName) +libName :: Lens' Library LibraryName libName f s = fmap (\x -> s { T.libName = x }) (f (T.libName s)) {-# INLINE libName #-} diff --git a/Cabal/Distribution/Types/LibraryName.hs b/Cabal/Distribution/Types/LibraryName.hs index e320d956e9e..ff37976d302 100644 --- a/Cabal/Distribution/Types/LibraryName.hs +++ b/Cabal/Distribution/Types/LibraryName.hs @@ -8,6 +8,9 @@ module Distribution.Types.LibraryName ( showLibraryName, libraryNameStanza, libraryNameString, + -- * Pretty & Parse + prettyLibraryNameComponent, + parsecLibraryNameComponent, ) where import Prelude () @@ -27,20 +30,24 @@ data LibraryName = LMainLibName instance Binary LibraryName instance NFData LibraryName where rnf = genericRnf --- Build-target-ish syntax -instance Pretty LibraryName where - pretty LMainLibName = Disp.text "lib" - pretty (LSubLibName str) = Disp.text "lib:" <<>> pretty str +-- | Pretty print 'LibraryName' in build-target-ish syntax. +-- +-- /Note:/ there are no 'Pretty' or 'Parsec' instances, +-- as there's other way to represent 'LibraryName', namely as bare +-- 'UnqualComponentName'. +prettyLibraryNameComponent :: LibraryName -> Disp.Doc +prettyLibraryNameComponent LMainLibName = Disp.text "lib" +prettyLibraryNameComponent (LSubLibName str) = Disp.text "lib:" <<>> pretty str -instance Parsec LibraryName where - parsec = do - _ <- P.string "lib" - parseComposite <|> parseSingle - where - parseSingle = return LMainLibName - parseComposite = do - _ <- P.char ':' - LSubLibName <$> parsec +parsecLibraryNameComponent :: CabalParsing m => m LibraryName +parsecLibraryNameComponent = do + _ <- P.string "lib" + parseComposite <|> parseSingle + where + parseSingle = return LMainLibName + parseComposite = do + _ <- P.char ':' + LSubLibName <$> parsec defaultLibName :: LibraryName defaultLibName = LMainLibName diff --git a/Cabal/Distribution/Types/MungedPackageId.hs b/Cabal/Distribution/Types/MungedPackageId.hs index 3fd7faad82d..f10e2594d1c 100644 --- a/Cabal/Distribution/Types/MungedPackageId.hs +++ b/Cabal/Distribution/Types/MungedPackageId.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module Distribution.Types.MungedPackageId ( MungedPackageId(..) , computeCompatPackageId @@ -10,13 +10,12 @@ import Prelude () import Distribution.Parsec import Distribution.Pretty +import Distribution.Types.LibraryName import Distribution.Types.MungedPackageName import Distribution.Types.PackageId -import Distribution.Types.UnqualComponentName -import Distribution.Version (Version, nullVersion) +import Distribution.Version (Version, nullVersion) -import qualified Distribution.Compat.CharParsing as P -import qualified Text.PrettyPrint as Disp +import qualified Text.PrettyPrint as Disp -- | A simple pair of a 'MungedPackageName' and 'Version'. 'MungedPackageName' is to -- 'MungedPackageId' as 'PackageName' is to 'PackageId'. See 'MungedPackageName' for more @@ -33,22 +32,51 @@ data MungedPackageId instance Binary MungedPackageId +-- | +-- +-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" LMainLibName) (mkVersion [1,2,3]) +-- "servant-1.2.3" +-- +-- >>> prettyShow $ MungedPackageId (MungedPackageName "servant" (LSubLibName "lackey")) (mkVersion [0,1,2]) +-- "z-servant-z-lackey-0.1.2" +-- instance Pretty MungedPackageId where pretty (MungedPackageId n v) | v == nullVersion = pretty n -- if no version, don't show version. | otherwise = pretty n <<>> Disp.char '-' <<>> pretty v +-- | +-- +-- >>> simpleParsec "foo-bar-0" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") LMainLibName, mungedVersion = mkVersion [0]}) +-- +-- >>> simpleParsec "foo-bar" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") LMainLibName, mungedVersion = mkVersion []}) +-- +-- >>> simpleParsec "z-foo-bar-z-baz-0" :: Maybe MungedPackageId +-- Just (MungedPackageId {mungedName = MungedPackageName (PackageName "foo-bar") (LSubLibName (UnqualComponentName "baz")), mungedVersion = mkVersion [0]}) +-- +-- >>> simpleParsec "foo-bar-0-0" :: Maybe MungedPackageId +-- Nothing +-- +-- >>> simpleParsec "foo-bar.0" :: Maybe MungedPackageId +-- Nothing +-- +-- >>> simpleParsec "foo-bar.4-2" :: Maybe MungedPackageId +-- Nothing +-- instance Parsec MungedPackageId where parsec = do - n <- parsec - v <- (P.char '-' >> parsec) <|> return nullVersion - return (MungedPackageId n v) + PackageIdentifier pn v <- parsec + return $ MungedPackageId (decodeCompatPackageName pn) v instance NFData MungedPackageId where rnf (MungedPackageId name version) = rnf name `seq` rnf version --- | See docs for 'Distribution.Types.MungedPackageName.computeCompatPackageId'. this --- is a thin wrapper around that. -computeCompatPackageId :: PackageId -> Maybe UnqualComponentName -> MungedPackageId -computeCompatPackageId (PackageIdentifier pn vr) mb_uqn = MungedPackageId pn' vr - where pn' = computeCompatPackageName pn mb_uqn +computeCompatPackageId :: PackageId -> LibraryName -> MungedPackageId +computeCompatPackageId (PackageIdentifier pn vr) ln = + MungedPackageId (MungedPackageName pn ln) vr + +-- $setup +-- >>> :seti -XOverloadedStrings +-- >>> import Distribution.Types.Version diff --git a/Cabal/Distribution/Types/MungedPackageName.hs b/Cabal/Distribution/Types/MungedPackageName.hs index b657061c54c..1efa01e47e0 100644 --- a/Cabal/Distribution/Types/MungedPackageName.hs +++ b/Cabal/Distribution/Types/MungedPackageName.hs @@ -1,17 +1,17 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Distribution.Types.MungedPackageName - ( MungedPackageName, unMungedPackageName, mkMungedPackageName - , computeCompatPackageName + ( MungedPackageName (..) , decodeCompatPackageName + , encodeCompatPackageName ) where import Distribution.Compat.Prelude -import Distribution.Utils.ShortText import Prelude () import Distribution.Parsec import Distribution.Pretty +import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName @@ -26,41 +26,15 @@ import qualified Text.PrettyPrint as Disp -- -- Use 'mkMungedPackageName' and 'unMungedPackageName' to convert from/to a 'String'. -- --- @since 2.0.0.2 -newtype MungedPackageName = MungedPackageName ShortText - deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) - --- | Convert 'MungedPackageName' to 'String' -unMungedPackageName :: MungedPackageName -> String -unMungedPackageName (MungedPackageName s) = fromShortText s - --- | Construct a 'MungedPackageName' from a 'String' --- --- 'mkMungedPackageName' is the inverse to 'unMungedPackageName' --- --- Note: No validations are performed to ensure that the resulting --- 'MungedPackageName' is valid +-- In @3.0.0.0@ representation was changed from opaque (string) to semantic representation. -- -- @since 2.0.0.2 -mkMungedPackageName :: String -> MungedPackageName -mkMungedPackageName = MungedPackageName . toShortText - --- | 'mkMungedPackageName' -- --- @since 2.0.0.2 -instance IsString MungedPackageName where - fromString = mkMungedPackageName +data MungedPackageName = MungedPackageName !PackageName !LibraryName + deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) instance Binary MungedPackageName - -instance Pretty MungedPackageName where - pretty = Disp.text . unMungedPackageName - -instance Parsec MungedPackageName where - parsec = mkMungedPackageName <$> parsecUnqualComponentName - -instance NFData MungedPackageName where - rnf (MungedPackageName pkg) = rnf pkg +instance NFData MungedPackageName where rnf = genericRnf -- | Computes the package name for a library. If this is the public -- library, it will just be the original package name; otherwise, @@ -91,23 +65,67 @@ instance NFData MungedPackageName where -- When we have the public library, the compat-pkg-name is just the -- package-name, no surprises there! -- -computeCompatPackageName :: PackageName -> Maybe UnqualComponentName -> MungedPackageName --- First handle the cases where we can just use the original 'PackageName'. --- This is for the PRIMARY library, and it is non-Backpack, or the --- indefinite package for us. -computeCompatPackageName pkg_name Nothing - = mkMungedPackageName $ unPackageName pkg_name -computeCompatPackageName pkg_name (Just uqn) - = mkMungedPackageName $ - "z-" ++ zdashcode (unPackageName pkg_name) ++ - "-z-" ++ zdashcode (unUnqualComponentName uqn) +-- >>> prettyShow $ MungedPackageName "servant" LMainLibName +-- "servant" +-- +-- >>> prettyShow $ MungedPackageName "servant" (LSubLibName "lackey") +-- "z-servant-z-lackey" +-- +instance Pretty MungedPackageName where + -- First handle the cases where we can just use the original 'PackageName'. + -- This is for the PRIMARY library, and it is non-Backpack, or the + -- indefinite package for us. + pretty = Disp.text . encodeCompatPackageName' -decodeCompatPackageName :: MungedPackageName -> (PackageName, Maybe UnqualComponentName) -decodeCompatPackageName m = - case unMungedPackageName m of +-- | +-- +-- >>> simpleParsec "servant" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "servant") LMainLibName) +-- +-- >>> simpleParsec "z-servant-z-lackey" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey"))) +-- +-- >>> simpleParsec "z-servant-zz" :: Maybe MungedPackageName +-- Just (MungedPackageName (PackageName "z-servant-zz") LMainLibName) +-- +instance Parsec MungedPackageName where + parsec = decodeCompatPackageName' <$> parsecUnqualComponentName + +------------------------------------------------------------------------------- +-- ZDashCode conversions +------------------------------------------------------------------------------- + +-- | Intended for internal use only +-- +-- >>> decodeCompatPackageName "z-servant-z-lackey" +-- MungedPackageName (PackageName "servant") (LSubLibName (UnqualComponentName "lackey")) +-- +decodeCompatPackageName :: PackageName -> MungedPackageName +decodeCompatPackageName = decodeCompatPackageName' . unPackageName + +-- | Intended for internal use only +-- +-- >>> encodeCompatPackageName $ MungedPackageName "servant" (LSubLibName "lackey") +-- PackageName "z-servant-z-lackey" +-- +-- This is used in @cabal-install@ in the Solver. +-- May become obsolete as solver moves to per-component solving. +-- +encodeCompatPackageName :: MungedPackageName -> PackageName +encodeCompatPackageName = mkPackageName . encodeCompatPackageName' + +decodeCompatPackageName' :: String -> MungedPackageName +decodeCompatPackageName' m = + case m of 'z':'-':rest | Right [pn, cn] <- explicitEitherParsec parseZDashCode rest - -> (mkPackageName pn, Just (mkUnqualComponentName cn)) - s -> (mkPackageName s, Nothing) + -> MungedPackageName (mkPackageName pn) (LSubLibName (mkUnqualComponentName cn)) + s -> MungedPackageName (mkPackageName s) LMainLibName + +encodeCompatPackageName' :: MungedPackageName -> String +encodeCompatPackageName' (MungedPackageName pn LMainLibName) = unPackageName pn +encodeCompatPackageName' (MungedPackageName pn (LSubLibName uqn)) = + "z-" ++ zdashcode (unPackageName pn) ++ + "-z-" ++ zdashcode (unUnqualComponentName uqn) zdashcode :: String -> String zdashcode s = go s (Nothing :: Maybe Int) [] @@ -133,3 +151,6 @@ parseZDashCode = do unZ r = r paste :: [String] -> String paste = intercalate "-" . map unZ + +-- $setup +-- >>> :seti -XOverloadedStrings diff --git a/Cabal/Distribution/Types/PackageDescription.hs b/Cabal/Distribution/Types/PackageDescription.hs index 3f6bc432db8..ea648a57a11 100644 --- a/Cabal/Distribution/Types/PackageDescription.hs +++ b/Cabal/Distribution/Types/PackageDescription.hs @@ -77,7 +77,6 @@ import Distribution.Types.ComponentRequestedSpec import Distribution.Types.Dependency import Distribution.Types.PackageId import Distribution.Types.ComponentName -import Distribution.Types.LibraryName import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName import Distribution.Types.SetupBuildInfo @@ -450,9 +449,8 @@ enabledComponents :: PackageDescription -> ComponentRequestedSpec -> [Component] enabledComponents pkg enabled = filter (componentEnabled enabled) $ pkgBuildableComponents pkg lookupComponent :: PackageDescription -> ComponentName -> Maybe Component -lookupComponent pkg (CLibName LMainLibName) = fmap CLib (library pkg) -lookupComponent pkg (CLibName (LSubLibName name)) = - fmap CLib $ find ((Just name ==) . libName) (subLibraries pkg) +lookupComponent pkg (CLibName name) = + fmap CLib $ find ((name ==) . libName) (allLibraries pkg) lookupComponent pkg (CFLibName name) = fmap CFLib $ find ((name ==) . foreignLibName) (foreignLibs pkg) lookupComponent pkg (CExeName name) = diff --git a/Cabal/Distribution/Types/PackageDescription/Lens.hs b/Cabal/Distribution/Types/PackageDescription/Lens.hs index bcff4358934..947b629e049 100644 --- a/Cabal/Distribution/Types/PackageDescription/Lens.hs +++ b/Cabal/Distribution/Types/PackageDescription/Lens.hs @@ -23,14 +23,12 @@ import Distribution.Types.ForeignLib (ForeignLib, foreignLibModules) import Distribution.Types.ForeignLib.Lens (foreignLibName, foreignLibBuildInfo) import Distribution.Types.Library (Library, explicitLibModules) import Distribution.Types.Library.Lens (libName, libBuildInfo) -import Distribution.Types.LibraryName (LibraryName(..)) import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.PackageId (PackageIdentifier) import Distribution.Types.SetupBuildInfo (SetupBuildInfo) import Distribution.Types.SourceRepo (SourceRepo) import Distribution.Types.TestSuite (TestSuite, testModules) import Distribution.Types.TestSuite.Lens (testName, testBuildInfo) -import Distribution.Types.UnqualComponentName ( UnqualComponentName ) import Distribution.Version (Version, VersionRange) import qualified Distribution.SPDX as SPDX @@ -156,74 +154,65 @@ extraDocFiles :: Lens' PackageDescription [String] extraDocFiles f s = fmap (\x -> s { T.extraDocFiles = x }) (f (T.extraDocFiles s)) {-# INLINE extraDocFiles #-} +-- | @since 3.0.0.0 +allLibraries :: Traversal' PackageDescription Library +allLibraries f pd = mk <$> traverse f (T.library pd) <*> traverse f (T.subLibraries pd) + where + mk l ls = pd { T.library = l, T.subLibraries = ls } + -- | @since 2.4 componentModules :: Monoid r => ComponentName -> Getting r PackageDescription [ModuleName] componentModules cname = case cname of - CLibName LMainLibName -> library . traverse . getting explicitLibModules - CLibName (LSubLibName name) -> - componentModules' name subLibraries (libName . non "") explicitLibModules + CLibName name -> + componentModules' name allLibraries libName explicitLibModules CFLibName name -> - componentModules' name foreignLibs foreignLibName foreignLibModules + componentModules' name (foreignLibs . traverse) foreignLibName foreignLibModules CExeName name -> - componentModules' name executables exeName exeModules + componentModules' name (executables . traverse) exeName exeModules CTestName name -> - componentModules' name testSuites testName testModules + componentModules' name (testSuites . traverse) testName testModules CBenchName name -> - componentModules' name benchmarks benchmarkName benchmarkModules + componentModules' name (benchmarks . traverse) benchmarkName benchmarkModules where componentModules' - :: Monoid r - => UnqualComponentName - -> Traversal' PackageDescription [a] - -> Traversal' a UnqualComponentName + :: (Eq name, Monoid r) + => name + -> Traversal' PackageDescription a + -> Lens' a name -> (a -> [ModuleName]) -> Getting r PackageDescription [ModuleName] componentModules' name pdL nameL modules = pdL - . traverse . filtered ((== name) . view nameL) . getting modules - -- This are easily wrongly used, so we have them here locally only. - non :: Eq a => a -> Lens' (Maybe a) a - non x afb s = f <$> afb (fromMaybe x s) - where f y = if x == y then Nothing else Just y - filtered :: (a -> Bool) -> Traversal' a a filtered p f s = if p s then f s else pure s -- | @since 2.4 componentBuildInfo :: ComponentName -> Traversal' PackageDescription BuildInfo componentBuildInfo cname = case cname of - CLibName LMainLibName -> - library . traverse . libBuildInfo - CLibName (LSubLibName name) -> - componentBuildInfo' name subLibraries (libName . non "") libBuildInfo + CLibName name -> + componentBuildInfo' name allLibraries libName libBuildInfo CFLibName name -> - componentBuildInfo' name foreignLibs foreignLibName foreignLibBuildInfo + componentBuildInfo' name (foreignLibs . traverse) foreignLibName foreignLibBuildInfo CExeName name -> - componentBuildInfo' name executables exeName exeBuildInfo + componentBuildInfo' name (executables . traverse) exeName exeBuildInfo CTestName name -> - componentBuildInfo' name testSuites testName testBuildInfo + componentBuildInfo' name (testSuites . traverse) testName testBuildInfo CBenchName name -> - componentBuildInfo' name benchmarks benchmarkName benchmarkBuildInfo + componentBuildInfo' name (benchmarks . traverse) benchmarkName benchmarkBuildInfo where - componentBuildInfo' :: UnqualComponentName - -> Traversal' PackageDescription [a] - -> Traversal' a UnqualComponentName - -> Traversal' a BuildInfo - -> Traversal' PackageDescription BuildInfo + componentBuildInfo' :: Eq name + => name + -> Traversal' PackageDescription a + -> Lens' a name + -> Traversal' a BuildInfo + -> Traversal' PackageDescription BuildInfo componentBuildInfo' name pdL nameL biL = pdL - . traverse . filtered ((== name) . view nameL) . biL - -- This are easily wrongly used, so we have them here locally only. - -- We have to repeat these, as everything is exported from this module. - non :: Eq a => a -> Lens' (Maybe a) a - non x afb s = f <$> afb (fromMaybe x s) - where f y = if x == y then Nothing else Just y - filtered :: (a -> Bool) -> Traversal' a a filtered p f s = if p s then f s else pure s diff --git a/Cabal/Distribution/Types/PackageId.hs b/Cabal/Distribution/Types/PackageId.hs index 2b5edfbcee6..ddf160d3a2a 100644 --- a/Cabal/Distribution/Types/PackageId.hs +++ b/Cabal/Distribution/Types/PackageId.hs @@ -53,13 +53,16 @@ instance Pretty PackageIdentifier where -- >>> simpleParsec "foo-bar.4-2" :: Maybe PackageIdentifier -- Nothing -- +-- >>> simpleParsec "1.2.3" :: Maybe PackageIdentifier +-- Nothing +-- instance Parsec PackageIdentifier where parsec = do xs' <- P.sepBy1 component (P.char '-') (v, xs) <- case simpleParsec (last xs') of Nothing -> return (nullVersion, xs') -- all components are version Just v -> return (v, init xs') - if all (\c -> all (/= '.') c && not (all isDigit c)) xs + if not (null xs) && all (\c -> all (/= '.') c && not (all isDigit c)) xs then return $ PackageIdentifier (mkPackageName (intercalate "-" xs)) v else fail "all digits or a dot in a portion of package name" where diff --git a/Cabal/Distribution/Types/PackageName/Magic.hs b/Cabal/Distribution/Types/PackageName/Magic.hs new file mode 100644 index 00000000000..35c464729e9 --- /dev/null +++ b/Cabal/Distribution/Types/PackageName/Magic.hs @@ -0,0 +1,20 @@ +-- | Magic 'PackageName's. +-- +-- @since 3.0.0.0 +module Distribution.Types.PackageName.Magic where + +import Distribution.Types.PackageId +import Distribution.Types.PackageName +import Distribution.Types.Version + +-- | Used as a placeholder in "Distribution.Backpack.ReadyComponent" +nonExistentPackageThisIsCabalBug :: PackageName +nonExistentPackageThisIsCabalBug = mkPackageName "nonexistent-package-this-is-a-cabal-bug" + +-- | Used by @cabal new-repl@ and @cabal new-run@ +fakePackageName :: PackageName +fakePackageName = mkPackageName "fake-package" + +-- | 'fakePackageName' with 'version0'. +fakePackageId :: PackageId +fakePackageId = PackageIdentifier fakePackageName version0 diff --git a/Cabal/Distribution/Types/UnqualComponentName.hs b/Cabal/Distribution/Types/UnqualComponentName.hs index 05aee14527e..9afd25a208d 100644 --- a/Cabal/Distribution/Types/UnqualComponentName.hs +++ b/Cabal/Distribution/Types/UnqualComponentName.hs @@ -67,6 +67,10 @@ instance NFData UnqualComponentName where -- Useful in legacy situations where a package name may refer to an internal -- component, if one is defined with that name. -- +-- 2018-12-21: These "legacy" situations are not legacy. +-- We can @build-depends@ on the internal library. However +-- Now dependency contains @Set LibraryName@, and we should use that. +-- -- @since 2.0.0.2 packageNameToUnqualComponentName :: PackageName -> UnqualComponentName packageNameToUnqualComponentName = mkUnqualComponentName . unPackageName diff --git a/Cabal/tests/ParserTests/ipi/Includes2.expr b/Cabal/tests/ParserTests/ipi/Includes2.expr index 8868e0caa0b..dbf0226c3b2 100644 --- a/Cabal/tests/ParserTests/ipi/Includes2.expr +++ b/Cabal/tests/ParserTests/ipi/Includes2.expr @@ -43,7 +43,7 @@ InstalledPackageInfo maintainer = "ezyang@cs.stanford.edu", pkgRoot = Nothing, pkgUrl = "", - sourceLibName = Just `UnqualComponentName "mylib"`, + sourceLibName = LSubLibName `UnqualComponentName "mylib"`, sourcePackageId = PackageIdentifier {pkgName = `PackageName "Includes2"`, pkgVersion = `mkVersion [0,1,0,0]`}, diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr index 5b2ea370a0c..7a6057367a2 100644 --- a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr +++ b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -38,7 +38,7 @@ InstalledPackageInfo pkgRoot = Just "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist", pkgUrl = "", - sourceLibName = Nothing, + sourceLibName = LMainLibName, sourcePackageId = PackageIdentifier {pkgName = `PackageName "internal-preprocessor-test"`, pkgVersion = `mkVersion [0,1,0,0]`}, diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr index 1a5a3da916c..f2698418293 100644 --- a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr +++ b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -2078,7 +2078,7 @@ InstalledPackageInfo maintainer = "Ross Paterson ", pkgRoot = Nothing, pkgUrl = "", - sourceLibName = Nothing, + sourceLibName = LMainLibName, sourcePackageId = PackageIdentifier {pkgName = `PackageName "transformers"`, pkgVersion = `mkVersion [0,5,2,0]`}, diff --git a/Cabal/tests/ParserTests/ipi/transformers.expr b/Cabal/tests/ParserTests/ipi/transformers.expr index d16192ddc23..f0afc331bd9 100644 --- a/Cabal/tests/ParserTests/ipi/transformers.expr +++ b/Cabal/tests/ParserTests/ipi/transformers.expr @@ -78,7 +78,7 @@ InstalledPackageInfo maintainer = "Ross Paterson ", pkgRoot = Just "/opt/ghc/8.2.2/lib/ghc-8.2.2", pkgUrl = "", - sourceLibName = Nothing, + sourceLibName = LMainLibName, sourcePackageId = PackageIdentifier {pkgName = `PackageName "transformers"`, pkgVersion = `mkVersion [0,5,2,0]`}, diff --git a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr index 507b847a60a..540b424a781 100644 --- a/Cabal/tests/ParserTests/regressions/Octree-0.5.expr +++ b/Cabal/tests/ParserTests/regressions/Octree-0.5.expr @@ -86,7 +86,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/common-conditional.expr b/Cabal/tests/ParserTests/regressions/common-conditional.expr index f0d3a587c83..bf66e970a7f 100644 --- a/Cabal/tests/ParserTests/regressions/common-conditional.expr +++ b/Cabal/tests/ParserTests/regressions/common-conditional.expr @@ -76,7 +76,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -161,7 +161,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -219,7 +219,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/common.expr b/Cabal/tests/ParserTests/regressions/common.expr index ea1f085e292..9533ab5a30e 100644 --- a/Cabal/tests/ParserTests/regressions/common.expr +++ b/Cabal/tests/ParserTests/regressions/common.expr @@ -59,7 +59,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/common2.expr b/Cabal/tests/ParserTests/regressions/common2.expr index 4eb84624d4d..460e4c33422 100644 --- a/Cabal/tests/ParserTests/regressions/common2.expr +++ b/Cabal/tests/ParserTests/regressions/common2.expr @@ -72,7 +72,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -154,7 +154,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, @@ -229,7 +229,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Just + libName = LSubLibName `UnqualComponentName "internal"`, libVisibility = LibraryVisibilityPrivate, reexportedModules = [], @@ -315,7 +315,8 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Just `UnqualComponentName "internal"`, + libName = LSubLibName + `UnqualComponentName "internal"`, libVisibility = LibraryVisibilityPrivate, reexportedModules = [], signatures = []}}], diff --git a/Cabal/tests/ParserTests/regressions/elif.expr b/Cabal/tests/ParserTests/regressions/elif.expr index e317aa84e92..11a1191c358 100644 --- a/Cabal/tests/ParserTests/regressions/elif.expr +++ b/Cabal/tests/ParserTests/regressions/elif.expr @@ -72,7 +72,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -123,7 +123,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/elif2.expr b/Cabal/tests/ParserTests/regressions/elif2.expr index 15d4deea3d4..fd7e6bb6363 100644 --- a/Cabal/tests/ParserTests/regressions/elif2.expr +++ b/Cabal/tests/ParserTests/regressions/elif2.expr @@ -68,7 +68,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, @@ -137,7 +137,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -196,7 +196,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, @@ -265,7 +265,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -316,7 +316,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr index 182cf99ceac..fb3277136f9 100644 --- a/Cabal/tests/ParserTests/regressions/encoding-0.8.expr +++ b/Cabal/tests/ParserTests/regressions/encoding-0.8.expr @@ -73,7 +73,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/generics-sop.expr b/Cabal/tests/ParserTests/regressions/generics-sop.expr index 0ed31c9c58a..4d1061af7b7 100644 --- a/Cabal/tests/ParserTests/regressions/generics-sop.expr +++ b/Cabal/tests/ParserTests/regressions/generics-sop.expr @@ -80,7 +80,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}, @@ -178,7 +178,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}, @@ -243,7 +243,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}, @@ -308,7 +308,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -475,7 +475,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr b/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr index a4b817aab30..bd2163c2ee8 100644 --- a/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr +++ b/Cabal/tests/ParserTests/regressions/hidden-main-lib.expr @@ -59,7 +59,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/issue-774.expr b/Cabal/tests/ParserTests/regressions/issue-774.expr index 2473aab476a..64e0037e8f5 100644 --- a/Cabal/tests/ParserTests/regressions/issue-774.expr +++ b/Cabal/tests/ParserTests/regressions/issue-774.expr @@ -57,7 +57,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr b/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr index 51632fcbca2..00e10cf33dd 100644 --- a/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr +++ b/Cabal/tests/ParserTests/regressions/jaeger-flamegraph.expr @@ -215,7 +215,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/leading-comma-2.expr b/Cabal/tests/ParserTests/regressions/leading-comma-2.expr index 7a86ae252e6..68bf1e5ce22 100644 --- a/Cabal/tests/ParserTests/regressions/leading-comma-2.expr +++ b/Cabal/tests/ParserTests/regressions/leading-comma-2.expr @@ -111,7 +111,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/leading-comma.expr b/Cabal/tests/ParserTests/regressions/leading-comma.expr index e4503a8a878..a95daebdb8c 100644 --- a/Cabal/tests/ParserTests/regressions/leading-comma.expr +++ b/Cabal/tests/ParserTests/regressions/leading-comma.expr @@ -104,7 +104,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr b/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr index 5ba2486dd36..955b0ea5e02 100644 --- a/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr +++ b/Cabal/tests/ParserTests/regressions/multiple-libs-2.expr @@ -59,7 +59,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, @@ -124,7 +124,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Just `UnqualComponentName "public"`, + libName = LSubLibName `UnqualComponentName "public"`, libVisibility = LibraryVisibilityPrivate, reexportedModules = [], signatures = []}}], diff --git a/Cabal/tests/ParserTests/regressions/noVersion.expr b/Cabal/tests/ParserTests/regressions/noVersion.expr index 035da9aedf5..633c6cf880f 100644 --- a/Cabal/tests/ParserTests/regressions/noVersion.expr +++ b/Cabal/tests/ParserTests/regressions/noVersion.expr @@ -65,7 +65,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr index de71734cb9c..2882bd7196a 100644 --- a/Cabal/tests/ParserTests/regressions/nothing-unicode.expr +++ b/Cabal/tests/ParserTests/regressions/nothing-unicode.expr @@ -64,7 +64,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -115,7 +115,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/shake.expr b/Cabal/tests/ParserTests/regressions/shake.expr index 80f4d03a811..7cafa64a06f 100644 --- a/Cabal/tests/ParserTests/regressions/shake.expr +++ b/Cabal/tests/ParserTests/regressions/shake.expr @@ -733,7 +733,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -792,7 +792,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, @@ -865,7 +865,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -924,7 +924,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}, @@ -996,7 +996,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}}], @@ -1245,7 +1245,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/spdx-1.expr b/Cabal/tests/ParserTests/regressions/spdx-1.expr index 2e10ba58904..e8d1bd85836 100644 --- a/Cabal/tests/ParserTests/regressions/spdx-1.expr +++ b/Cabal/tests/ParserTests/regressions/spdx-1.expr @@ -52,7 +52,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/spdx-2.expr b/Cabal/tests/ParserTests/regressions/spdx-2.expr index 6490a34dfd0..f4c489a7a16 100644 --- a/Cabal/tests/ParserTests/regressions/spdx-2.expr +++ b/Cabal/tests/ParserTests/regressions/spdx-2.expr @@ -52,7 +52,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/spdx-3.expr b/Cabal/tests/ParserTests/regressions/spdx-3.expr index 0ccd9c68c65..22ef0b353db 100644 --- a/Cabal/tests/ParserTests/regressions/spdx-3.expr +++ b/Cabal/tests/ParserTests/regressions/spdx-3.expr @@ -52,7 +52,7 @@ GenericPackageDescription targetBuildDepends = [], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr index 52492f6e641..4ddd656e5aa 100644 --- a/Cabal/tests/ParserTests/regressions/th-lift-instances.expr +++ b/Cabal/tests/ParserTests/regressions/th-lift-instances.expr @@ -146,7 +146,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr index 23e28a0fa0e..9f245fb0422 100644 --- a/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr +++ b/Cabal/tests/ParserTests/regressions/wl-pprint-indef.expr @@ -148,7 +148,7 @@ GenericPackageDescription [LMainLibName])], virtualModules = []}, libExposed = True, - libName = Nothing, + libName = LMainLibName, libVisibility = LibraryVisibilityPublic, reexportedModules = [], signatures = []}}, diff --git a/Cabal/tests/custom-setup/CabalDoctestSetup.hs b/Cabal/tests/custom-setup/CabalDoctestSetup.hs index 2ed94bf9095..7e064ab2ed0 100644 --- a/Cabal/tests/custom-setup/CabalDoctestSetup.hs +++ b/Cabal/tests/custom-setup/CabalDoctestSetup.hs @@ -136,6 +136,11 @@ import Distribution.Types.UnqualComponentName (unUnqualComponentName) #endif +#if MIN_VERSION_Cabal(2,5,0) +import Distribution.Types.LibraryName + (libraryNameString) +#endif + #if MIN_VERSION_directory(1,2,2) import System.Directory (makeAbsolute) @@ -449,9 +454,12 @@ generateBuildModule testSuiteName flags pkg lbi = do isSpecific _ = False mbLibraryName :: Library -> Name -#if MIN_VERSION_Cabal(2,0,0) +#if MIN_VERSION_Cabal(2,5,0) + -- Cabal-2.5 library's name is LibraryName + mbLibraryName = NameLib . fmap display . libraryNameString . libName +#elif MIN_VERSION_Cabal(2,0,0) -- Cabal-2.0 introduced internal libraries, which are named. - mbLibraryName = NameLib . fmap unUnqualComponentName . libName + mbLibraryName = NameLib . fmap display . libName #else -- Before that, there was only ever at most one library per -- .cabal file, which has no name. diff --git a/Makefile b/Makefile index a34f380b3ab..ae99e009625 100644 --- a/Makefile +++ b/Makefile @@ -80,6 +80,9 @@ check-tests : parser-tests : $(CABALRUN) parser-tests -- --cwd Cabal ${TEST} +parser-tests-accept : + $(CABALRUN) parser-tests -- --cwd Cabal --accept ${TEST} + custom-setup-tests : $(CABALRUN) custom-setup-tests -- diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 8eabb213250..a90167679fc 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -76,12 +76,12 @@ import Distribution.Types.LibraryName ( LibraryName(..) ) import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) +import Distribution.Types.PackageName.Magic + ( fakePackageId ) import Distribution.Types.Library ( Library(..), emptyLibrary ) -import Distribution.Types.PackageId - ( PackageIdentifier(..) ) import Distribution.Types.Version - ( mkVersion, version0 ) + ( mkVersion ) import Distribution.Types.VersionRange ( anyVersion ) import Distribution.Deprecated.Text @@ -373,7 +373,7 @@ withoutProject config verbosity extraArgs = do , defaultLanguage = Just Haskell2010 } baseDep = Dependency "base" anyVersion (Set.singleton LMainLibName) - pkgId = PackageIdentifier "fake-package" version0 + pkgId = fakePackageId writeGenericPackageDescription (tempDir "fake-package.cabal") genericPackageDescription diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 4f5f9ada423..1fda1d065c8 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -90,10 +90,10 @@ import Distribution.Types.GenericPackageDescription as GPD ( GenericPackageDescription(..), emptyGenericPackageDescription ) import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) -import Distribution.Types.PackageId - ( PackageIdentifier(..) ) import Distribution.Types.Version - ( mkVersion, version0 ) + ( mkVersion ) +import Distribution.Types.PackageName.Magic + ( fakePackageId ) import Language.Haskell.Extension ( Language(..) ) @@ -368,7 +368,7 @@ handleScriptCase verbosity baseCtx tempDir scriptContents = do , specVersionRaw = Left (mkVersion [2, 2]) , licenseRaw = Left SPDX.NONE } - pkgId = PackageIdentifier "fake-package" version0 + pkgId = fakePackageId writeGenericPackageDescription (tempDir "fake-package.cabal") genericPackageDescription BS.writeFile (tempDir "Main.hs") contents' diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index df2c7bb4b7e..6e7da0f468b 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -146,6 +146,7 @@ import Distribution.Types.Dependency ( thisPackageVersion ) import Distribution.Types.GivenComponent ( GivenComponent(..) ) +import Distribution.Pretty ( prettyShow ) import Distribution.Types.PackageVersionConstraint ( PackageVersionConstraint(..) ) import Distribution.Types.MungedPackageId @@ -166,8 +167,6 @@ import Distribution.Client.Utils , tryCanonicalizePath, ProgressPhase(..), progressMessage ) import Distribution.System ( Platform, OS(Windows), buildOS, buildPlatform ) -import Distribution.Deprecated.Text - ( display ) import Distribution.Verbosity as Verbosity ( Verbosity, modifyVerbosity, normal, verbose ) import Distribution.Simple.BuildPaths ( exeExtension ) @@ -490,9 +489,9 @@ pruneInstallPlan pkgSpecifiers = "Cannot select only the dependencies (as requested by the " ++ "'--only-dependencies' flag), " ++ (case pkgids of - [pkgid] -> "the package " ++ display pkgid ++ " is " + [pkgid] -> "the package " ++ prettyShow pkgid ++ " is " _ -> "the packages " - ++ intercalate ", " (map display pkgids) ++ " are ") + ++ intercalate ", " (map prettyShow pkgids) ++ " are ") ++ "required by a dependency of one of the other targets." where pkgids = @@ -530,7 +529,7 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb when nothingToInstall $ notice verbosity $ unlines $ "All the requested packages are already installed:" - : map (display . packageId) preExistingTargets + : map (prettyShow . packageId) preExistingTargets ++ ["Use --reinstall if you want to reinstall anyway."] let lPlan = @@ -577,7 +576,7 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb then do (if dryRun || overrideReinstall then warn else die') verbosity $ unlines $ "The following packages are likely to be broken by the reinstalls:" - : map (display . mungedId) newBrokenPkgs + : map (prettyShow . mungedId) newBrokenPkgs ++ if overrideReinstall then if dryRun then [] else ["Continuing even though " ++ @@ -599,7 +598,7 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb unless (null notFetched) $ die' verbosity $ "Can't download packages in offline mode. " ++ "Must download the following packages to proceed:\n" - ++ intercalate ", " (map display notFetched) + ++ intercalate ", " (map prettyShow notFetched) ++ "\nTry using 'cabal fetch'." where @@ -673,10 +672,10 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of wouldWill | dryRun = "would" | otherwise = "will" - showPkg (pkg, _) = display (packageId pkg) ++ + showPkg (pkg, _) = prettyShow (packageId pkg) ++ showLatest (pkg) - showPkgAndReason (ReadyPackage pkg', pr) = display (packageId pkg') ++ + showPkgAndReason (ReadyPackage pkg', pr) = prettyShow (packageId pkg') ++ showLatest pkg' ++ showFlagAssignment (nonDefaultFlags pkg') ++ showStanzas (confPkgStanzas pkg') ++ @@ -693,7 +692,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of showLatest pkg = case mLatestVersion of Just latestVersion -> if packageVersion pkg < latestVersion - then (" (latest: " ++ display latestVersion ++ ")") + then (" (latest: " ++ prettyShow latestVersion ++ ")") else "" Nothing -> "" where @@ -721,13 +720,13 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of showFlagAssignment :: FlagAssignment -> String showFlagAssignment = concatMap ((' ' :) . showFlagValue) . unFlagAssignment - change (OnlyInLeft pkgid) = display pkgid ++ " removed" - change (InBoth pkgid pkgid') = display pkgid ++ " -> " - ++ display (mungedVersion pkgid') - change (OnlyInRight pkgid') = display pkgid' ++ " added" + change (OnlyInLeft pkgid) = prettyShow pkgid ++ " removed" + change (InBoth pkgid pkgid') = prettyShow pkgid ++ " -> " + ++ prettyShow (mungedVersion pkgid') + change (OnlyInRight pkgid') = prettyShow pkgid' ++ " added" showDep pkg | Just rdeps <- Map.lookup (packageId pkg) revDeps - = " (via: " ++ unwords (map display rdeps) ++ ")" + = " (via: " ++ unwords (map prettyShow rdeps) ++ ")" | otherwise = "" revDepGraphEdges :: [(PackageId, PackageId)] @@ -772,7 +771,7 @@ reportPlanningFailure verbosity unless (null buildReports) $ info verbosity $ "Solver failure will be reported for " - ++ intercalate "," (map display pkgids) + ++ intercalate "," (map prettyShow pkgids) -- Save reports BuildReports.storeLocal (compilerInfo comp) @@ -875,7 +874,7 @@ storeDetailedBuildReports :: Verbosity -> FilePath -> [(BuildReports.BuildReport, Maybe Repo)] -> IO () storeDetailedBuildReports verbosity logsDir reports = sequence_ [ do dotCabal <- getCabalDir - let logFileName = display (BuildReports.package report) <.> "log" + let logFileName = prettyShow (BuildReports.package report) <.> "log" logFile = logsDir logFileName reportsDir = dotCabal "reports" remoteRepoName remoteRepo reportFile = reportsDir logFileName @@ -986,14 +985,14 @@ symlinkBinaries verbosity platform comp configFlags installFlags [(_, exe, path)] -> warn verbosity $ "could not create a symlink in " ++ bindir ++ " for " - ++ display exe ++ " because the file exists there already but is not " + ++ prettyShow exe ++ " because the file exists there already but is not " ++ "managed by cabal. You can create a symlink for this executable " ++ "manually if you wish. The executable file has been installed at " ++ path exes -> warn verbosity $ "could not create symlinks in " ++ bindir ++ " for " - ++ intercalate ", " [ display exe | (_, exe, _) <- exes ] + ++ intercalate ", " [ prettyShow exe | (_, exe, _) <- exes ] ++ " because the files exist there already and are not " ++ "managed by cabal. You can create symlinks for these executables " ++ "manually if you wish. The executable files have been installed at " @@ -1009,11 +1008,11 @@ printBuildFailures verbosity buildOutcomes = [] -> return () failed -> die' verbosity . unlines $ "Error: some packages failed to install:" - : [ display pkgid ++ printFailureReason reason + : [ prettyShow pkgid ++ printFailureReason reason | (pkgid, reason) <- failed ] where printFailureReason reason = case reason of - DependentFailed pkgid -> " depends on " ++ display pkgid + DependentFailed pkgid -> " depends on " ++ prettyShow pkgid ++ " which failed to install." DownloadFailed e -> " failed while downloading the package." ++ showException e @@ -1215,9 +1214,9 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg = -- otherwise. printBuildResult :: PackageId -> UnitId -> BuildOutcome -> IO () printBuildResult pkgid uid buildOutcome = case buildOutcome of - (Right _) -> progressMessage verbosity ProgressCompleted (display pkgid) + (Right _) -> progressMessage verbosity ProgressCompleted (prettyShow pkgid) (Left _) -> do - notice verbosity $ "Failed to install " ++ display pkgid + notice verbosity $ "Failed to install " ++ prettyShow pkgid when (verbosity >= normal) $ case useLogFile of Nothing -> return () @@ -1251,7 +1250,7 @@ installReadyPackage platform cinfo configFlags flags stanzas deps)) installPkg = installPkg configFlags { - configIPID = toFlag (display ipid), + configIPID = toFlag (prettyShow ipid), configConfigurationsFlags = flags, -- We generate the legacy constraints as well as the new style precise deps. -- In the end only one set gets passed to Setup.hs configure, depending on @@ -1333,10 +1332,10 @@ installLocalTarballPackage verbosity pkgid tmp <- getTemporaryDirectory withTempDirectory verbosity tmp "cabal-tmp" $ \tmpDirPath -> onFailure UnpackFailed $ do - let relUnpackedPath = display pkgid + let relUnpackedPath = prettyShow pkgid absUnpackedPath = tmpDirPath relUnpackedPath descFilePath = absUnpackedPath - display (packageName pkgid) <.> "cabal" + prettyShow (packageName pkgid) <.> "cabal" info verbosity $ "Extracting " ++ tarballPath ++ " to " ++ tmpDirPath ++ "..." extractTarGzFile tmpDirPath relUnpackedPath tarballPath @@ -1401,9 +1400,9 @@ installUnpackedPackage verbosity installLock numJobs Nothing -> return () Just pkgtxt -> do let descFilePath = fromMaybe "." workingDir - display (packageName pkgid) <.> "cabal" + prettyShow (packageName pkgid) <.> "cabal" info verbosity $ - "Updating " ++ display (packageName pkgid) <.> "cabal" + "Updating " ++ prettyShow (packageName pkgid) <.> "cabal" ++ " with the latest revision from the index." writeFileAtomic descFilePath pkgtxt @@ -1474,7 +1473,7 @@ installUnpackedPackage verbosity installLock numJobs uid = installedUnitId rpkg cinfo = compilerInfo comp buildCommand' = buildCommand progdb - dispname = display pkgid + dispname = prettyShow pkgid isParallelBuild = numJobs >= 2 noticeProgress phase = when isParallelBuild $ @@ -1505,7 +1504,7 @@ installUnpackedPackage verbosity installLock numJobs Cabal.regVerbosity = toFlag verbosity' } verbosity' = maybe verbosity snd useLogFile - tempTemplate name = name ++ "-" ++ display pkgid + tempTemplate name = name ++ "-" ++ prettyShow pkgid addDefaultInstallDirs :: ConfigFlags -> IO ConfigFlags addDefaultInstallDirs configFlags' = do @@ -1626,7 +1625,7 @@ withWin32SelfUpgrade verbosity uid configFlags cinfo platform pkg action = do [ InstallDirs.bindir absoluteDirs exeName <.> exeExtension buildPlatform | exe <- PackageDescription.executables pkg , PackageDescription.buildable (PackageDescription.buildInfo exe) - , let exeName = prefix ++ display (PackageDescription.exeName exe) ++ suffix + , let exeName = prefix ++ prettyShow (PackageDescription.exeName exe) ++ suffix prefix = substTemplate prefixTemplate suffix = substTemplate suffixTemplate ] where diff --git a/cabal-install/Distribution/Client/PackageUtils.hs b/cabal-install/Distribution/Client/PackageUtils.hs index 8c24762af22..8d84ec5ebd6 100644 --- a/cabal-install/Distribution/Client/PackageUtils.hs +++ b/cabal-install/Distribution/Client/PackageUtils.hs @@ -14,16 +14,14 @@ module Distribution.Client.PackageUtils ( externalBuildDepends, ) where -import Distribution.Package - ( packageVersion, packageName ) -import Distribution.Types.ComponentRequestedSpec - ( ComponentRequestedSpec ) +import Distribution.Package (packageName, packageVersion) +import Distribution.PackageDescription + (PackageDescription (..), enabledBuildDepends, libName) +import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec) import Distribution.Types.Dependency +import Distribution.Types.LibraryName import Distribution.Types.UnqualComponentName -import Distribution.PackageDescription - ( PackageDescription(..), libName, enabledBuildDepends ) -import Distribution.Version - ( withinRange, isAnyVersion ) +import Distribution.Version (isAnyVersion, withinRange) -- | The list of dependencies that refer to external packages -- rather than internal package components. @@ -36,5 +34,5 @@ externalBuildDepends pkg spec = filter (not . internal) (enabledBuildDepends pkg internal (Dependency depName versionRange _) = (depName == packageName pkg && packageVersion pkg `withinRange` versionRange) || - (Just (packageNameToUnqualComponentName depName) `elem` map libName (subLibraries pkg) && + (LSubLibName (packageNameToUnqualComponentName depName) `elem` map libName (subLibraries pkg) && isAnyVersion versionRange) diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 671cccac3b3..b373f44cdb3 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -93,7 +93,7 @@ import Distribution.Simple.Compiler import Distribution.Simple.Utils import Distribution.Version import Distribution.Verbosity -import Distribution.Deprecated.Text +import Distribution.Pretty import Distribution.Compat.Graph (IsNode(..)) import Data.Map (Map) @@ -314,7 +314,7 @@ improveInstallPlanWithUpToDatePackages pkgsBuildStatus = Just BuildStatusUpToDate {} -> True Just _ -> False Nothing -> error $ "improveInstallPlanWithUpToDatePackages: " - ++ display (packageId pkg) ++ " not in status map" + ++ prettyShow (packageId pkg) ++ " not in status map" ----------------------------- @@ -831,7 +831,7 @@ withTarballLocalDirectory verbosity distDirLayout@DistDirLayout{..} withTempDirectory verbosity tmpdir "src" $ \unpackdir -> do unpackPackageTarball verbosity tarball unpackdir pkgid pkgTextOverride - let srcdir = unpackdir display pkgid + let srcdir = unpackdir prettyShow pkgid builddir = srcdir "dist" buildPkg srcdir builddir @@ -878,14 +878,14 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride = case pkgTextOverride of Nothing -> return () Just pkgtxt -> do - info verbosity $ "Updating " ++ display pkgname <.> "cabal" + info verbosity $ "Updating " ++ prettyShow pkgname <.> "cabal" ++ " with the latest revision from the index." writeFileAtomic cabalFile pkgtxt where cabalFile = parentdir pkgsubdir - display pkgname <.> "cabal" - pkgsubdir = display pkgid + prettyShow pkgname <.> "cabal" + pkgsubdir = prettyShow pkgid pkgname = packageName pkgid @@ -908,7 +908,7 @@ moveTarballShippedDistDirectory verbosity DistDirLayout{distBuildDirectory} --TODO: [nice to have] or perhaps better to copy, and use a file monitor renameDirectory tarballDistDir targetDistDir where - tarballDistDir = parentdir display pkgid "dist" + tarballDistDir = parentdir prettyShow pkgid "dist" targetDistDir = distBuildDirectory dparams @@ -1019,7 +1019,7 @@ buildAndInstallUnpackedPackage verbosity | not (elabRequiresRegistration pkg) = debug verbosity $ "registerPkg: elab does NOT require registration for " - ++ display uid + ++ prettyShow uid | otherwise = do -- We register ourselves rather than via Setup.hs. We need to -- grab and modify the InstalledPackageInfo. We decide what @@ -1071,10 +1071,10 @@ buildAndInstallUnpackedPackage verbosity compid = compilerId compiler dispname = case elabPkgOrComp pkg of - ElabPackage _ -> display pkgid + ElabPackage _ -> prettyShow pkgid ++ " (all, legacy fallback)" - ElabComponent comp -> display pkgid - ++ " (" ++ maybe "custom" display (compComponentName comp) ++ ")" + ElabComponent comp -> prettyShow pkgid + ++ " (" ++ maybe "custom" prettyShow (compComponentName comp) ++ ")" noticeProgress phase = when isParallelBuild $ progressMessage verbosity phase dispname diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index 4cd28fd5fcb..03d6d9ee520 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -152,7 +152,8 @@ import Distribution.Simple.Utils import Distribution.Verbosity import Distribution.Version ( mkVersion ) -import Distribution.Deprecated.Text +import Distribution.Pretty + ( prettyShow ) import Distribution.Simple.Compiler ( compilerCompatVersion, showCompilerId , OptimisationLevel(..)) @@ -859,8 +860,8 @@ printPlan verbosity showPkgAndReason (ReadyPackage elab) = " - " ++ (if verbosity >= deafening - then display (installedUnitId elab) - else display (packageId elab) + then prettyShow (installedUnitId elab) + else prettyShow (packageId elab) ) ++ (case elabPkgOrComp elab of ElabPackage pkg -> showTargets elab ++ ifVerbose (showStanzas pkg) @@ -873,13 +874,13 @@ printPlan verbosity " (" ++ showBuildStatus buildStatus ++ ")" showComp elab comp = - maybe "custom" display (compComponentName comp) ++ + maybe "custom" prettyShow (compComponentName comp) ++ if Map.null (elabInstantiatedWith elab) then "" else " with " ++ intercalate ", " -- TODO: Abbreviate the UnitIds - [ display k ++ "=" ++ display v + [ prettyShow k ++ "=" ++ prettyShow v | (k,v) <- Map.toList (elabInstantiatedWith elab) ] nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment @@ -1104,8 +1105,8 @@ dieOnBuildFailures verbosity plan buildOutcomes BenchFailed _ -> "Benchmarks failed for " ++ pkgstr InstallFailed _ -> "Failed to build " ++ pkgstr DependentFailed depid - -> "Failed to build " ++ display (packageId pkg) - ++ " because it depends on " ++ display depid + -> "Failed to build " ++ prettyShow (packageId pkg) + ++ " because it depends on " ++ prettyShow depid ++ " which itself failed to build" where pkgstr = elabConfiguredName verbosity pkg diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index c0392568a95..126e56c3ec1 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -2025,10 +2025,7 @@ matchPlanPkg p = InstallPlan.foldPlanPackage (p . ipiComponentName) (matchElabPk -- | Get the appropriate 'ComponentName' which identifies an installed -- component. ipiComponentName :: IPI.InstalledPackageInfo -> ComponentName -ipiComponentName ipkg = - case IPI.sourceLibName ipkg of - Nothing -> CLibName LMainLibName - Just n -> CLibName (LSubLibName n) +ipiComponentName = CLibName . IPI.sourceLibName -- | Given a 'ElaboratedConfiguredPackage', report if it matches a -- 'ComponentName'. diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 14ac05dcd0c..8d129c4ed50 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -75,8 +75,8 @@ import Distribution.Client.DistDirLayout import Distribution.Backpack import Distribution.Backpack.ModuleShape +import Distribution.Pretty import Distribution.Verbosity -import Distribution.Deprecated.Text import Distribution.Types.ComponentRequestedSpec import Distribution.Types.PackageDescription (PackageDescription(..)) import Distribution.Package @@ -133,8 +133,8 @@ type ElaboratedPlanPackage -- | User-friendly display string for an 'ElaboratedPlanPackage'. elabPlanPackageName :: Verbosity -> ElaboratedPlanPackage -> String elabPlanPackageName verbosity (PreExisting ipkg) - | verbosity <= normal = display (packageName ipkg) - | otherwise = display (installedUnitId ipkg) + | verbosity <= normal = prettyShow (packageName ipkg) + | otherwise = prettyShow (installedUnitId ipkg) elabPlanPackageName verbosity (Configured elab) = elabConfiguredName verbosity elab elabPlanPackageName verbosity (Installed elab) @@ -483,10 +483,10 @@ elabConfiguredName verbosity elab case compComponentName comp of Nothing -> "setup from " Just (CLibName LMainLibName) -> "" - Just cname -> display cname ++ " from ") - ++ display (packageId elab) + Just cname -> prettyShow cname ++ " from ") + ++ prettyShow (packageId elab) | otherwise - = display (elabUnitId elab) + = prettyShow (elabUnitId elab) elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams elabDistDirParams shared elab = DistDirParams { @@ -762,7 +762,7 @@ showComponentTarget pkgid = FileTarget fname -> Cabal.BuildTargetFile cname fname showTestComponentTarget :: PackageId -> ComponentTarget -> Maybe String -showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ display n +showTestComponentTarget _ (ComponentTarget (CTestName n) _) = Just $ prettyShow n showTestComponentTarget _ _ = Nothing isTestComponentTarget :: ComponentTarget -> Bool @@ -770,7 +770,7 @@ isTestComponentTarget (ComponentTarget (CTestName _) _) = True isTestComponentTarget _ = False showBenchComponentTarget :: PackageId -> ComponentTarget -> Maybe String -showBenchComponentTarget _ (ComponentTarget (CBenchName n) _) = Just $ display n +showBenchComponentTarget _ (ComponentTarget (CBenchName n) _) = Just $ prettyShow n showBenchComponentTarget _ _ = Nothing isBenchComponentTarget :: ComponentTarget -> Bool diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 6155df128a3..089400b4e83 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -183,7 +183,7 @@ instance Package (ConfiguredPackage loc) where packageId cpkg = packageId (confPkgSource cpkg) instance HasMungedPackageId (ConfiguredPackage loc) where - mungedId cpkg = computeCompatPackageId (packageId cpkg) Nothing + mungedId cpkg = computeCompatPackageId (packageId cpkg) LMainLibName -- Never has nontrivial UnitId instance HasUnitId (ConfiguredPackage loc) where diff --git a/cabal-install/Distribution/Deprecated/Text.hs b/cabal-install/Distribution/Deprecated/Text.hs index a93521ddd84..930f26523c0 100644 --- a/cabal-install/Distribution/Deprecated/Text.hs +++ b/cabal-install/Distribution/Deprecated/Text.hs @@ -44,8 +44,6 @@ import qualified Distribution.Package as D import qualified Distribution.PackageDescription as D import qualified Distribution.Simple.Setup as D import qualified Distribution.System as D -import qualified Distribution.Types.MungedPackageId as D -import qualified Distribution.Types.MungedPackageName as D import qualified Distribution.Types.PackageVersionConstraint as D import qualified Distribution.Types.SourceRepo as D import qualified Distribution.Types.UnqualComponentName as D @@ -202,14 +200,6 @@ instance Text E.Language where lang <- Parse.munch1 isAlphaNum return (E.classifyLanguage lang) -instance Text D.LibraryName where - parse = parseComposite <++ parseSingle - where - parseSingle = Parse.string "lib" >> return D.LMainLibName - parseComposite = do - ctor <- Parse.string "lib:" >> return D.LSubLibName - ctor <$> parse - instance Text D.License where parse = do name <- Parse.munch1 (\c -> isAlphaNum c && c /= '-') @@ -249,15 +239,6 @@ instance Text D.ModuleName where cs <- Parse.munch validModuleChar return (c:cs) -instance Text D.MungedPackageId where - parse = do - n <- parse - v <- (Parse.char '-' >> parse) <++ return D.nullVersion - return (D.MungedPackageId n v) - -instance Text D.MungedPackageName where - parse = D.mkMungedPackageName <$> parsePackageName - instance Text D.OS where parse = fmap (D.classifyOS D.Compat) ident @@ -303,17 +284,6 @@ instance Text D.RepoType where instance Text D.UnqualComponentName where parse = D.mkUnqualComponentName <$> parsePackageName -instance Text D.ComponentName where - parse = parseComposite <++ parseLib - where - parseLib = D.CLibName <$> parse - parseComposite = do - ctor <- Parse.choice [ Parse.string "flib:" >> return D.CFLibName - , Parse.string "exe:" >> return D.CExeName - , Parse.string "bench:" >> return D.CBenchName - , Parse.string "test:" >> return D.CTestName ] - ctor <$> parse - instance Text D.PackageIdentifier where parse = do n <- parse diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 05896706c86..377e9358699 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -86,7 +86,7 @@ convId :: InstalledPackageInfo -> (PN, I) convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi) where MungedPackageId mpn ver = mungedId ipi -- HACK. See Note [Index conversion with internal libraries] - pn = mkPackageName (unMungedPackageName mpn) + pn = encodeCompatPackageName mpn -- | Convert a single installed package into the solver-specific format. convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo) @@ -100,7 +100,7 @@ convIP idx ipi = (pn, i) = convId ipi -- 'sourceLibName' is unreliable, but for now we only really use this for -- primary libs anyways - comp = componentNameToComponent $ libraryComponentName $ sourceLibName ipi + comp = componentNameToComponent $ CLibName $ sourceLibName ipi -- TODO: Installed packages should also store their encapsulations! -- Note [Index conversion with internal libraries] diff --git a/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs index 472ef37993e..85140e8eec6 100644 --- a/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs +++ b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs @@ -9,7 +9,6 @@ import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) import Distribution.Solver.Types.SolverId import Distribution.Types.MungedPackageId import Distribution.Types.PackageId -import Distribution.Types.PackageName import Distribution.Types.MungedPackageName import Distribution.InstalledPackageInfo (InstalledPackageInfo) import GHC.Generics (Generic) @@ -29,7 +28,7 @@ instance Package InstSolverPackage where packageId i = -- HACK! See Note [Index conversion with internal libraries] let MungedPackageId mpn v = mungedId i - in PackageIdentifier (mkPackageName (unMungedPackageName mpn)) v + in PackageIdentifier (encodeCompatPackageName mpn) v instance HasMungedPackageId InstSolverPackage where mungedId = mungedId . instSolverPkgIPI