From afa4db4a81af46f36f1adc19af6a48ebcaca416b Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 14 Jan 2024 19:46:50 +0000 Subject: [PATCH 1/2] Remove dp prefix from DepPackage field names --- src/Stack/Build/ConstructPlan.hs | 4 ++-- src/Stack/Build/Installed.hs | 4 ++-- src/Stack/Build/Source.hs | 16 ++++++++-------- src/Stack/Build/Target.hs | 2 +- src/Stack/BuildPlan.hs | 2 +- src/Stack/Config.hs | 8 ++++---- src/Stack/DependencyGraph.hs | 6 +++--- src/Stack/Ghci.hs | 4 ++-- src/Stack/Hoogle.hs | 2 +- src/Stack/Script.hs | 6 +++--- src/Stack/SourceMap.hs | 18 +++++++++--------- src/Stack/Types/SourceMap.hs | 15 ++++++++------- 12 files changed, 44 insertions(+), 43 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 531bea7f6f..4cab565078 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -299,10 +299,10 @@ constructPlan pure $ PSFilePath lp bopts <- view $ configL . to (.build) deps <- for sourceDeps $ \dp -> - case dp.dpLocation of + case dp.location of PLImmutable loc -> pure $ - PSRemote loc (getPLIVersion loc) dp.dpFromSnapshot dp.dpCommon + PSRemote loc (getPLIVersion loc) dp.fromSnapshot dp.common PLMutable dir -> do pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts) lp <- loadLocalPackage' pp diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs index ae6f9c1be9..904f91c9d5 100644 --- a/src/Stack/Build/Installed.hs +++ b/src/Stack/Build/Installed.hs @@ -44,10 +44,10 @@ toInstallMap sourceMap = do pure (Local, version) depInstalls <- for sourceMap.smDeps $ \dp -> - case dp.dpLocation of + case dp.location of PLImmutable pli -> pure (Snap, getPLIVersion pli) PLMutable _ -> do - version <- loadVersion dp.dpCommon + version <- loadVersion dp.common pure (Local, version) pure $ projectInstalls <> depInstalls diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index fb5e70a685..ea9e4578f6 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -84,7 +84,7 @@ localDependencies = do bopts <- view $ configL . to (.build) sourceMap <- view $ envConfigL . to (.sourceMap) forMaybeM (Map.elems sourceMap.smDeps) $ \dp -> - case dp.dpLocation of + case dp.location of PLMutable dir -> do pp <- mkProjectPackage YesPrintWarnings dir (shouldHaddockDeps bopts) Just <$> loadLocalPackage pp @@ -106,8 +106,8 @@ loadSourceMap smt boptsCli sma = do p{ppCommon = applyOptsFlags (M.member c.name smt.smtTargets) True c} deps0 = smt.smtDeps <> sma.smaDeps deps = M.map applyOptsFlagsDep deps0 - applyOptsFlagsDep d@DepPackage{dpCommon = c} = - d{dpCommon = applyOptsFlags (M.member c.name smt.smtDeps) False c} + applyOptsFlagsDep d@DepPackage{ common = c } = + d{ common = applyOptsFlags (M.member c.name smt.smtDeps) False c } applyOptsFlags isTarget isProjectPackage common = let name = common.name flags = getLocalFlags boptsCli name @@ -190,17 +190,17 @@ hashSourceMapData boptsCli sm = do depPackageHashableContent :: (HasConfig env) => DepPackage -> RIO env Builder depPackageHashableContent dp = - case dp.dpLocation of + case dp.location of PLMutable _ -> pure "" PLImmutable pli -> do let flagToBs (f, enabled) = if enabled then "" else "-" <> fromString (C.unFlagName f) - flags = map flagToBs $ Map.toList dp.dpCommon.flags - ghcOptions = map display dp.dpCommon.ghcOptions - cabalConfigOpts = map display dp.dpCommon.cabalConfigOpts - haddocks = if dp.dpCommon.haddocks then "haddocks" else "" + flags = map flagToBs $ Map.toList dp.common.flags + ghcOptions = map display dp.common.ghcOptions + cabalConfigOpts = map display dp.common.cabalConfigOpts + haddocks = if dp.common.haddocks then "haddocks" else "" hash = immutableLocSha pli pure $ hash diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs index 6dce4f4326..4e8ba2892d 100644 --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -543,7 +543,7 @@ parseTargets needTargets haddockDeps boptscli smActual = do (errs1, concat -> rawTargets) <- fmap partitionEithers $ forM rawInput $ parseRawTargetDirs workingDir locals - let depLocs = Map.map (.dpLocation) smActual.smaDeps + let depLocs = Map.map (.location) smActual.smaDeps (errs2, resolveResults) <- fmap partitionEithers $ forM rawTargets $ resolveRawTarget smActual depLocs diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index 968279613a..f2790ceb6f 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -386,7 +386,7 @@ checkSnapBuildPlan pkgDirs flags snapCandidate = do let compiler = sma.smaCompiler globalVersion (GlobalPackageVersion v) = v depVersion dep - | PLImmutable loc <- dep.dpLocation = Just $ packageLocationVersion loc + | PLImmutable loc <- dep.location = Just $ packageLocationVersion loc | otherwise = Nothing snapPkgs = Map.union (Map.mapMaybe depVersion sma.smaDeps) diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index a7c28142a2..072cecaf8c 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -892,11 +892,11 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages RPLMutable p -> pure (PLMutable p, Nothing) dp <- additionalDepPackage (shouldHaddockDeps bopts) pl - pure ((dp.dpCommon.name, dp), mCompleted) + pure ((dp.common.name, dp), mCompleted) checkDuplicateNames $ map (second (PLMutable . (.ppResolvedDir))) packages0 ++ - map (second (.dpLocation)) deps0 + map (second (.location)) deps0 let packages1 = Map.fromList packages0 snPackages = snapPackages @@ -914,13 +914,13 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages packages2 = mergeApply packages1 pFlags $ \_ p flags -> p{ ppCommon = p.ppCommon { CommonPackage.flags = flags } } deps2 = mergeApply deps1 pFlags $ - \_ d flags -> d{ dpCommon = d.dpCommon { CommonPackage.flags = flags } } + \_ d flags -> d{ common = d.common { CommonPackage.flags = flags } } checkFlagsUsedThrowing pFlags FSStackYaml packages1 deps1 let pkgGhcOptions = config.ghcOptionsByName deps = mergeApply deps2 pkgGhcOptions $ - \_ d options -> d{ dpCommon = d.dpCommon { ghcOptions = options } } + \_ d options -> d{ common = d.common { ghcOptions = options } } packages = mergeApply packages2 pkgGhcOptions $ \_ p options -> p{ ppCommon = p.ppCommon { ghcOptions = options } } unusedPkgGhcOptions = diff --git a/src/Stack/DependencyGraph.hs b/src/Stack/DependencyGraph.hs index 70bcd882df..14f1eb2124 100644 --- a/src/Stack/DependencyGraph.hs +++ b/src/Stack/DependencyGraph.hs @@ -262,13 +262,13 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = dependencyDeps = loadDeps <$> Map.lookup pkgName sourceMap.smDeps where - loadDeps DepPackage{dpLocation=PLMutable dir} = do + loadDeps DepPackage{ location = PLMutable dir } = do pp <- mkProjectPackage YesPrintWarnings dir False pkg <- loadCommonPackage pp.ppCommon pure (setOfPackageDeps pkg, payloadFromLocal pkg (Just $ PLMutable dir)) - loadDeps dp@DepPackage{dpLocation=PLImmutable loc} = do - let common = dp.dpCommon + loadDeps dp@DepPackage{ location = PLImmutable loc } = do + let common = dp.common gpd <- liftIO common.gpd let PackageIdentifier name version = PD.package $ PD.packageDescription gpd flags = common.flags diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index d28dea4837..e93a120704 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -848,11 +848,11 @@ loadGhciPkgDesc buildOptsCLI name cabalfp target = do sourceMapGhcOptions = fromMaybe [] $ ((.ppCommon.ghcOptions) <$> M.lookup name sm.smProject) <|> - ((.dpCommon.ghcOptions) <$> M.lookup name sm.smDeps) + ((.common.ghcOptions) <$> M.lookup name sm.smDeps) sourceMapCabalConfigOpts = fromMaybe [] $ ( (.ppCommon.cabalConfigOpts) <$> M.lookup name sm.smProject) <|> - ((.dpCommon.cabalConfigOpts) <$> M.lookup name sm.smDeps) + ((.common.cabalConfigOpts) <$> M.lookup name sm.smDeps) sourceMapFlags = maybe mempty (.ppCommon.flags) $ M.lookup name sm.smProject config = PackageConfig diff --git a/src/Stack/Hoogle.hs b/src/Stack/Hoogle.hs index d563c26074..c22940ca82 100644 --- a/src/Stack/Hoogle.hs +++ b/src/Stack/Hoogle.hs @@ -157,7 +157,7 @@ hoogleCmd (args, setup, rebuild, startServer) = sourceMap <- view $ sourceMapL . to (.smDeps) case Map.lookup hooglePackageName sourceMap of Just hoogleDep -> - case hoogleDep.dpLocation of + case hoogleDep.location of PLImmutable pli -> T.pack . packageIdentifierString <$> restrictMinHoogleVersion muted (packageLocationIdent pli) diff --git a/src/Stack/Script.hs b/src/Stack/Script.hs index faad4821e9..f6be1b3d5d 100644 --- a/src/Stack/Script.hs +++ b/src/Stack/Script.hs @@ -333,7 +333,7 @@ hashSnapshot = do sourceMap <- view $ envConfigL . to (.sourceMap) compilerInfo <- getCompilerInfo let eitherPliHash (pn, dep) - | PLImmutable pli <- dep.dpLocation = Right $ immutableLocSha pli + | PLImmutable pli <- dep.location = Right $ immutableLocSha pli | otherwise = Left pn deps = Map.toList sourceMap.smDeps case partitionEithers (map eitherPliHash deps) of @@ -351,14 +351,14 @@ mapSnapshotPackageModules = do (_installedMap, globalDumpPkgs, snapshotDumpPkgs, _localDumpPkgs) <- getInstalled installMap let globals = dumpedPackageModules sourceMap.smGlobal globalDumpPkgs - notHidden = Map.filter (not . (.dpHidden)) + notHidden = Map.filter (not . (.hidden)) notHiddenDeps = notHidden sourceMap.smDeps installedDeps = dumpedPackageModules notHiddenDeps snapshotDumpPkgs dumpPkgs = Set.fromList $ map (pkgName . (.packageIdent)) snapshotDumpPkgs notInstalledDeps = Map.withoutKeys notHiddenDeps dumpPkgs otherDeps <- for notInstalledDeps $ \dep -> do - gpd <- liftIO dep.dpCommon.gpd + gpd <- liftIO dep.common.gpd Set.fromList <$> allExposedModules gpd -- source map construction process should guarantee unique package names in -- these maps diff --git a/src/Stack/SourceMap.hs b/src/Stack/SourceMap.hs index dfb551a25d..22c0817992 100644 --- a/src/Stack/SourceMap.hs +++ b/src/Stack/SourceMap.hs @@ -96,10 +96,10 @@ additionalDepPackage buildHaddocks pl = do run <- askRunInIO pure (name, run $ loadCabalFileImmutable pli) pure DepPackage - { dpLocation = pl - , dpHidden = False - , dpFromSnapshot = NotFromSnapshot - , dpCommon = + { location = pl + , hidden = False + , fromSnapshot = NotFromSnapshot + , common = CommonPackage { gpd = gpdio , name = name @@ -120,10 +120,10 @@ snapToDepPackage :: snapToDepPackage buildHaddocks name sp = do run <- askRunInIO pure DepPackage - { dpLocation = PLImmutable sp.spLocation - , dpHidden = sp.spHidden - , dpFromSnapshot = FromSnapshot - , dpCommon = + { location = PLImmutable sp.spLocation + , hidden = sp.spHidden + , fromSnapshot = FromSnapshot + , common = CommonPackage { gpd = run $ loadCabalFileImmutable sp.spLocation , name = name @@ -237,7 +237,7 @@ getUnusedPackageFlags :: -> m (Maybe UnusedFlags) getUnusedPackageFlags (name, userFlags) source prj deps = let maybeCommon = fmap (.ppCommon) (Map.lookup name prj) - <|> fmap (.dpCommon) (Map.lookup name deps) + <|> fmap (.common) (Map.lookup name deps) in case maybeCommon of -- Package is not available as project or dependency Nothing -> diff --git a/src/Stack/Types/SourceMap.hs b/src/Stack/Types/SourceMap.hs index 2f7890ef14..71ee95ea9c 100644 --- a/src/Stack/Types/SourceMap.hs +++ b/src/Stack/Types/SourceMap.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE NoFieldSelectors #-} -{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE NoFieldSelectors #-} +{-# LANGUAGE OverloadedRecordDot #-} -- | A sourcemap maps a package name to how it should be built, including source -- code, flags, options, etc. This module contains various stages of source map @@ -63,12 +64,12 @@ data FromSnapshot -- | A view of a dependency package, specified in stack.yaml data DepPackage = DepPackage - { dpCommon :: !CommonPackage - , dpLocation :: !PackageLocation - , dpHidden :: !Bool + { common :: !CommonPackage + , location :: !PackageLocation + , hidden :: !Bool -- ^ Should the package be hidden after registering? Affects the script -- interpreter's module name import parser. - , dpFromSnapshot :: !FromSnapshot + , fromSnapshot :: !FromSnapshot -- ^ Needed to ignore bounds between snapshot packages -- See https://github.com/commercialhaskell/stackage/issues/3185 } From 6188b9a17daeb8e04f25325e281ce59861a6cf62 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 14 Jan 2024 20:01:08 +0000 Subject: [PATCH 2/2] Remove pp prefix from ProjectPackage field names --- src/Stack/Build/Installed.hs | 2 +- src/Stack/Build/Source.hs | 22 ++++++++++++++-------- src/Stack/BuildPlan.hs | 2 +- src/Stack/Config.hs | 22 ++++++++++++---------- src/Stack/DependencyGraph.hs | 4 ++-- src/Stack/Ghci.hs | 8 ++++---- src/Stack/IDE.hs | 2 +- src/Stack/SDist.hs | 4 ++-- src/Stack/SourceMap.hs | 17 +++++++++-------- src/Stack/Types/SourceMap.hs | 10 +++++----- 10 files changed, 51 insertions(+), 42 deletions(-) diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs index 904f91c9d5..3b23244ce5 100644 --- a/src/Stack/Build/Installed.hs +++ b/src/Stack/Build/Installed.hs @@ -40,7 +40,7 @@ toInstallMap :: MonadIO m => SourceMap -> m InstallMap toInstallMap sourceMap = do projectInstalls <- for sourceMap.smProject $ \pp -> do - version <- loadVersion pp.ppCommon + version <- loadVersion pp.common pure (Local, version) depInstalls <- for sourceMap.smDeps $ \dp -> diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs index ea9e4578f6..e8b05e17ab 100644 --- a/src/Stack/Build/Source.hs +++ b/src/Stack/Build/Source.hs @@ -68,6 +68,8 @@ import Stack.Types.SourceMap , SMActual (..), SMTargets (..), SourceMap (..) , SourceMapHash (..), Target (..), ppGPD, ppRoot ) +import qualified Stack.Types.SourceMap as DepPackage ( DepPackage (..) ) +import qualified Stack.Types.SourceMap as ProjectPackage ( ProjectPackage (..) ) import Stack.Types.UnusedFlags ( FlagSource (..) ) import System.FilePath ( takeFileName ) import System.IO.Error ( isDoesNotExistError ) @@ -102,12 +104,16 @@ loadSourceMap smt boptsCli sma = do let compiler = sma.smaCompiler project = M.map applyOptsFlagsPP sma.smaProject bopts = bconfig.config.build - applyOptsFlagsPP p@ProjectPackage{ppCommon = c} = - p{ppCommon = applyOptsFlags (M.member c.name smt.smtTargets) True c} + applyOptsFlagsPP p@ProjectPackage{ common = c } = p + { ProjectPackage.common = + applyOptsFlags (M.member c.name smt.smtTargets) True c + } deps0 = smt.smtDeps <> sma.smaDeps deps = M.map applyOptsFlagsDep deps0 - applyOptsFlagsDep d@DepPackage{ common = c } = - d{ common = applyOptsFlags (M.member c.name smt.smtDeps) False c } + applyOptsFlagsDep d@DepPackage{ common = c } = d + { DepPackage.common = + applyOptsFlags (M.member c.name smt.smtDeps) False c + } applyOptsFlags isTarget isProjectPackage common = let name = common.name flags = getLocalFlags boptsCli name @@ -300,7 +306,7 @@ loadLocalPackage :: -> RIO env LocalPackage loadLocalPackage pp = do sm <- view sourceMapL - let common = pp.ppCommon + let common = pp.common bopts <- view buildOptsL mcurator <- view $ buildConfigL . to (.curator) config <- getPackageConfig @@ -381,7 +387,7 @@ loadLocalPackage pp = do | otherwise = Just (resolvePackage btconfig gpkg) componentFiles <- memoizeRefWith $ - fst <$> getPackageFilesForTargets pkg pp.ppCabalFP nonLibComponents + fst <$> getPackageFilesForTargets pkg pp.cabalFP nonLibComponents checkCacheResults <- memoizeRefWith $ do componentFiles' <- runMemoizedWith componentFiles @@ -409,11 +415,11 @@ loadLocalPackage pp = do { package = pkg , testBench = btpkg , componentFiles = componentFiles - , buildHaddocks = pp.ppCommon.haddocks + , buildHaddocks = pp.common.haddocks , forceDirty = bopts.forceDirty , dirtyFiles = dirtyFiles , newBuildCaches = newBuildCaches - , cabalFile = pp.ppCabalFP + , cabalFile = pp.cabalFP , wanted = isWanted , components = nonLibComponents -- TODO: refactor this so that it's easier to be sure that these diff --git a/src/Stack/BuildPlan.hs b/src/Stack/BuildPlan.hs index f2790ceb6f..1d6f375d05 100644 --- a/src/Stack/BuildPlan.hs +++ b/src/Stack/BuildPlan.hs @@ -381,7 +381,7 @@ checkSnapBuildPlan :: checkSnapBuildPlan pkgDirs flags snapCandidate = do platform <- view platformL sma <- snapCandidate pkgDirs - gpds <- liftIO $ forM (Map.elems sma.smaProject) (.ppCommon.gpd) + gpds <- liftIO $ forM (Map.elems sma.smaProject) (.common.gpd) let compiler = sma.smaCompiler globalVersion (GlobalPackageVersion v) = v diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index 072cecaf8c..19842610d1 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -138,6 +138,8 @@ import Stack.Types.SourceMap ( CommonPackage (..), DepPackage (..), ProjectPackage (..) , SMWanted (..) ) +import qualified Stack.Types.SourceMap as DepPackage ( DepPackage (..) ) +import qualified Stack.Types.SourceMap as ProjectPackage ( ProjectPackage (..) ) import qualified Stack.Types.SourceMap as CommonPackage ( CommonPackage (..) ) import Stack.Types.StackYamlLoc ( StackYamlLoc (..) ) import Stack.Types.UnusedFlags ( FlagSource (..) ) @@ -862,7 +864,7 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages abs' <- resolveDir (parent stackYamlFP) (T.unpack t) let resolved = ResolvedPath fp abs' pp <- mkProjectPackage YesPrintWarnings resolved bopts.haddock - pure (pp.ppCommon.name, pp) + pure (pp.common.name, pp) -- prefetch git repos to avoid cloning per subdirectory -- see https://github.com/commercialhaskell/stack/issues/5411 @@ -895,7 +897,7 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages pure ((dp.common.name, dp), mCompleted) checkDuplicateNames $ - map (second (PLMutable . (.ppResolvedDir))) packages0 ++ + map (second (PLMutable . (.resolvedDir))) packages0 ++ map (second (.location)) deps0 let packages1 = Map.fromList packages0 @@ -911,18 +913,18 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages let mergeApply m1 m2 f = MS.merge MS.preserveMissing MS.dropMissing (MS.zipWithMatched f) m1 m2 pFlags = project.flags - packages2 = mergeApply packages1 pFlags $ - \_ p flags -> p{ ppCommon = p.ppCommon { CommonPackage.flags = flags } } - deps2 = mergeApply deps1 pFlags $ - \_ d flags -> d{ common = d.common { CommonPackage.flags = flags } } + packages2 = mergeApply packages1 pFlags $ \_ p flags -> + p { ProjectPackage.common = p.common { CommonPackage.flags = flags } } + deps2 = mergeApply deps1 pFlags $ \_ d flags -> + d { DepPackage.common = d.common { CommonPackage.flags = flags } } checkFlagsUsedThrowing pFlags FSStackYaml packages1 deps1 let pkgGhcOptions = config.ghcOptionsByName - deps = mergeApply deps2 pkgGhcOptions $ - \_ d options -> d{ common = d.common { ghcOptions = options } } - packages = mergeApply packages2 pkgGhcOptions $ - \_ p options -> p{ ppCommon = p.ppCommon { ghcOptions = options } } + deps = mergeApply deps2 pkgGhcOptions $ \_ d options -> + d { DepPackage.common = d.common { ghcOptions = options } } + packages = mergeApply packages2 pkgGhcOptions $ \_ p options -> + p { ProjectPackage.common = p.common { ghcOptions = options } } unusedPkgGhcOptions = pkgGhcOptions `Map.restrictKeys` Map.keysSet packages2 `Map.restrictKeys` Map.keysSet deps2 diff --git a/src/Stack/DependencyGraph.hs b/src/Stack/DependencyGraph.hs index 14f1eb2124..b83ce6ae39 100644 --- a/src/Stack/DependencyGraph.hs +++ b/src/Stack/DependencyGraph.hs @@ -256,7 +256,7 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = projectPackageDeps = loadDeps <$> Map.lookup pkgName sourceMap.smProject where loadDeps pp = do - pkg <- loadCommonPackage pp.ppCommon + pkg <- loadCommonPackage pp.common pure (setOfPackageDeps pkg, payloadFromLocal pkg Nothing) dependencyDeps = @@ -264,7 +264,7 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName = where loadDeps DepPackage{ location = PLMutable dir } = do pp <- mkProjectPackage YesPrintWarnings dir False - pkg <- loadCommonPackage pp.ppCommon + pkg <- loadCommonPackage pp.common pure (setOfPackageDeps pkg, payloadFromLocal pkg (Just $ PLMutable dir)) loadDeps dp@DepPackage{ location = PLImmutable loc } = do diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index e93a120704..1a77c4e2e1 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -423,7 +423,7 @@ getAllLocalTargets ghciOpts targets0 mainIsTargets localMap = do let directlyWanted = flip mapMaybe (M.toList packages) $ \(name, pp) -> case M.lookup name targets of - Just simpleTargets -> Just (name, (pp.ppCabalFP, simpleTargets)) + Just simpleTargets -> Just (name, (pp.cabalFP, simpleTargets)) Nothing -> Nothing -- Figure out let extraLoadDeps = @@ -846,15 +846,15 @@ loadGhciPkgDesc buildOptsCLI name cabalfp target = do -- Currently this source map is being build with -- the default targets sourceMapGhcOptions = fromMaybe [] $ - ((.ppCommon.ghcOptions) <$> M.lookup name sm.smProject) + ((.common.ghcOptions) <$> M.lookup name sm.smProject) <|> ((.common.ghcOptions) <$> M.lookup name sm.smDeps) sourceMapCabalConfigOpts = fromMaybe [] $ - ( (.ppCommon.cabalConfigOpts) <$> M.lookup name sm.smProject) + ( (.common.cabalConfigOpts) <$> M.lookup name sm.smProject) <|> ((.common.cabalConfigOpts) <$> M.lookup name sm.smDeps) sourceMapFlags = - maybe mempty (.ppCommon.flags) $ M.lookup name sm.smProject + maybe mempty (.common.flags) $ M.lookup name sm.smProject config = PackageConfig { enableTests = True , enableBenchmarks = True diff --git a/src/Stack/IDE.hs b/src/Stack/IDE.hs index f7d88ee627..21dc5afe1e 100644 --- a/src/Stack/IDE.hs +++ b/src/Stack/IDE.hs @@ -78,7 +78,7 @@ listPackages stream flag = do ListPackageNames -> map packageNameString (Map.keys packages) ListPackageCabalFiles -> - map (toFilePath . (.ppCabalFP)) (Map.elems packages) + map (toFilePath . (.cabalFP)) (Map.elems packages) mapM_ (outputFunc stream) strs -- | List the targets in the current project. diff --git a/src/Stack/SDist.hs b/src/Stack/SDist.hs index e00b152480..3258951fff 100644 --- a/src/Stack/SDist.hs +++ b/src/Stack/SDist.hs @@ -612,7 +612,7 @@ buildExtractedTarball pkgDir = do $ localPackage.package.name == localPackageToBuild.package.name pathsToKeep <- Map.fromList <$> filterM - (fmap not . isPathToRemove . resolvedAbsolute . (.ppResolvedDir) . snd) + (fmap not . isPathToRemove . resolvedAbsolute . (.resolvedDir) . snd) (Map.toList envConfig.buildConfig.smWanted.smwProject) pp <- mkProjectPackage YesPrintWarnings pkgDir False let adjustEnvForBuild env = @@ -625,7 +625,7 @@ buildExtractedTarball pkgDir = do } in set envConfigL updatedEnvConfig env updatePackagesInSourceMap sm = - sm {smProject = Map.insert pp.ppCommon.name pp pathsToKeep} + sm {smProject = Map.insert pp.common.name pp pathsToKeep} local adjustEnvForBuild $ build Nothing -- | Version of 'checkSDistTarball' that first saves lazy bytestring to diff --git a/src/Stack/SourceMap.hs b/src/Stack/SourceMap.hs index 22c0817992..177c36f04d 100644 --- a/src/Stack/SourceMap.hs +++ b/src/Stack/SourceMap.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedRecordDot #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE OverloadedStrings #-} module Stack.SourceMap ( mkProjectPackage @@ -63,9 +64,9 @@ mkProjectPackage printWarnings dir buildHaddocks = do (gpd, name, cabalfp) <- loadCabalFilePath (Just stackProgName') (resolvedAbsolute dir) pure ProjectPackage - { ppCabalFP = cabalfp - , ppResolvedDir = dir - , ppCommon = + { cabalFP = cabalfp + , resolvedDir = dir + , common = CommonPackage { gpd = gpd printWarnings , name = name @@ -236,7 +237,7 @@ getUnusedPackageFlags :: -> Map PackageName DepPackage -> m (Maybe UnusedFlags) getUnusedPackageFlags (name, userFlags) source prj deps = - let maybeCommon = fmap (.ppCommon) (Map.lookup name prj) + let maybeCommon = fmap (.common) (Map.lookup name prj) <|> fmap (.common) (Map.lookup name deps) in case maybeCommon of -- Package is not available as project or dependency @@ -297,7 +298,7 @@ loadProjectSnapshotCandidate loc printWarnings buildHaddocks = do pure $ \projectPackages -> do prjPkgs <- fmap Map.fromList . for projectPackages $ \resolved -> do pp <- mkProjectPackage printWarnings resolved buildHaddocks - pure (pp.ppCommon.name, pp) + pure (pp.common.name, pp) compiler <- either throwIO pure $ wantedToActual $ snapshotCompiler snapshot pure SMActual diff --git a/src/Stack/Types/SourceMap.hs b/src/Stack/Types/SourceMap.hs index 71ee95ea9c..6df40ae52c 100644 --- a/src/Stack/Types/SourceMap.hs +++ b/src/Stack/Types/SourceMap.hs @@ -76,9 +76,9 @@ data DepPackage = DepPackage -- | A view of a project package needed for resolving components data ProjectPackage = ProjectPackage - { ppCommon :: !CommonPackage - , ppCabalFP :: !(Path Abs File) - , ppResolvedDir :: !(ResolvedPath Dir) + { common :: !CommonPackage + , cabalFP :: !(Path Abs File) + , resolvedDir :: !(ResolvedPath Dir) } -- | A view of a package installed in the global package database also could @@ -172,11 +172,11 @@ smRelDir :: (MonadThrow m) => SourceMapHash -> m (Path Rel Dir) smRelDir (SourceMapHash smh) = parseRelDir $ T.unpack $ SHA256.toHexText smh ppGPD :: MonadIO m => ProjectPackage -> m GenericPackageDescription -ppGPD = liftIO . (.ppCommon.gpd) +ppGPD = liftIO . (.common.gpd) -- | Root directory for the given 'ProjectPackage' ppRoot :: ProjectPackage -> Path Abs Dir -ppRoot = parent . (.ppCabalFP) +ppRoot = parent . (.cabalFP) -- | All components available in the given 'ProjectPackage' ppComponents :: MonadIO m => ProjectPackage -> m (Set NamedComponent)