Merge pull request #6428 from commercialhaskell/cp-prefix

Remove cp prefix from CommonPackage field names

src/Stack/Build/ConstructPlan.hs

@@ -568,7 +568,7 @@ tellExecutables _name (PSFilePath lp)
   | otherwise = pure ()
 -- Ignores ghcOptions because they don't matter for enumerating executables.
 tellExecutables name (PSRemote pkgloc _version _fromSnapshot cp) =
-  tellExecutablesUpstream name (pure $ Just pkgloc) Snap cp.cpFlags
+  tellExecutablesUpstream name (pure $ Just pkgloc) Snap cp.flags
 
 -- | For a given 'PackageName' value, known to be immutable, adds relevant
 -- executables to the collected output.
@@ -630,8 +630,8 @@ installPackage name ps minstalled = do
         <> fromPackageName name
         <> "."
       package <- ctx.loadPackage
-        pkgLoc cp.cpFlags cp.cpGhcOptions cp.cpCabalConfigOpts
-      resolveDepsAndInstall True cp.cpHaddocks ps package minstalled
+        pkgLoc cp.flags cp.ghcOptions cp.cabalConfigOpts
+      resolveDepsAndInstall True cp.haddocks ps package minstalled
     PSFilePath lp -> do
       case lp.testBench of
         Nothing -> do

src/Stack/Build/Source.hs

@@ -103,28 +103,28 @@ loadSourceMap smt boptsCli sma = do
       project = M.map applyOptsFlagsPP sma.smaProject
       bopts = bconfig.config.build
       applyOptsFlagsPP p@ProjectPackage{ppCommon = c} =
-        p{ppCommon = applyOptsFlags (M.member c.cpName smt.smtTargets) True c}
+        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.cpName smt.smtDeps) False c}
+        d{dpCommon = applyOptsFlags (M.member c.name smt.smtDeps) False c}
       applyOptsFlags isTarget isProjectPackage common =
-        let name = common.cpName
+        let name = common.name
             flags = getLocalFlags boptsCli name
             ghcOptions =
               generalGhcOptions bconfig boptsCli isTarget isProjectPackage
             cabalConfigOpts =
-              generalCabalConfigOpts bconfig boptsCli common.cpName isTarget isProjectPackage
+              generalCabalConfigOpts bconfig boptsCli common.name isTarget isProjectPackage
         in  common
-              { cpFlags =
+              { flags =
                   if M.null flags
-                    then common.cpFlags
+                    then common.flags
                     else flags
-              , cpGhcOptions =
-                  ghcOptions ++ common.cpGhcOptions
-              , cpCabalConfigOpts =
-                  cabalConfigOpts ++ common.cpCabalConfigOpts
-              , cpHaddocks =
+              , ghcOptions =
+                  ghcOptions ++ common.ghcOptions
+              , cabalConfigOpts =
+                  cabalConfigOpts ++ common.cabalConfigOpts
+              , haddocks =
                   if isTarget
                     then bopts.haddock
                     else shouldHaddockDeps bopts
@@ -197,10 +197,10 @@ depPackageHashableContent dp =
             if enabled
               then ""
               else "-" <> fromString (C.unFlagName f)
-          flags = map flagToBs $ Map.toList dp.dpCommon.cpFlags
-          ghcOptions = map display dp.dpCommon.cpGhcOptions
-          cabalConfigOpts = map display dp.dpCommon.cpCabalConfigOpts
-          haddocks = if dp.dpCommon.cpHaddocks then "haddocks" else ""
+          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 ""
           hash = immutableLocSha pli
       pure
         $  hash
@@ -286,10 +286,10 @@ loadCommonPackage ::
 loadCommonPackage common = do
   config <-
     getPackageConfig
-      common.cpFlags
-      common.cpGhcOptions
-      common.cpCabalConfigOpts
-  gpkg <- liftIO common.cpGPD
+      common.flags
+      common.ghcOptions
+      common.cabalConfigOpts
+  gpkg <- liftIO common.gpd
   pure $ resolvePackage config gpkg
 
 -- | Upgrade the initial project package info to a full-blown @LocalPackage@
@@ -304,11 +304,11 @@ loadLocalPackage pp = do
   bopts <- view buildOptsL
   mcurator <- view $ buildConfigL . to (.curator)
   config <- getPackageConfig
-              common.cpFlags
-              common.cpGhcOptions
-              common.cpCabalConfigOpts
+              common.flags
+              common.ghcOptions
+              common.cabalConfigOpts
   gpkg <- ppGPD pp
-  let name = common.cpName
+  let name = common.name
       mtarget = M.lookup name sm.smTargets.smtTargets
       (exeCandidates, testCandidates, benchCandidates) =
         case mtarget of
@@ -409,7 +409,7 @@ loadLocalPackage pp = do
     { package = pkg
     , testBench = btpkg
     , componentFiles = componentFiles
-    , buildHaddocks = pp.ppCommon.cpHaddocks
+    , buildHaddocks = pp.ppCommon.haddocks
     , forceDirty = bopts.forceDirty
     , dirtyFiles = dirtyFiles
     , newBuildCaches = newBuildCaches

src/Stack/BuildPlan.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE GADTs               #-}
-{-# LANGUAGE OverloadedRecordDot #-}
-{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
+{-# LANGUAGE OverloadedStrings     #-}
 
 -- | Resolving a build plan for a set of packages in a given Stackage snapshot.
 
@@ -380,7 +381,7 @@ checkSnapBuildPlan ::
 checkSnapBuildPlan pkgDirs flags snapCandidate = do
   platform <- view platformL
   sma <- snapCandidate pkgDirs
-  gpds <- liftIO $ forM (Map.elems sma.smaProject) (.ppCommon.cpGPD)
+  gpds <- liftIO $ forM (Map.elems sma.smaProject) (.ppCommon.gpd)
 
   let compiler = sma.smaCompiler
       globalVersion (GlobalPackageVersion v) = v

src/Stack/Config.hs

@@ -138,6 +138,7 @@ import           Stack.Types.SourceMap
                    ( CommonPackage (..), DepPackage (..), ProjectPackage (..)
                    , SMWanted (..)
                    )
+import qualified Stack.Types.SourceMap as CommonPackage ( CommonPackage (..) )
 import           Stack.Types.StackYamlLoc ( StackYamlLoc (..) )
 import           Stack.Types.UnusedFlags ( FlagSource (..) )
 import           Stack.Types.Version
@@ -861,7 +862,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.cpName, pp)
+    pure (pp.ppCommon.name, pp)
 
   -- prefetch git repos to avoid cloning per subdirectory
   -- see https://github.com/commercialhaskell/stack/issues/5411
@@ -891,7 +892,7 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages
        RPLMutable p ->
          pure (PLMutable p, Nothing)
     dp <- additionalDepPackage (shouldHaddockDeps bopts) pl
-    pure ((dp.dpCommon.cpName, dp), mCompleted)
+    pure ((dp.dpCommon.name, dp), mCompleted)
 
   checkDuplicateNames $
     map (second (PLMutable . (.ppResolvedDir))) packages0 ++
@@ -911,17 +912,17 @@ fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages
         MS.merge MS.preserveMissing MS.dropMissing (MS.zipWithMatched f) m1 m2
       pFlags = project.flags
       packages2 = mergeApply packages1 pFlags $
-        \_ p flags -> p{ppCommon = p.ppCommon {cpFlags=flags}}
+        \_ p flags -> p{ ppCommon = p.ppCommon { CommonPackage.flags = flags } }
       deps2 = mergeApply deps1 pFlags $
-        \_ d flags -> d{dpCommon = d.dpCommon {cpFlags=flags}}
+        \_ d flags -> d{ dpCommon = d.dpCommon { CommonPackage.flags = flags } }
 
   checkFlagsUsedThrowing pFlags FSStackYaml packages1 deps1
 
   let pkgGhcOptions = config.ghcOptionsByName
       deps = mergeApply deps2 pkgGhcOptions $
-        \_ d options -> d{dpCommon = d.dpCommon {cpGhcOptions=options}}
+        \_ d options -> d{ dpCommon = d.dpCommon { ghcOptions = options } }
       packages = mergeApply packages2 pkgGhcOptions $
-        \_ p options -> p{ppCommon = p.ppCommon {cpGhcOptions=options}}
+        \_ p options -> p{ ppCommon = p.ppCommon { ghcOptions = options } }
       unusedPkgGhcOptions =
         pkgGhcOptions `Map.restrictKeys` Map.keysSet packages2
           `Map.restrictKeys` Map.keysSet deps2

src/Stack/DependencyGraph.hs

@@ -269,11 +269,11 @@ createDepLoader sourceMap globalDumpMap globalIdMap loadPackageDeps pkgName =
 
     loadDeps dp@DepPackage{dpLocation=PLImmutable loc} = do
       let common = dp.dpCommon
-      gpd <- liftIO common.cpGPD
+      gpd <- liftIO common.gpd
       let PackageIdentifier name version = PD.package $ PD.packageDescription gpd
-          flags = common.cpFlags
-          ghcOptions = common.cpGhcOptions
-          cabalConfigOpts = common.cpCabalConfigOpts
+          flags = common.flags
+          ghcOptions = common.ghcOptions
+          cabalConfigOpts = common.cabalConfigOpts
       assert
         (pkgName == name)
         (loadPackageDeps pkgName version loc flags ghcOptions cabalConfigOpts)

src/Stack/Ghci.hs

@@ -846,15 +846,15 @@ loadGhciPkgDesc buildOptsCLI name cabalfp target = do
       -- Currently this source map is being build with
       -- the default targets
       sourceMapGhcOptions = fromMaybe [] $
-        ((.ppCommon.cpGhcOptions) <$> M.lookup name sm.smProject)
+        ((.ppCommon.ghcOptions) <$> M.lookup name sm.smProject)
         <|>
-        ((.dpCommon.cpGhcOptions) <$> M.lookup name sm.smDeps)
+        ((.dpCommon.ghcOptions) <$> M.lookup name sm.smDeps)
       sourceMapCabalConfigOpts = fromMaybe [] $
-        ( (.ppCommon.cpCabalConfigOpts) <$> M.lookup name sm.smProject)
+        ( (.ppCommon.cabalConfigOpts) <$> M.lookup name sm.smProject)
         <|>
-        ((.dpCommon.cpCabalConfigOpts) <$> M.lookup name sm.smDeps)
+        ((.dpCommon.cabalConfigOpts) <$> M.lookup name sm.smDeps)
       sourceMapFlags =
-        maybe mempty (.ppCommon.cpFlags) $ M.lookup name sm.smProject
+        maybe mempty (.ppCommon.flags) $ M.lookup name sm.smProject
       config = PackageConfig
         { enableTests = True
         , enableBenchmarks = True

src/Stack/SDist.hs

@@ -625,7 +625,7 @@ buildExtractedTarball pkgDir = do
               }
         in  set envConfigL updatedEnvConfig env
       updatePackagesInSourceMap sm =
-        sm {smProject = Map.insert pp.ppCommon.cpName pp pathsToKeep}
+        sm {smProject = Map.insert pp.ppCommon.name pp pathsToKeep}
   local adjustEnvForBuild $ build Nothing
 
 -- | Version of 'checkSDistTarball' that first saves lazy bytestring to

src/Stack/Script.hs

@@ -358,7 +358,7 @@ mapSnapshotPackageModules = do
         Set.fromList $ map (pkgName . (.packageIdent)) snapshotDumpPkgs
       notInstalledDeps = Map.withoutKeys notHiddenDeps dumpPkgs
   otherDeps <- for notInstalledDeps $ \dep -> do
-    gpd <- liftIO dep.dpCommon.cpGPD
+    gpd <- liftIO dep.dpCommon.gpd
     Set.fromList <$> allExposedModules gpd
   -- source map construction process should guarantee unique package names in
   -- these maps

src/Stack/SourceMap.hs

@@ -67,12 +67,12 @@ mkProjectPackage printWarnings dir buildHaddocks = do
     , ppResolvedDir = dir
     , ppCommon =
         CommonPackage
-          { cpGPD = gpd printWarnings
-          , cpName = name
-          , cpFlags = mempty
-          , cpGhcOptions = mempty
-          , cpCabalConfigOpts = mempty
-          , cpHaddocks = buildHaddocks
+          { gpd = gpd printWarnings
+          , name = name
+          , flags = mempty
+          , ghcOptions = mempty
+          , cabalConfigOpts = mempty
+          , haddocks = buildHaddocks
           }
     }
 
@@ -101,12 +101,12 @@ additionalDepPackage buildHaddocks pl = do
     , dpFromSnapshot = NotFromSnapshot
     , dpCommon =
         CommonPackage
-          { cpGPD = gpdio
-          , cpName = name
-          , cpFlags = mempty
-          , cpGhcOptions = mempty
-          , cpCabalConfigOpts = mempty
-          , cpHaddocks = buildHaddocks
+          { gpd = gpdio
+          , name = name
+          , flags = mempty
+          , ghcOptions = mempty
+          , cabalConfigOpts = mempty
+          , haddocks = buildHaddocks
           }
     }
 
@@ -125,18 +125,18 @@ snapToDepPackage buildHaddocks name sp = do
     , dpFromSnapshot = FromSnapshot
     , dpCommon =
         CommonPackage
-          { cpGPD = run $ loadCabalFileImmutable sp.spLocation
-          , cpName = name
-          , cpFlags = sp.spFlags
-          , cpGhcOptions = sp.spGhcOptions
-          , cpCabalConfigOpts = [] -- No spCabalConfigOpts, not present in snapshots
-          , cpHaddocks = buildHaddocks
+          { gpd = run $ loadCabalFileImmutable sp.spLocation
+          , name = name
+          , flags = sp.spFlags
+          , ghcOptions = sp.spGhcOptions
+          , cabalConfigOpts = [] -- No spCabalConfigOpts, not present in snapshots
+          , haddocks = buildHaddocks
           }
     }
 
 loadVersion :: MonadIO m => CommonPackage -> m Version
 loadVersion common = do
-  gpd <- liftIO common.cpGPD
+  gpd <- liftIO common.gpd
   pure (pkgVersion $ PD.package $ PD.packageDescription gpd)
 
 getPLIVersion :: PackageLocationImmutable -> Version
@@ -244,7 +244,7 @@ getUnusedPackageFlags (name, userFlags) source prj deps =
           pure $ Just $ UFNoPackage source name
         -- Package exists, let's check if the flags are defined
         Just common -> do
-          gpd <- liftIO common.cpGPD
+          gpd <- liftIO common.gpd
           let pname = pkgName $ PD.package $ PD.packageDescription gpd
               pkgFlags = Set.fromList $ map PD.flagName $ PD.genPackageFlags gpd
               unused = Map.keysSet $ Map.withoutKeys userFlags pkgFlags
@@ -297,7 +297,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.cpName, pp)
+      pure (pp.ppCommon.name, pp)
     compiler <- either throwIO pure $ wantedToActual $ snapshotCompiler snapshot
     pure
       SMActual

src/Stack/Types/SourceMap.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude   #-}
+{-# LANGUAGE NoFieldSelectors    #-}
 {-# LANGUAGE OverloadedRecordDot #-}
 
 -- | A sourcemap maps a package name to how it should be built, including source
@@ -42,14 +43,14 @@ import           Stack.Types.NamedComponent ( NamedComponent (..) )
 -- | Settings common to dependency packages ('Stack.Types.SourceMap.DepPackage')
 -- and project packages ('Stack.Types.SourceMap.ProjectPackage').
 data CommonPackage = CommonPackage
-  { cpGPD :: !(IO GenericPackageDescription)
-  , cpName :: !PackageName
-  , cpFlags :: !(Map FlagName Bool)
+  { gpd :: !(IO GenericPackageDescription)
+  , name :: !PackageName
+  , flags :: !(Map FlagName Bool)
     -- ^ overrides default flags
-  , cpGhcOptions :: ![Text]
+  , ghcOptions :: ![Text]
     -- also lets us know if we're doing profiling
-  , cpCabalConfigOpts :: ![Text]
-  , cpHaddocks :: !Bool
+  , cabalConfigOpts :: ![Text]
+  , haddocks :: !Bool
     -- ^ Should Haddock documentation be built for this package?
   }
 
@@ -170,7 +171,7 @@ 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.cpGPD)
+ppGPD = liftIO . (.ppCommon.gpd)
 
 -- | Root directory for the given 'ProjectPackage'
 ppRoot :: ProjectPackage -> Path Abs Dir