diff --git a/.stan.toml b/.stan.toml index 99909c5b33..8868811841 100644 --- a/.stan.toml +++ b/.stan.toml @@ -52,24 +52,24 @@ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-1119:21" + id = "OBS-STAN-0203-fki0nd-1125:21" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs # -# 1097 ┃ -# 1098 ┃ newProjectRoot <- S8.pack . toFilePath <$> view projectRootL -# 1099 ┃ ^^^^^^^ +# 1122 ┃ +# 1123 ┃ newProjectRoot <- S8.pack . toFilePath <$> view projectRootL +# 1124 ┃ ^^^^^^^ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] - id = "OBS-STAN-0203-fki0nd-2661:3" + id = "OBS-STAN-0203-fki0nd-2667:3" # ✦ Description: Usage of 'pack' function that doesn't handle Unicode characters # ✦ Category: #AntiPattern # ✦ File: src\Stack\Build\Execute.hs -# 2614 ┃ -# 2615 ┃ S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q" -# 2616 ┃ ^^^^^^^ +# 2673 ┃ +# 2674 ┃ S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q" +# 2675 ┃ ^^^^^^^ # Anti-pattern: Data.ByteString.Char8.pack [[ignore]] diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 7d8281e2aa..02bbc7c736 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -31,6 +31,7 @@ import Stack.Constants ( compilerOptionsCabalFlag ) import Stack.Package ( applyForceCustomBuild, buildableExes , hasBuildableMainLibrary, packageUnknownTools + , processPackageDepsToList ) import Stack.Prelude hiding ( loadPackage ) import Stack.SourceMap ( getPLIVersion, mkProjectPackage ) @@ -56,8 +57,7 @@ import Stack.Types.Config ( Config (..), HasConfig (..), stackRootL ) import Stack.Types.ConfigureOpts ( BaseConfigOpts (..), ConfigureOpts (..), configureOpts ) import Stack.Types.Curator ( Curator (..) ) -import Stack.Types.Dependency - ( DepValue (DepValue), DepType (AsLibrary) ) +import Stack.Types.Dependency ( DepValue (..), isDepTypeLibrary ) import Stack.Types.DumpPackage ( DumpPackage (..) ) import Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..) ) @@ -1001,25 +1001,25 @@ addPackageDeps :: addPackageDeps package = do ctx <- ask checkAndWarnForUnknownTools package - let deps' = Map.toList $ packageDeps package - deps <- forM deps' $ \(depname, DepValue range depType) -> do - eres <- getCachedDepOrAddDep depname + deps <- processPackageDepsToList package $ \name value -> do + eres <- getCachedDepOrAddDep name let getLatestApplicableVersionAndRev :: M (Maybe (Version, BlobKey)) getLatestApplicableVersionAndRev = do vsAndRevs <- runRIO ctx $ getHackagePackageVersions - YesRequireHackageIndex UsePreferredVersions depname + YesRequireHackageIndex UsePreferredVersions name pure $ do lappVer <- latestApplicableVersion range $ Map.keysSet vsAndRevs revs <- Map.lookup lappVer vsAndRevs (cabalHash, _) <- Map.maxView revs Just (lappVer, cabalHash) + range = dvVersionRange value case eres of Left e -> do - addParent depname range + addParent name range let bd = case e of - UnknownPackage name -> assert (name == depname) NotInBuildPlan + UnknownPackage name' -> assert (name' == name) NotInBuildPlan DependencyCycleDetected names -> BDDependencyCycleDetected names -- ultimately we won't show any information on this to the user, -- we'll allow the dependency failures alone to display to avoid @@ -1027,11 +1027,12 @@ addPackageDeps package = do DependencyPlanFailures _ _ -> Couldn'tResolveItsDependencies (packageVersion package) mlatestApplicable <- getLatestApplicableVersionAndRev - pure $ Left (depname, (range, mlatestApplicable, bd)) - Right adr | depType == AsLibrary && not (adrHasLibrary adr) -> - pure $ Left (depname, (range, Nothing, HasNoLibrary)) + pure $ Left (name, (range, mlatestApplicable, bd)) + Right adr + | isDepTypeLibrary (dvType value) && not (adrHasLibrary adr) -> + pure $ Left (name, (range, Nothing, HasNoLibrary)) Right adr -> do - addParent depname range + addParent name range inRange <- if adrVersion adr `withinRange` range then pure True else do @@ -1039,14 +1040,21 @@ addPackageDeps package = do where msg = fillSep - [ if isIgnoring then "Ignoring" else flow "Not ignoring" - , style Current (fromString . packageNameString $ packageName package) <> "'s" + [ if isIgnoring + then "Ignoring" + else flow "Not ignoring" + , style + Current + ( fromString . packageNameString $ + packageName package + ) + <> "'s" , flow "bounds on" - , style Current (fromString $ packageNameString depname) + , style Current (fromString $ packageNameString name) , parens (fromString . T.unpack $ versionRangeText range) , flow "and using" , style Current (fromString . packageIdentifierString $ - PackageIdentifier depname (adrVersion adr)) <> "." + PackageIdentifier name (adrVersion adr)) <> "." ] <> line <> fillSep @@ -1058,7 +1066,7 @@ addPackageDeps package = do let inSnapshotCheck = do -- We ignore dependency information for packages in a snapshot x <- inSnapshot (packageName package) (packageVersion package) - y <- inSnapshot depname (adrVersion adr) + y <- inSnapshot name (adrVersion adr) if x && y then do warn_ True @@ -1131,7 +1139,7 @@ addPackageDeps package = do else do mlatestApplicable <- getLatestApplicableVersionAndRev pure $ Left - ( depname + ( name , ( range , mlatestApplicable , DependencyMismatch $ adrVersion adr diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index c9099db537..4293a367e5 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -165,6 +165,7 @@ import Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL, stackRootL ) import Stack.Types.ConfigureOpts ( BaseConfigOpts (..), ConfigureOpts (..) ) +import Stack.Types.Dependency (DepValue(dvVersionRange)) import Stack.Types.DumpLogs ( DumpLogs (..) ) import Stack.Types.DumpPackage ( DumpPackage (..) ) import Stack.Types.EnvConfig @@ -979,44 +980,49 @@ toActions installedMap mtestLock runInBase ee (mbuild, mfinal) = afinal = case mfinal of Nothing -> [] Just task@Task {..} -> - (if taskAllInOne then id else (:) - Action - { actionId = ActionId pkgId ATBuildFinal - , actionDeps = addBuild - (Set.map (`ActionId` ATBuild) (tcoMissing taskConfigOpts)) - , actionDo = - \ac -> runInBase $ singleBuild ac ee task installedMap True - , actionConcurrency = ConcurrencyAllowed - }) $ + ( if taskAllInOne + then id + else (:) Action + { actionId = ActionId pkgId ATBuildFinal + , actionDeps = addBuild + (Set.map (`ActionId` ATBuild) (tcoMissing taskConfigOpts)) + , actionDo = + \ac -> runInBase $ singleBuild ac ee task installedMap True + , actionConcurrency = ConcurrencyAllowed + } + ) $ -- These are the "final" actions - running tests and benchmarks. - (if Set.null tests then id else (:) - Action - { actionId = ActionId pkgId ATRunTests - , actionDeps = finalDeps - , actionDo = \ac -> withLock mtestLock $ runInBase $ - singleTest topts (Set.toList tests) ac ee task installedMap - -- Always allow tests tasks to run concurrently with - -- other tasks, particularly build tasks. Note that - -- 'mtestLock' can optionally make it so that only - -- one test is run at a time. - , actionConcurrency = ConcurrencyAllowed - }) $ - (if Set.null benches then id else (:) - Action - { actionId = ActionId pkgId ATRunBenchmarks - , actionDeps = finalDeps - , actionDo = \ac -> runInBase $ - singleBench - beopts - (Set.toList benches) - ac - ee - task - installedMap - -- Never run benchmarks concurrently with any other task, see - -- #3663 - , actionConcurrency = ConcurrencyDisallowed - }) + ( if Set.null tests + then id + else (:) Action + { actionId = ActionId pkgId ATRunTests + , actionDeps = finalDeps + , actionDo = \ac -> withLock mtestLock $ runInBase $ + singleTest topts (Set.toList tests) ac ee task installedMap + -- Always allow tests tasks to run concurrently with other tasks, + -- particularly build tasks. Note that 'mtestLock' can optionally + -- make it so that only one test is run at a time. + , actionConcurrency = ConcurrencyAllowed + } + ) $ + ( if Set.null benches + then id + else (:) Action + { actionId = ActionId pkgId ATRunBenchmarks + , actionDeps = finalDeps + , actionDo = \ac -> runInBase $ + singleBench + beopts + (Set.toList benches) + ac + ee + task + installedMap + -- Never run benchmarks concurrently with any other task, see + -- #3663 + , actionConcurrency = ConcurrencyDisallowed + } + ) [] where pkgId = taskProvides task @@ -1488,10 +1494,10 @@ withSingleContext \errors." ] matchedDeps <- - forM (Map.toList customSetupDeps) $ \(name, range) -> do + forM (Map.toList customSetupDeps) $ \(name, depValue) -> do let matches (PackageIdentifier name' version) = - name == name' && - version `withinRange` range + name == name' + && version `withinRange` dvVersionRange depValue case filter (matches . fst) (Map.toList allDeps) of x:xs -> do unless (null xs) $ diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index 620dcedde5..436e7a3e3c 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -36,7 +36,7 @@ import qualified RIO.NonEmpty as NE import Stack.Constants ( wiredInPackages ) import Stack.Package ( PackageConfig (..), packageDependencies - , pdpModifiedBuildable, resolvePackageDescription + , resolvePackageDescription ) import Stack.Prelude hiding ( Display (..) ) import Stack.SourceMap @@ -174,9 +174,9 @@ gpdPackageDeps gpd ac platform flags = $ map (C.mkPackageName . unUnqualComponentName . fst) $ C.condSubLibraries gpd - -- Since tests and benchmarks are both enabled, doesn't matter - -- if we choose modified or unmodified - pkgDesc = pdpModifiedBuildable $ resolvePackageDescription pkgConfig gpd + -- Since tests and benchmarks are both enabled, doesn't matter if we choose + -- modified or unmodified + pkgDesc = resolvePackageDescription pkgConfig gpd pkgConfig = PackageConfig { packageConfigEnableTests = True , packageConfigEnableBenchmarks = True diff --git a/src/Stack/Component.hs b/src/Stack/Component.hs index d1666549b2..1ac9d492fc 100644 --- a/src/Stack/Component.hs +++ b/src/Stack/Component.hs @@ -23,6 +23,7 @@ module Stack.Component , stackTestFromCabal , foldOnNameAndBuildInfo , stackUnqualToQual + , processDependencies ) where import Data.Foldable ( foldr' ) @@ -44,7 +45,8 @@ import Stack.Types.Component , StackExecutable (..), StackForeignLibrary (..) , StackLibrary (..), StackTest (..), StackUnqualCompName (..) ) -import Stack.Types.Dependency ( cabalExeToStackDep, cabalToStackDep ) +import Stack.Types.Dependency + ( DepValue, cabalExeToStackDep, cabalToStackDep ) import Stack.Types.NamedComponent ( NamedComponent ) fromCabalName :: UnqualComponentName -> StackUnqualCompName @@ -185,6 +187,20 @@ gatherComponentToolsAndDepsFromCabal legacyBuildTools buildTools targetDeps = Map.insert pName (cabalToStackDep dep) $ sbiDependency sbi } +-- | This processes package's dependencies without recreating intermediate data +-- reprensentation for them. +processDependencies :: + (HasField "buildInfo" component StackBuildInfo, Monad m) + => (PackageName -> DepValue -> m (t resT) -> m (t resT)) + -> component + -> m (t resT) + -> m (t resT) +processDependencies iteratorFn component resAction = + Map.foldrWithKey' iteratorFn resAction componentDeps + where + componentDeps = buildInfo.sbiDependency + buildInfo = component.buildInfo + -- | A hard-coded map for tool dependencies. If a dependency is within this map -- it's considered "known" (the exe will be found at the execution stage). -- [It also exists in Cabal](https://hackage.haskell.org/package/Cabal/docs/src/Distribution.Simple.BuildToolDepends.html#local-6989586621679259154) diff --git a/src/Stack/Dot.hs b/src/Stack/Dot.hs index f539272dcd..28295a057b 100644 --- a/src/Stack/Dot.hs +++ b/src/Stack/Dot.hs @@ -36,7 +36,7 @@ import Stack.Build.Source ( loadCommonPackage, loadLocalPackage, loadSourceMap ) import Stack.Build.Target( NeedTargets (..), parseTargets ) import Stack.Constants ( wiredInPackages ) -import Stack.Package ( Package (..) ) +import Stack.Package ( Package (..), setOfPackageDeps ) import Stack.Prelude hiding ( Display (..), pkgName, loadPackage ) import qualified Stack.Prelude ( pkgName ) import Stack.Runners @@ -189,7 +189,7 @@ createDependencyGraph dotOpts = do pure ( Set.empty , DotPayload (Just version) (Just $ Right BSD3) Nothing ) | otherwise = - fmap (packageAllDeps &&& makePayload loc) + fmap (setOfPackageDeps &&& makePayload loc) (loadPackage loc flags ghcOptions cabalConfigOpts) resolveDependencies (dotDependencyDepth dotOpts) graph depLoader where @@ -433,7 +433,7 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = where loadDeps pp = do pkg <- loadCommonPackage (ppCommon pp) - pure (packageAllDeps pkg, payloadFromLocal pkg Nothing) + pure (setOfPackageDeps pkg, payloadFromLocal pkg Nothing) dependencyDeps = loadDeps <$> Map.lookup pkgName (smDeps sourceMap) @@ -441,7 +441,7 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = loadDeps DepPackage{dpLocation=PLMutable dir} = do pp <- mkProjectPackage YesPrintWarnings dir False pkg <- loadCommonPackage (ppCommon pp) - pure (packageAllDeps pkg, payloadFromLocal pkg (Just $ PLMutable dir)) + pure (setOfPackageDeps pkg, payloadFromLocal pkg (Just $ PLMutable dir)) loadDeps dp@DepPackage{dpLocation=PLImmutable loc} = do let common = dpCommon dp @@ -483,13 +483,14 @@ projectPackageDependencies :: projectPackageDependencies dotOpts locals = map (\lp -> let pkg = localPackageToPackage lp pkgDir = parent $ lpCabalFile lp + packageDepsSet = setOfPackageDeps pkg loc = PLMutable $ ResolvedPath (RelFilePath "N/A") pkgDir - in (packageName pkg, (deps pkg, lpPayload pkg loc))) + in (packageName pkg, (deps pkg packageDepsSet, lpPayload pkg loc))) locals where - deps pkg = if dotIncludeExternal dotOpts - then Set.delete (packageName pkg) (packageAllDeps pkg) - else Set.intersection localNames (packageAllDeps pkg) + deps pkg packageDepsSet = if dotIncludeExternal dotOpts + then Set.delete (packageName pkg) packageDepsSet + else Set.intersection localNames packageDepsSet localNames = Set.fromList $ map (packageName . lpPackage) locals lpPayload pkg loc = DotPayload (Just $ packageVersion pkg) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index ceaad19b7d..76630d1c1e 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -48,10 +48,10 @@ import Stack.Ghci.Script , scriptToLazyByteString ) import Stack.Package - ( PackageDescriptionPair (..), buildableExes - , buildableForeignLibs, hasBuildableMainLibrary - , getPackageOpts, packageFromPackageDescription - , readDotBuildinfo, resolvePackageDescription + ( buildableExes, buildableForeignLibs, getPackageOpts + , hasBuildableMainLibrary, listOfPackageDeps + , packageFromPackageDescription, readDotBuildinfo + , resolvePackageDescription ) import Stack.PackageFile ( getPackageFile ) import Stack.Prelude @@ -882,17 +882,8 @@ loadGhciPkgDesc buildOptsCLI name cabalfp target = do | otherwise = Nothing mbuildinfo <- forM mbuildinfofp readDotBuildinfo let pdp = resolvePackageDescription config gpkgdesc - pkg = - packageFromPackageDescription config (C.genPackageFlags gpkgdesc) $ - maybe - pdp - ( \bi -> - let PackageDescriptionPair x y = pdp - in PackageDescriptionPair - (C.updatePackageDescription bi x) - (C.updatePackageDescription bi y) - ) - mbuildinfo + pkg = packageFromPackageDescription config (C.genPackageFlags gpkgdesc) $ + maybe pdp (`C.updatePackageDescription` pdp) mbuildinfo pure GhciPkgDesc { ghciDescPkg = pkg , ghciDescCabalFp = cabalfp @@ -1201,7 +1192,7 @@ getExtraLoadDeps loadAllDeps localMap targets = getDeps :: PackageName -> [PackageName] getDeps name = case M.lookup name localMap of - Just lp -> M.keys (packageDeps (lpPackage lp)) -- FIXME just Local? + Just lp -> listOfPackageDeps (lpPackage lp) -- FIXME just Local? _ -> [] go :: PackageName @@ -1212,7 +1203,7 @@ getExtraLoadDeps loadAllDeps localMap targets = (Just (Just _), _) -> pure True (Just Nothing, _) | not loadAllDeps -> pure False (_, Just lp) -> do - let deps = M.keys (packageDeps (lpPackage lp)) + let deps = listOfPackageDeps (lpPackage lp) shouldLoad <- or <$> mapM go deps if shouldLoad then do diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 06a3332dfd..7fbab2c9a9 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -10,7 +10,6 @@ module Stack.Package , resolvePackage , packageFromPackageDescription , Package (..) - , PackageDescriptionPair (..) , PackageConfig (..) , buildLogPath , PackageException (..) @@ -26,10 +25,12 @@ module Stack.Package , buildableTestSuites , buildableBenchmarks , getPackageOpts + , processPackageDepsToList + , listOfPackageDeps + , setOfPackageDeps ) where import Data.Foldable ( Foldable (..) ) -import Data.List ( unzip ) import qualified Data.Map.Strict as M import qualified Data.Set as S import qualified Data.Text as T @@ -46,16 +47,13 @@ import Distribution.PackageDescription , GenericPackageDescription (..), HookedBuildInfo , Library (..), PackageDescription (..), PackageFlag (..) , SetupBuildInfo (..), TestSuite (..), allLibraries - , buildType, depPkgName, depVerRange, libraryNameString - , maybeToLibraryName + , buildType, depPkgName, depVerRange, maybeToLibraryName ) import Distribution.Pretty ( prettyShow ) import Distribution.Simple.PackageDescription ( readHookedBuildInfo ) import Distribution.System ( OS (..), Arch, Platform (..) ) import Distribution.Text ( display ) import qualified Distribution.Types.CondTree as Cabal -import qualified Distribution.Types.ExeDependency as Cabal -import qualified Distribution.Types.LegacyExeDependency as Cabal import qualified Distribution.Types.UnqualComponentName as Cabal import Distribution.Utils.Path ( getSymbolicPath ) import Distribution.Verbosity ( silent ) @@ -69,9 +67,10 @@ import Path import Path.Extra ( concatAndCollapseAbsDir, toFilePathNoTrailingSep ) import Stack.Component ( foldOnNameAndBuildInfo, isComponentBuildable - , stackBenchmarkFromCabal, stackExecutableFromCabal - , stackForeignLibraryFromCabal, stackLibraryFromCabal - , stackTestFromCabal, stackUnqualToQual + , processDependencies, stackBenchmarkFromCabal + , stackExecutableFromCabal, stackForeignLibraryFromCabal + , stackLibraryFromCabal, stackTestFromCabal + , stackUnqualToQual ) import Stack.ComponentFile ( buildDir, componentAutogenDir, componentBuildDir @@ -85,21 +84,24 @@ import Stack.Types.BuildConfig ( HasBuildConfig (..), getProjectWorkDir ) import Stack.Types.CompCollection ( CompCollection, foldAndMakeCollection - , getBuildableSetText + , foldComponentToAnotherCollection, getBuildableSetText ) import Stack.Types.Compiler ( ActualCompiler (..) ) import Stack.Types.CompilerPaths ( cabalVersionL ) import Stack.Types.Component ( HasBuildInfo ) import qualified Stack.Types.Component as Component import Stack.Types.Config ( Config (..), HasConfig (..) ) -import Stack.Types.Dependency ( DepType (..), DepValue (..) ) +import Stack.Types.Dependency + ( DepValue (..), cabalSetupDepsToStackDep + , libraryDepFromVersionRange + ) import Stack.Types.EnvConfig ( HasEnvConfig ) import Stack.Types.GhcPkgId ( ghcPkgIdString ) import Stack.Types.NamedComponent ( NamedComponent (..), subLibComponents ) import Stack.Types.Package - ( BioInput (..), BuildInfoOpts (..), ExeName (..) - , InstallMap, Installed (..), InstalledMap, Package (..) + ( BioInput(..), BuildInfoOpts (..), InstallMap + , Installed (..), InstalledMap, Package (..) , PackageConfig (..), PackageException (..) , dotCabalCFilePath, packageIdentifier ) @@ -130,17 +132,16 @@ resolvePackage packageConfig gpkg = packageFromPackageDescription :: PackageConfig -> [PackageFlag] - -> PackageDescriptionPair + -> PackageDescription -> Package packageFromPackageDescription packageConfig pkgFlags - (PackageDescriptionPair pkgNoMod pkg) + pkg = Package { packageName = name , packageVersion = pkgVersion pkgId , packageLicense = licenseRaw pkg - , packageDeps = deps , packageGhcOptions = packageConfigGhcOptions packageConfig , packageCabalConfigOpts = packageConfigCabalConfigOpts packageConfig , packageFlags = packageConfigFlags packageConfig @@ -152,76 +153,34 @@ packageFromPackageDescription , packageForeignLibraries = foldAndMakeCollection stackForeignLibraryFromCabal $ foreignLibs pkg , packageTestSuites = - foldAndMakeCollection stackTestFromCabal $ testSuites pkgNoMod + foldAndMakeCollection stackTestFromCabal $ testSuites pkg , packageBenchmarks = - foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkgNoMod + foldAndMakeCollection stackBenchmarkFromCabal $ benchmarks pkg , packageExecutables = foldAndMakeCollection stackExecutableFromCabal $ executables pkg - , packageAllDeps = M.keysSet deps , packageSubLibDeps = subLibDeps , packageBuildType = buildType pkg - , packageSetupDeps = msetupDeps + , packageSetupDeps = fmap cabalSetupDepsToStackDep (setupBuildInfo pkg) , packageCabalSpec = specVersion pkg , packageFile = stackPackageFileFromCabal pkg + , packageTestEnabled = packageConfigEnableTests packageConfig + , packageBenchmarkEnabled = packageConfigEnableBenchmarks packageConfig } where - extraLibNames = S.union subLibNames foreignLibNames - - subLibNames - = S.fromList - $ map (T.pack . Cabal.unUnqualComponentName) - $ mapMaybe (libraryNameString . libName) -- this is a design bug in the - -- Cabal API: this should - -- statically be known to exist - $ filter (buildable . libBuildInfo) - $ subLibraries pkg - - foreignLibNames - = S.fromList - $ map (T.pack . Cabal.unUnqualComponentName . foreignLibName) - $ filter (buildable . foreignLibBuildInfo) - $ foreignLibs pkg - -- Gets all of the modules, files, build files, and data files that constitute -- the package. This is primarily used for dirtiness checking during build, as -- well as use by "stack ghci" pkgId = package pkg name = pkgName pkgId - (_unknownTools, knownTools) = packageDescTools pkg - - deps = M.filterWithKey (const . not . isMe) (M.unionsWith (<>) - [ asLibrary <$> packageDependencies pkg - -- We include all custom-setup deps - if present - in the package deps - -- themselves. Stack always works with the invariant that there will be a - -- single installed package relating to a package name, and this applies at - -- the setup dependency level as well. - , asLibrary <$> fromMaybe M.empty msetupDeps - , knownTools - ]) - - msetupDeps = fmap - (M.fromList . map (depPkgName &&& depVerRange) . setupDepends) - (setupBuildInfo pkg) - subLibDeps = M.fromList $ concatMap (\(Dependency n vr libs) -> mapMaybe (getSubLibName n vr) (NES.toList libs)) (concatMap targetBuildDepends (allBuildInfo' pkg)) getSubLibName pn vr lib@(LSubLibName _) = - Just (MungedPackageName pn lib, asLibrary vr) + Just (MungedPackageName pn lib, libraryDepFromVersionRange vr) getSubLibName _ _ _ = Nothing - asLibrary range = DepValue - { dvVersionRange = range - , dvType = AsLibrary - } - - -- Is the package dependency mentioned here me: either the package name - -- itself, or the name of one of the sub libraries - isMe name' = name' == name - || fromString (packageNameString name') `S.member` extraLibNames - toInternalPackageMungedName :: Package -> Text -> Text toInternalPackageMungedName pkg = T.pack @@ -471,73 +430,6 @@ packageDependencies pkg = concatMap targetBuildDepends (allBuildInfo' pkg) <> maybe [] setupDepends (setupBuildInfo pkg) --- | Get all dependencies of the package (buildable targets only). --- --- This uses both the new 'buildToolDepends' and old 'buildTools' information. -packageDescTools :: - PackageDescription - -> (Set ExeName, Map PackageName DepValue) -packageDescTools pd = - (S.fromList $ concat unknowns, M.fromListWith (<>) $ concat knowns) - where - (unknowns, knowns) = unzip $ map perBI $ allBuildInfo' pd - - perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)]) - perBI bi = - (unknownTools, tools) - where - (unknownTools, knownTools) = partitionEithers $ map go1 (buildTools bi) - - tools = mapMaybe go2 (knownTools ++ buildToolDepends bi) - - -- This is similar to desugarBuildTool from Cabal, however it - -- uses our own hard-coded map which drops tools shipped with - -- GHC (like hsc2hs), and includes some tools from Stackage. - go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency - go1 (Cabal.LegacyExeDependency name range) = - case M.lookup name hardCodedMap of - Just pkgName -> - Right $ - Cabal.ExeDependency pkgName (Cabal.mkUnqualComponentName name) range - Nothing -> Left $ ExeName $ T.pack name - - go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue) - go2 (Cabal.ExeDependency pkg _name range) - | pkg `S.member` preInstalledPackages = Nothing - | otherwise = Just - ( pkg - , DepValue - { dvVersionRange = range - , dvType = AsBuildTool - } - ) - --- | A hard-coded map for tool dependencies -hardCodedMap :: Map String PackageName -hardCodedMap = M.fromList - [ ("alex", Distribution.Package.mkPackageName "alex") - , ("happy", Distribution.Package.mkPackageName "happy") - , ("cpphs", Distribution.Package.mkPackageName "cpphs") - , ("greencard", Distribution.Package.mkPackageName "greencard") - , ("c2hs", Distribution.Package.mkPackageName "c2hs") - , ("hscolour", Distribution.Package.mkPackageName "hscolour") - , ("hspec-discover", Distribution.Package.mkPackageName "hspec-discover") - , ("hsx2hs", Distribution.Package.mkPackageName "hsx2hs") - , ("gtk2hsC2hs", Distribution.Package.mkPackageName "gtk2hs-buildtools") - , ("gtk2hsHookGenerator", Distribution.Package.mkPackageName "gtk2hs-buildtools") - , ("gtk2hsTypeGen", Distribution.Package.mkPackageName "gtk2hs-buildtools") - ] - --- | Executable-only packages which come pre-installed with GHC and do not need --- to be built. Without this exception, we would either end up unnecessarily --- rebuilding these packages, or failing because the packages do not appear in --- the Stackage snapshot. -preInstalledPackages :: Set PackageName -preInstalledPackages = S.fromList - [ mkPackageName "hsc2hs" - , mkPackageName "haddock" - ] - -- | Variant of 'allBuildInfo' from Cabal that, like versions before Cabal 2.2 -- only includes buildable components. allBuildInfo' :: PackageDescription -> [BuildInfo] @@ -557,42 +449,21 @@ allBuildInfo' pkg_descr = [ bi | lib <- allLibraries pkg_descr , let bi = benchmarkBuildInfo tst , buildable bi ] --- | A pair of package descriptions: one which modified the buildable values of --- test suites and benchmarks depending on whether they are enabled, and one --- which does not. --- --- Fields are intentionally lazy, we may only need one or the other value. --- --- Michael S Snoyman 2017-08-29: The very presence of this data type is terribly --- ugly, it represents the fact that the Cabal 2.0 upgrade did _not_ go well. --- Specifically, we used to have a field to indicate whether a component was --- enabled in addition to buildable, but that's gone now, and this is an ugly --- proxy. We should at some point clean up the mess of Package, LocalPackage, --- etc, and probably pull in the definition of PackageDescription from Cabal --- with our additionally needed metadata. But this is a good enough hack for the --- moment. Odds are, you're reading this in the year 2024 and thinking "wtf?" -data PackageDescriptionPair = PackageDescriptionPair - { pdpOrigBuildable :: PackageDescription - , pdpModifiedBuildable :: PackageDescription - } - -- | Evaluates the conditions of a 'GenericPackageDescription', yielding -- a resolved 'PackageDescription'. resolvePackageDescription :: PackageConfig -> GenericPackageDescription - -> PackageDescriptionPair + -> PackageDescription resolvePackageDescription packageConfig ( GenericPackageDescription desc _ defaultFlags mlib subLibs foreignLibs' exes tests benches ) = - PackageDescriptionPair - { pdpOrigBuildable = go False - , pdpModifiedBuildable = go True - } + go False where + -- TODO: remove modBuildable go modBuildable = desc { library = fmap (resolveConditions rc updateLibDeps) mlib , subLibraries = map @@ -796,12 +667,9 @@ applyForceCustomBuild cabalVersion package | forceCustomBuild = package { packageBuildType = Custom - , packageDeps = - M.insertWith (<>) "Cabal" (DepValue cabalVersionRange AsLibrary) $ - packageDeps package , packageSetupDeps = Just $ M.fromList - [ ("Cabal", cabalVersionRange) - , ("base", anyVersion) + [ ("Cabal", libraryDepFromVersionRange cabalVersionRange) + , ("base", libraryDepFromVersionRange anyVersion) ] } | otherwise = package @@ -861,3 +729,73 @@ buildableTestSuites pkg = getBuildableSetText (packageTestSuites pkg) buildableBenchmarks :: Package -> Set Text buildableBenchmarks pkg = getBuildableSetText (packageBenchmarks pkg) + +-- | This is a function to iterate in a monad over all of a package component's +-- dependencies, and yield a collection of results (used with list and set). +processPackageDeps :: + (Monad m, Monoid (targetedCollection resT)) + => Package + -> (resT -> targetedCollection resT -> targetedCollection resT) + -> (PackageName -> DepValue -> m resT) + -> m (targetedCollection resT) +processPackageDeps pkg combineResults fn = do + let asPackageNameSet accessor = + S.map (mkPackageName . T.unpack) $ getBuildableSetText $ accessor pkg + let (!subLibNames, !foreignLibNames) = + ( asPackageNameSet packageSubLibraries + , asPackageNameSet packageForeignLibraries + ) + let shouldIgnoreDep (packageNameV :: PackageName) + | packageNameV == packageName pkg = True + | packageNameV `S.member` subLibNames = True + | packageNameV `S.member` foreignLibNames = True + | otherwise = False + let innerIterator packageName depValue resListInMonad + | shouldIgnoreDep packageName = resListInMonad + | otherwise = do + resList <- resListInMonad + newResElement <- fn packageName depValue + pure $ combineResults newResElement resList + let compProcessor target = + foldComponentToAnotherCollection + (target pkg) + (processDependencies innerIterator) + let packageSetupDepsProcessor resAction = case packageSetupDeps pkg of + Nothing -> resAction + Just v -> M.foldrWithKey' innerIterator resAction v + let processAllComp = + compProcessor packageSubLibraries + . compProcessor packageForeignLibraries + . compProcessor packageExecutables + . ( if packageBenchmarkEnabled pkg + then compProcessor packageBenchmarks + else id + ) + . ( if packageTestEnabled pkg + then compProcessor packageTestSuites + else id + ) + . packageSetupDepsProcessor + let initialValue = case packageLibrary pkg of + Nothing -> pure mempty + Just comp -> processDependencies innerIterator comp (pure mempty) + processAllComp initialValue + +-- | Iterate/fold on all the package dependencies, components, setup deps and +-- all. +processPackageDepsToList :: + Monad m + => Package + -> (PackageName -> DepValue -> m resT) + -> m [resT] +processPackageDepsToList pkg = processPackageDeps pkg (:) + +-- | List all package's dependencies in a "free" context through the identity +-- monad. +listOfPackageDeps :: Package -> [PackageName] +listOfPackageDeps pkg = + runIdentity $ processPackageDepsToList pkg (\pn _ -> pure pn) +-- | The set of package's dependencies. +setOfPackageDeps :: Package -> Set PackageName +setOfPackageDeps pkg = + runIdentity $ processPackageDeps pkg S.insert (\pn _ -> pure pn) diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index 24462c7bad..9880b4fab8 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -55,10 +55,7 @@ import Stack.Build.Installed ( getInstalled, toInstallMap ) import Stack.Build.Source ( projectLocalPackages ) import Stack.Constants ( stackProgName, stackProgName' ) import Stack.Constants.Config ( distDirFromDir ) -import Stack.Package - ( PackageDescriptionPair (..), resolvePackage - , resolvePackageDescription - ) +import Stack.Package ( resolvePackage, resolvePackageDescription ) import Stack.Prelude import Stack.Runners ( ShouldReexec (..), withConfig, withDefaultEnvConfig ) @@ -565,7 +562,7 @@ checkPackageInExtractedTarball pkgDir = do (gpdio, name, _cabalfp) <- loadCabalFilePath (Just stackProgName') pkgDir gpd <- liftIO $ gpdio YesPrintWarnings config <- getDefaultPackageConfig - let PackageDescriptionPair pkgDesc _ = resolvePackageDescription config gpd + let pkgDesc = resolvePackageDescription config gpd prettyInfoL [ flow "Checking package" , style Current (fromString $ packageNameString name) diff --git a/src/Stack/Types/CompCollection.hs b/src/Stack/Types/CompCollection.hs index d55c63940b..12ee9f3a1e 100644 --- a/src/Stack/Types/CompCollection.hs +++ b/src/Stack/Types/CompCollection.hs @@ -23,6 +23,7 @@ module Stack.Types.CompCollection , collectionLookup , collectionKeyValueList , collectionMember + , foldComponentToAnotherCollection ) where import qualified Data.HashMap.Strict as HM @@ -157,3 +158,12 @@ collectionKeyValueList haystack = collectionMember :: Text -> CompCollection component -> Bool collectionMember needle haystack = isJust $ collectionLookup needle haystack + +foldComponentToAnotherCollection :: + (Monad m) + => CompCollection component + -> (component -> m (t b) -> m (t b)) + -> m (t b) + -> m (t b) +foldComponentToAnotherCollection collection fn initialValue = + HM.foldr' fn initialValue (asNameMap $ buildableOnes collection) diff --git a/src/Stack/Types/Dependency.hs b/src/Stack/Types/Dependency.hs index 3985b8871e..6de2601d94 100644 --- a/src/Stack/Types/Dependency.hs +++ b/src/Stack/Types/Dependency.hs @@ -5,24 +5,25 @@ module Stack.Types.Dependency , DepType (..) , cabalToStackDep , cabalExeToStackDep + , cabalSetupDepsToStackDep + , libraryDepFromVersionRange + , isDepTypeLibrary ) where +import Data.Foldable ( foldr' ) +import qualified Data.Map as Map import qualified Distribution.PackageDescription as Cabal import Distribution.Types.VersionRange ( VersionRange ) import Stack.Prelude -import Stack.Types.Version ( intersectVersionRanges ) -- | The value for a map from dependency name. This contains both the version --- range and the type of dependency, and provides a semigroup instance. +-- range and the type of dependency. data DepValue = DepValue { dvVersionRange :: !VersionRange , dvType :: !DepType } deriving (Show, Typeable) -instance Semigroup DepValue where - DepValue a x <> DepValue b y = DepValue (intersectVersionRanges a b) (x <> y) - -- | Is this package being used as a library, or just as a build tool? If the -- former, we need to ensure that a library actually exists. See -- @@ -31,13 +32,27 @@ data DepType | AsBuildTool deriving (Eq, Show) -instance Semigroup DepType where - AsLibrary <> _ = AsLibrary - AsBuildTool <> x = x +isDepTypeLibrary :: DepType -> Bool +isDepTypeLibrary AsLibrary = True +isDepTypeLibrary AsBuildTool = False cabalToStackDep :: Cabal.Dependency -> DepValue cabalToStackDep (Cabal.Dependency _ verRange _libNameSet) = DepValue{dvVersionRange = verRange, dvType = AsLibrary} + cabalExeToStackDep :: Cabal.ExeDependency -> DepValue cabalExeToStackDep (Cabal.ExeDependency _ _name verRange) = DepValue{dvVersionRange = verRange, dvType = AsBuildTool} + +cabalSetupDepsToStackDep :: Cabal.SetupBuildInfo -> Map PackageName DepValue +cabalSetupDepsToStackDep setupInfo = + foldr' inserter mempty (Cabal.setupDepends setupInfo) + where + inserter d@(Cabal.Dependency packageName _ _) = + Map.insert packageName (cabalToStackDep d) + +libraryDepFromVersionRange :: VersionRange -> DepValue +libraryDepFromVersionRange range = DepValue + { dvVersionRange = range + , dvType = AsLibrary + } diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 058ab582a2..614f0b4824 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -67,7 +67,6 @@ import Stack.Types.PackageFile , StackPackageFile ) import Stack.Types.SourceMap ( CommonPackage, FromSnapshot ) -import Stack.Types.Version ( VersionRange ) -- | Type representing exceptions thrown by functions exported by the -- "Stack.Package" module. @@ -155,11 +154,6 @@ data Package = Package -- ^ Version of the package , packageLicense :: !(Either SPDX.License License) -- ^ The license the package was released under. - , packageDeps :: !(Map PackageName DepValue) - -- ^ Packages that the package depends on, both as libraries and build - -- tools. - , packageAllDeps :: !(Set PackageName) - -- ^ Original dependencies (not sieved). , packageSubLibDeps :: !(Map MungedPackageName DepValue) -- ^ Original sub-library dependencies (not sieved). , packageGhcOptions :: ![Text] @@ -184,13 +178,21 @@ data Package = Package -- ^ The executables of the package. , packageBuildType :: !BuildType -- ^ Package build-type. - , packageSetupDeps :: !(Maybe (Map PackageName VersionRange)) + , packageSetupDeps :: !(Maybe (Map PackageName DepValue)) -- ^ If present: custom-setup dependencies , packageCabalSpec :: !CabalSpecVersion -- ^ Cabal spec range , packageFile :: StackPackageFile - -- ^ The cabal sourced files related to the package at the package level + -- ^ The Cabal sourced files related to the package at the package level -- The components may have file information in their own types + , packageTestEnabled :: Bool + -- ^ This is a requirement because when tests are not enabled, Stack's + -- package dependencies should ignore test dependencies. Directly set from + -- 'packageConfigEnableTests'. + , packageBenchmarkEnabled :: Bool + -- ^ This is a requirement because when benchmark are not enabled, Stack's + -- package dependencies should ignore benchmark dependencies. Directly set + -- from 'packageConfigEnableBenchmarks'. } deriving (Show, Typeable)