From 1908cf673f5eeb9ccfb463c826c505eea742c77d Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Wed, 25 Oct 2023 13:30:16 +0100 Subject: [PATCH] Use 'sub-library' terminology consistently --- src/Stack/Build.hs | 4 +-- src/Stack/Build/Cache.hs | 10 +++--- src/Stack/Build/ConstructPlan.hs | 4 +-- src/Stack/Build/Execute.hs | 56 +++++++++++++++---------------- src/Stack/Build/Installed.hs | 2 +- src/Stack/Build/Source.hs | 8 ++--- src/Stack/Build/Target.hs | 2 +- src/Stack/ComponentFile.hs | 4 +-- src/Stack/Coverage.hs | 21 ++++++------ src/Stack/Ghci.hs | 6 ++-- src/Stack/Package.hs | 26 +++++++------- src/Stack/PackageDump.hs | 4 +-- src/Stack/PackageFile.hs | 6 ++-- src/Stack/SDist.hs | 8 ++--- src/Stack/Types/Build.hs | 6 ++-- src/Stack/Types/NamedComponent.hs | 22 ++++++------ src/Stack/Types/Package.hs | 9 +++-- 17 files changed, 99 insertions(+), 99 deletions(-) diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs index 506a72451f..674d65e4bd 100644 --- a/src/Stack/Build.hs +++ b/src/Stack/Build.hs @@ -372,8 +372,8 @@ checkComponentsBuildable lps = , c <- Set.toList (lpUnbuildable lp) ] --- | Find if any sublibrary dependency (other than internal libraries) exists in --- each project package. +-- | Find if any sub-library dependency (other than internal libraries) exists +-- in each project package. checkSubLibraryDependencies :: HasTerm env => [ProjectPackage] -> RIO env () checkSubLibraryDependencies projectPackages = forM_ projectPackages $ \projectPackage -> do diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs index 0b50773580..7c3a24e246 100644 --- a/src/Stack/Build/Cache.hs +++ b/src/Stack/Build/Cache.hs @@ -134,7 +134,7 @@ buildCacheFile dir component = do let nonLibComponent prefix name = prefix <> "-" <> T.unpack name cacheFileName <- parseRelFile $ case component of CLib -> "lib" - CInternalLib name -> nonLibComponent "internal-lib" name + CSubLib name -> nonLibComponent "sub-lib" name CExe name -> nonLibComponent "exe" name CTest name -> nonLibComponent "test" name CBench name -> nonLibComponent "bench" name @@ -375,23 +375,23 @@ writePrecompiledCache :: -> ConfigureOpts -> Bool -- ^ build haddocks -> Installed -- ^ library - -> [GhcPkgId] -- ^ sublibraries, in the GhcPkgId format + -> [GhcPkgId] -- ^ sub-libraries, in the GhcPkgId format -> Set Text -- ^ executables -> RIO env () -writePrecompiledCache baseConfigOpts loc copts buildHaddocks mghcPkgId sublibs exes = do +writePrecompiledCache baseConfigOpts loc copts buildHaddocks mghcPkgId subLibs exes = do key <- getPrecompiledCacheKey loc copts buildHaddocks ec <- view envConfigL let stackRootRelative = makeRelative (view stackRootL ec) mlibpath <- case mghcPkgId of Executable _ -> pure Nothing Library _ ipid _ -> Just <$> pathFromPkgId stackRootRelative ipid - sublibpaths <- mapM (pathFromPkgId stackRootRelative) sublibs + subLibPaths <- mapM (pathFromPkgId stackRootRelative) subLibs exes' <- forM (Set.toList exes) $ \exe -> do name <- parseRelFile $ T.unpack exe stackRootRelative $ bcoSnapInstallRoot baseConfigOpts bindirSuffix name let precompiled = PrecompiledCache { pcLibrary = mlibpath - , pcSubLibs = sublibpaths + , pcSubLibs = subLibPaths , pcExes = exes' } savePrecompiledCache key precompiled diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 35ea144018..33c93c5790 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -1161,10 +1161,10 @@ addPackageDeps package = do TTLocalMutable lp -> packageHasLibrary $ lpPackage lp TTRemotePackage _ p _ -> packageHasLibrary p - -- make sure we consider internal libraries as libraries too + -- make sure we consider sub-libraries as libraries too packageHasLibrary :: Package -> Bool packageHasLibrary p = - not (Set.null (packageInternalLibraries p)) || + not (Set.null (packageSubLibraries p)) || case packageLibraries p of HasLibraries _ -> True NoLibraries -> False diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 8a05f07fd9..7384a52d0a 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -1727,7 +1727,7 @@ singleBuild where result = T.intercalate " + " $ concat [ ["lib" | taskAllInOne && hasLib] - , ["internal-lib" | taskAllInOne && hasSubLib] + , ["sub-lib" | taskAllInOne && hasSubLib] , ["exe" | taskAllInOne && hasExe] , ["test" | enableTests] , ["bench" | enableBenchmarks] @@ -1739,10 +1739,10 @@ singleBuild case packageLibraries package of NoLibraries -> False HasLibraries _ -> True - hasSubLibrary = not . Set.null $ packageInternalLibraries package + hasSubLibraries = not . Set.null $ packageSubLibraries package hasExecutables = not . Set.null $ exesToBuild executableBuildStatuses lp - in (hasLibrary, hasSubLibrary, hasExecutables) + in (hasLibrary, hasSubLibraries, hasExecutables) -- This isn't true, but we don't want to have this info for upstream deps. _ -> (False, False, False) @@ -1776,21 +1776,21 @@ singleBuild pure $ if b then Just pc else Nothing _ -> pure Nothing - copyPreCompiled (PrecompiledCache mlib sublibs exes) = do + copyPreCompiled (PrecompiledCache mlib subLibs exes) = do announceTask ee task "using precompiled package" - -- We need to copy .conf files for the main library and all sublibraries + -- We need to copy .conf files for the main library and all sub-libraries -- which exist in the cache, from their old snapshot to the new one. -- However, we must unregister any such library in the new snapshot, in case -- it was built with different flags. let subLibNames = Set.toList $ case taskType of - TTLocalMutable lp -> packageInternalLibraries $ lpPackage lp - TTRemotePackage _ p _ -> packageInternalLibraries p + TTLocalMutable lp -> packageSubLibraries $ lpPackage lp + TTRemotePackage _ p _ -> packageSubLibraries p toMungedPackageId :: Text -> MungedPackageId - toMungedPackageId sublib = - let sublibName = LSubLibName $ mkUnqualComponentName $ T.unpack sublib - in MungedPackageId (MungedPackageName pname sublibName) pversion + toMungedPackageId subLib = + let subLibName = LSubLibName $ mkUnqualComponentName $ T.unpack subLib + in MungedPackageId (MungedPackageName pname subLibName) pversion toPackageId :: MungedPackageId -> PackageIdentifier toPackageId (MungedPackageId n v) = PackageIdentifier (encodeCompatPackageName n) v @@ -1798,7 +1798,7 @@ singleBuild allToUnregister = mcons (Left pkgId <$ mlib) (map (Left . toPackageId . toMungedPackageId) subLibNames) - allToRegister = mcons mlib sublibs + allToRegister = mcons mlib subLibs unless (null allToRegister) $ withMVar eeInstallLock $ \() -> do @@ -2030,11 +2030,11 @@ singleBuild NoLibraries -> False HasLibraries _ -> True packageHasComponentSet f = not $ Set.null $ f package - hasInternalLibrary = packageHasComponentSet packageInternalLibraries + hasSubLibraries = packageHasComponentSet packageSubLibraries hasExecutables = packageHasComponentSet packageExes shouldCopy = not isFinalBuild - && (hasLibrary || hasInternalLibrary || hasExecutables) + && (hasLibrary || hasSubLibraries || hasExecutables) when shouldCopy $ withMVar eeInstallLock $ \() -> do announce "copy/register" eres <- try $ cabal KeepTHLoading ["copy"] @@ -2044,7 +2044,7 @@ singleBuild (packageBuildType package == C.Simple) (displayException err) _ -> pure () - when (hasLibrary || hasInternalLibrary) $ cabal KeepTHLoading ["register"] + when (hasLibrary || hasSubLibraries) $ cabal KeepTHLoading ["register"] -- copy ddump-* files case T.unpack <$> boptsDdumpDir eeBuildOpts of @@ -2078,19 +2078,19 @@ singleBuild ( bcoLocalDB eeBaseConfigOpts , eeLocalDumpPkgs ) let ident = PackageIdentifier (packageName package) (packageVersion package) - -- only pure the sublibs to cache them if we also cache the main lib (that - -- is, if it exists) - (mpkgid, sublibsPkgIds) <- case packageLibraries package of + -- only pure the sub-libraries to cache them if we also cache the main + -- library (that is, if it exists) + (mpkgid, subLibsPkgIds) <- case packageLibraries package of HasLibraries _ -> do - sublibsPkgIds <- fmap catMaybes $ - forM (Set.toList $ packageInternalLibraries package) $ \sublib -> do - let sublibName = MungedPackageName + subLibsPkgIds <- fmap catMaybes $ + forM (Set.toList $ packageSubLibraries package) $ \subLib -> do + let subLibName = MungedPackageName (packageName package) - (LSubLibName $ mkUnqualComponentName $ T.unpack sublib) + (LSubLibName $ mkUnqualComponentName $ T.unpack subLib) loadInstalledPkg [installedPkgDb] installedDumpPkgsTVar - (encodeCompatPackageName sublibName) + (encodeCompatPackageName subLibName) mpkgid <- loadInstalledPkg [installedPkgDb] @@ -2098,11 +2098,11 @@ singleBuild (packageName package) case mpkgid of Nothing -> throwM $ Couldn'tFindPkgId $ packageName package - Just pkgid -> pure (Library ident pkgid Nothing, sublibsPkgIds) + Just pkgid -> pure (Library ident pkgid Nothing, subLibsPkgIds) NoLibraries -> do markExeInstalled (taskLocation task) pkgId -- TODO unify somehow - -- with writeFlagCache? - pure (Executable ident, []) -- don't pure sublibs in this case + -- with writeFlagCache? + pure (Executable ident, []) -- don't pure sub-libraries in this case case taskType of TTRemotePackage Immutable _ loc -> @@ -2112,7 +2112,7 @@ singleBuild (configCacheOpts cache) (configCacheHaddock cache) mpkgid - sublibsPkgIds + subLibsPkgIds (packageExes package) _ -> pure () @@ -2675,7 +2675,7 @@ extraBuildOptions wc bopts = do else pure [optsFlag, baseOpts] --- Library, internal and foreign libraries and executable build components. +-- Library, sub-library, foreign library and executable build components. primaryComponentOptions :: Map Text ExecutableBuildStatus -> LocalPackage @@ -2693,7 +2693,7 @@ primaryComponentOptions executableBuildStatuses lp = ) ++ map (T.unpack . T.append "lib:") - (Set.toList $ packageInternalLibraries package) + (Set.toList $ packageSubLibraries package) ++ map (T.unpack . T.append "exe:") (Set.toList $ exesToBuild executableBuildStatuses lp) diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs index b4073f5399..09ebdf8847 100644 --- a/src/Stack/Build/Installed.hs +++ b/src/Stack/Build/Installed.hs @@ -181,7 +181,7 @@ isAllowed :: InstallMap isAllowed installMap mloc dp = case Map.lookup name installMap of Nothing -> -- If the sourceMap has nothing to say about this package, - -- check if it represents a sublibrary first + -- check if it represents a sub-library first -- See: https://github.com/commercialhaskell/stack/issues/3899 case dpParentLibIdent dp of Just (PackageIdentifier parentLibName version') -> diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index f60c326abb..470ace9cbe 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -49,7 +49,7 @@ import Stack.Types.EnvConfig ) import Stack.Types.FileDigestCache ( readFileDigest ) import Stack.Types.NamedComponent - ( NamedComponent (..), isCInternalLib ) + ( NamedComponent (..), isCSubLib ) import Stack.Types.Package ( FileCacheInfo (..), LocalPackage (..), Package (..) , PackageConfig (..), PackageLibraries (..) @@ -280,7 +280,7 @@ splitComponents = where go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c []) go a b c (CLib:xs) = go a b c xs - go a b c (CInternalLib x:xs) = go (a . (x:)) b c xs + go a b c (CSubLib x:xs) = go (a . (x:)) b c xs go a b c (CExe x:xs) = go (a . (x:)) b c xs go a b c (CTest x:xs) = go a (b . (x:)) c xs go a b c (CBench x:xs) = go a b (c . (x:)) xs @@ -348,7 +348,7 @@ loadLocalPackage pp = do HasLibraries _ -> True in hasLibrary || not (Set.null nonLibComponents) - || not (Set.null $ packageInternalLibraries pkg) + || not (Set.null $ packageSubLibraries pkg) filterSkippedComponents = Set.filter (not . (`elem` boptsSkipComponents bopts)) @@ -510,7 +510,7 @@ getPackageFilesForTargets pkg cabalFP nonLibComponents = do (components',compFiles,otherFiles,warnings) <- getPackageFiles (packageFiles pkg) cabalFP let necessaryComponents = - Set.insert CLib $ Set.filter isCInternalLib (M.keysSet components') + Set.insert CLib $ Set.filter isCSubLib (M.keysSet components') components = necessaryComponents `Set.union` nonLibComponents componentsFiles = M.map (\files -> diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs index e4ad1b65b4..b7a592b78f 100644 --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -260,7 +260,7 @@ resolveRawTarget sma allLocs (ri, rt) = -- 'ComponentName' isCompNamed :: ComponentName -> NamedComponent -> Bool isCompNamed _ CLib = False - isCompNamed t1 (CInternalLib t2) = t1 == t2 + isCompNamed t1 (CSubLib t2) = t1 == t2 isCompNamed t1 (CExe t2) = t1 == t2 isCompNamed t1 (CTest t2) = t1 == t2 isCompNamed t1 (CBench t2) = t1 == t2 diff --git a/src/Stack/ComponentFile.hs b/src/Stack/ComponentFile.hs index b69bd34d34..896ff119f0 100644 --- a/src/Stack/ComponentFile.hs +++ b/src/Stack/ComponentFile.hs @@ -332,7 +332,7 @@ componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir componentOutputDir namedComponent distDir = case namedComponent of CLib -> buildDir distDir - CInternalLib name -> makeTmp name + CSubLib name -> makeTmp name CExe name -> makeTmp name CTest name -> makeTmp name CBench name -> makeTmp name @@ -551,7 +551,7 @@ componentBuildDir cabalVer component distDir | otherwise = case component of CLib -> buildDir distDir - CInternalLib name -> buildDir distDir componentNameToDir name + CSubLib name -> buildDir distDir componentNameToDir name CExe name -> buildDir distDir componentNameToDir name CTest name -> buildDir distDir componentNameToDir name CBench name -> buildDir distDir componentNameToDir name diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs index eea6df2099..8f01572c99 100644 --- a/src/Stack/Coverage.hs +++ b/src/Stack/Coverage.hs @@ -185,12 +185,12 @@ generateHpcReport pkgDir package tests = do case packageLibraries package of NoLibraries -> False HasLibraries _ -> True - internalLibs = packageInternalLibraries package + subLibs = packageSubLibraries package eincludeName <- -- Pre-7.8 uses plain PKG-version in tix files. if ghcVersion < mkVersion [7, 10] then pure $ Right $ Just [pkgId] -- We don't expect to find a package key if there is no library. - else if not hasLibrary && Set.null internalLibs then pure $ Right Nothing + else if not hasLibrary && Set.null subLibs then pure $ Right Nothing -- Look in the inplace DB for the package key. -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986 else do @@ -201,7 +201,7 @@ generateHpcReport pkgDir package tests = do findPackageFieldForBuiltPackage pkgDir (packageIdentifier package) - internalLibs + subLibs hpcNameField case eincludeName of Left err -> do @@ -593,7 +593,7 @@ findPackageFieldForBuiltPackage :: HasEnvConfig env => Path Abs Dir -> PackageIdentifier -> Set.Set Text -> Text -> RIO env (Either Text [Text]) -findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do +findPackageFieldForBuiltPackage pkgDir pkgId subLibs field = do distDir <- distDirFromDir pkgDir let inplaceDir = distDir relDirPackageConfInplace pkgIdStr = packageIdentifierString pkgId @@ -613,12 +613,13 @@ findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do logDebug $ displayShow files -- From all the files obtained from the scanning process above, we need to -- identify which are .conf files and then ensure that there is at most one - -- .conf file for each library and internal library (some might be missing if - -- that component has not been built yet). We should error if there are more - -- than one .conf file for a component or if there are no .conf files at all - -- in the searched location. + -- .conf file for each library and sub-library (some might be missing if that + -- component has not been built yet). We should error if there are more than + -- one .conf file for a component or if there are no .conf files at all in the + -- searched location. let toFilename = T.pack . toFilePath . filename - -- strip known prefix and suffix from the found files to determine only the conf files + -- strip known prefix and suffix from the found files to determine only + -- the .conf files stripKnown = T.stripSuffix ".conf" <=< T.stripPrefix (T.pack (pkgIdStr ++ "-")) stripped = @@ -629,7 +630,7 @@ findPackageFieldForBuiltPackage pkgDir pkgId internalLibs field = do in if T.null z then "" else T.tail z matchedComponents = map (\(n, f) -> (stripHash n, [f])) stripped byComponents = - Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" internalLibs + Map.restrictKeys (Map.fromListWith (++) matchedComponents) $ Set.insert "" subLibs logDebug $ displayShow byComponents if Map.null $ Map.filter (\fs -> length fs > 1) byComponents then case concat $ Map.elems byComponents of diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 752b606930..6d2dbe00bc 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -791,7 +791,7 @@ figureOutMainFile bopts mainIsTargets targets0 packages = renderComp c = case c of CLib -> "lib" - CInternalLib name -> "internal-lib:" <> fromString (T.unpack name) + CSubLib name -> "sub-lib:" <> fromString (T.unpack name) CExe name -> "exe:" <> fromString (T.unpack name) CTest name -> "test:" <> fromString ( T.unpack name) CBench name -> "bench:" <> fromString (T.unpack name) @@ -939,9 +939,9 @@ wantedPackageComponents _ (TargetComps cs) _ = cs wantedPackageComponents bopts (TargetAll PTProject) pkg = S.fromList $ (case packageLibraries pkg of NoLibraries -> [] - HasLibraries names -> CLib : map CInternalLib (S.toList names)) ++ + HasLibraries names -> CLib : map CSubLib (S.toList names)) ++ map CExe (S.toList (packageExes pkg)) <> - map CInternalLib (S.toList $ packageInternalLibraries pkg) <> + map CSubLib (S.toList $ packageSubLibraries pkg) <> (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <> (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else []) wantedPackageComponents _ _ _ = S.empty diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 4bc50888b5..a6763e0ee4 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -71,7 +71,7 @@ import Stack.Types.Config ( Config (..), HasConfig (..) ) import Stack.Types.EnvConfig ( HasEnvConfig ) import Stack.Types.GhcPkgId ( ghcPkgIdString ) import Stack.Types.NamedComponent - ( NamedComponent (..), internalLibComponents ) + ( NamedComponent (..), subLibComponents ) import Stack.Types.Package ( BuildInfoOpts (..), ExeName (..), GetPackageOpts (..) , InstallMap, Installed (..), InstalledMap, Package (..) @@ -132,7 +132,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg case mlib of Nothing -> NoLibraries Just _ -> HasLibraries foreignLibNames - , packageInternalLibraries = subLibNames + , packageSubLibraries = subLibNames , packageTests = M.fromList [ (T.pack (Cabal.unUnqualComponentName $ testName t), testInterface t) | t <- testSuites pkgNoMod @@ -154,17 +154,17 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg , packageOpts = GetPackageOpts $ \installMap installedMap omitPkgs addPkgs cabalfp -> do (componentsModules,componentFiles, _, _) <- getPackageFiles pkgFiles cabalfp - let internals = - S.toList $ internalLibComponents $ M.keysSet componentsModules - excludedInternals <- mapM (parsePackageNameThrowing . T.unpack) internals - mungedInternals <- mapM + let subLibs = + S.toList $ subLibComponents $ M.keysSet componentsModules + excludedSubLibs <- mapM (parsePackageNameThrowing . T.unpack) subLibs + mungedSubLibs <- mapM (parsePackageNameThrowing . T.unpack . toInternalPackageMungedName) - internals + subLibs componentsOpts <- generatePkgDescOpts installMap installedMap - (excludedInternals ++ omitPkgs) - (mungedInternals ++ addPkgs) + (excludedSubLibs ++ omitPkgs) + (mungedSubLibs ++ addPkgs) cabalfp pkg componentFiles @@ -284,11 +284,11 @@ generatePkgDescOpts installMap installedMap omitPkgs addPkgs cabalfp pkg compone (pure . generate CLib . libBuildInfo) (library pkg) , mapMaybe - (\sublib -> do + (\subLib -> do let maybeLib = - CInternalLib . T.pack . Cabal.unUnqualComponentName <$> - (libraryNameString . libName) sublib - flip generate (libBuildInfo sublib) <$> maybeLib + CSubLib . T.pack . Cabal.unUnqualComponentName <$> + (libraryNameString . libName) subLib + flip generate (libBuildInfo subLib) <$> maybeLib ) (subLibraries pkg) , fmap diff --git a/src/Stack/PackageDump.hs b/src/Stack/PackageDump.hs index 7a2bdb183c..1162be3de4 100644 --- a/src/Stack/PackageDump.hs +++ b/src/Stack/PackageDump.hs @@ -206,8 +206,8 @@ conduitDumpPackage = (.| CL.catMaybes) $ eachSection $ do _ -> Nothing depends <- mapMaybeM parseDepend $ concatMap T.words $ parseM "depends" - -- Handle sublibs by recording the name of the parent library - -- If name of parent library is missing, this is not a sublib. + -- Handle sub-libraries by recording the name of the parent library + -- If name of parent library is missing, this is not a sub-library. let mkParentLib n = PackageIdentifier n version parentLib = mkParentLib <$> (parseS "package-name" >>= parsePackageNameThrowing . T.unpack) diff --git a/src/Stack/PackageFile.hs b/src/Stack/PackageFile.hs index 3d418ba34e..8ac13bdac7 100644 --- a/src/Stack/PackageFile.hs +++ b/src/Stack/PackageFile.hs @@ -71,7 +71,7 @@ packageDescModulesAndFiles pkg = do fmap foldTuples ( mapM - (asModuleAndFileMap internalLibComponent libraryFiles) + (asModuleAndFileMap subLibComponent libraryFiles) (subLibraries pkg) ) (executableMods, exeDotCabalFiles, exeWarnings) <- @@ -106,8 +106,8 @@ packageDescModulesAndFiles pkg = do pure (modules, files, dfiles, warnings) where libComponent = const CLib - internalLibComponent = - CInternalLib . T.pack . maybe + subLibComponent = + CSubLib . T.pack . maybe "" Cabal.unUnqualComponentName . libraryNameString . libName exeComponent = CExe . T.pack . Cabal.unUnqualComponentName . exeName testComponent = CTest . T.pack . Cabal.unUnqualComponentName . testName diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index 4da347bdbc..2701446ecd 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -303,12 +303,12 @@ getCabalLbs pvpBounds mrev cabalfp sourceMap = do prettyThrowIO $ CabalFilePathsInconsistentBug cabalfp cabalfp' installMap <- toInstallMap sourceMap (installedMap, _, _, _) <- getInstalled installMap - let internalPackages = Set.fromList $ + let subLibPackages = Set.fromList $ gpdPackageName gpd : map (Cabal.unqualComponentNameToPackageName . fst) (Cabal.condSubLibraries gpd) - gpd' = gtraverseT (addBounds internalPackages installMap installedMap) gpd + gpd' = gtraverseT (addBounds subLibPackages installMap installedMap) gpd gpd'' = case mrev of Nothing -> gpd' @@ -402,8 +402,8 @@ getCabalLbs pvpBounds mrev cabalfp sourceMap = do -> InstalledMap -> Dependency -> Dependency - addBounds internalPackages installMap installedMap dep = - if name `Set.member` internalPackages + addBounds subLibPackages installMap installedMap dep = + if name `Set.member` subLibPackages then dep else case foundVersion of Nothing -> dep diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs index 299efbcff3..9c192aea79 100644 --- a/src/Stack/Types/Build.hs +++ b/src/Stack/Types/Build.hs @@ -218,13 +218,13 @@ data Plan = Plan } deriving Show --- | Information on a compiled package: the library conf file (if relevant), --- the sublibraries (if present) and all of the executable paths. +-- | Information on a compiled package: the library .conf file (if relevant), +-- the sub-libraries (if present) and all of the executable paths. data PrecompiledCache base = PrecompiledCache { pcLibrary :: !(Maybe (Path base File)) -- ^ .conf file inside the package database , pcSubLibs :: ![Path base File] - -- ^ .conf file inside the package database, for each of the sublibraries + -- ^ .conf file inside the package database, for each of the sub-libraries , pcExes :: ![Path base File] -- ^ Full paths to executables } diff --git a/src/Stack/Types/NamedComponent.hs b/src/Stack/Types/NamedComponent.hs index 0e182f284f..d10647ee5f 100644 --- a/src/Stack/Types/NamedComponent.hs +++ b/src/Stack/Types/NamedComponent.hs @@ -9,9 +9,9 @@ module Stack.Types.NamedComponent , exeComponents , testComponents , benchComponents - , internalLibComponents + , subLibComponents , isCLib - , isCInternalLib + , isCSubLib , isCExe , isCTest , isCBench @@ -24,7 +24,7 @@ import Stack.Prelude -- | A single, fully resolved component of a package data NamedComponent = CLib - | CInternalLib !Text + | CSubLib !Text | CExe !Text | CTest !Text | CBench !Text @@ -32,7 +32,7 @@ data NamedComponent renderComponent :: NamedComponent -> Text renderComponent CLib = "lib" -renderComponent (CInternalLib x) = "internal-lib:" <> x +renderComponent (CSubLib x) = "sub-lib:" <> x renderComponent (CExe x) = "exe:" <> x renderComponent (CTest x) = "test:" <> x renderComponent (CBench x) = "bench:" <> x @@ -62,19 +62,19 @@ benchComponents = Set.fromList . mapMaybe mBenchName . Set.toList mBenchName (CBench name) = Just name mBenchName _ = Nothing -internalLibComponents :: Set NamedComponent -> Set Text -internalLibComponents = Set.fromList . mapMaybe mInternalName . Set.toList +subLibComponents :: Set NamedComponent -> Set Text +subLibComponents = Set.fromList . mapMaybe mSubLibName . Set.toList where - mInternalName (CInternalLib name) = Just name - mInternalName _ = Nothing + mSubLibName (CSubLib name) = Just name + mSubLibName _ = Nothing isCLib :: NamedComponent -> Bool isCLib CLib{} = True isCLib _ = False -isCInternalLib :: NamedComponent -> Bool -isCInternalLib CInternalLib{} = True -isCInternalLib _ = False +isCSubLib :: NamedComponent -> Bool +isCSubLib CSubLib{} = True +isCSubLib _ = False isCExe :: NamedComponent -> Bool isCExe CExe{} = True diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 3a4a78093d..8960d4befa 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -132,12 +132,11 @@ instance Exception PackageException where displayException ComponentNotParsedBug = bugReport "[S-4623]" "Component names should always parse as directory names." --- | Libraries in a package. Since Cabal 2.0, internal libraries are a --- thing. +-- | Libraries in a package. Since Cabal 2.0, sub-libraries are a thing. data PackageLibraries = NoLibraries | HasLibraries !(Set Text) - -- ^ the foreign library names, sub libraries get built automatically + -- ^ the foreign library names, sub-libraries get built automatically -- without explicit component name passing deriving (Show, Typeable) @@ -175,8 +174,8 @@ data Package = Package -- ^ Defaults for unspecified flags. , packageLibraries :: !PackageLibraries -- ^ does the package have a buildable library stanza? - , packageInternalLibraries :: !(Set Text) - -- ^ names of internal libraries + , packageSubLibraries :: !(Set Text) + -- ^ Names of sub-libraries , packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites , packageBenchmarks :: !(Set Text)