Merge pull request #6434 from commercialhaskell/dp-pp-prefix

Remove dp/pp prefixes from DepPackage ProjectPackage field names

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

src/Stack/Build/Installed.hs

@@ -40,14 +40,14 @@ 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 ->
-      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
 

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 )
@@ -84,7 +86,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
@@ -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{dpCommon = c} =
-        d{dpCommon = 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
@@ -190,17 +196,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
@@ -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

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

src/Stack/BuildPlan.hs

@@ -381,12 +381,12 @@ 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
       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)

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
@@ -892,11 +894,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 (PLMutable . (.resolvedDir))) packages0 ++
+    map (second (.location)) deps0
 
   let packages1 = Map.fromList packages0
       snPackages = snapPackages
@@ -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{ dpCommon = d.dpCommon { 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{ dpCommon = d.dpCommon { 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

src/Stack/DependencyGraph.hs

@@ -256,19 +256,19 @@ 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 =
     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
+      pkg <- loadCommonPackage pp.common
       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

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)
         <|>
-        ((.dpCommon.ghcOptions) <$> M.lookup name sm.smDeps)
+        ((.common.ghcOptions) <$> M.lookup name sm.smDeps)
       sourceMapCabalConfigOpts = fromMaybe [] $
-        ( (.ppCommon.cabalConfigOpts) <$> M.lookup name sm.smProject)
+        ( (.common.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
+        maybe mempty (.common.flags) $ M.lookup name sm.smProject
       config = PackageConfig
         { enableTests = True
         , enableBenchmarks = True

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)

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.

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

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

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
@@ -96,10 +97,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 +121,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
@@ -236,8 +237,8 @@ getUnusedPackageFlags ::
   -> Map PackageName DepPackage
   -> m (Maybe UnusedFlags)
 getUnusedPackageFlags (name, userFlags) source prj deps =
-  let maybeCommon =     fmap (.ppCommon) (Map.lookup name prj)
-                    <|> fmap (.dpCommon) (Map.lookup name deps)
+  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
         Nothing ->
@@ -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