Merge pull request #6792 from commercialhaskell/refactor

Refactor

Author: mpilgrem

.stan.toml

@@ -1,11 +1,11 @@
 # Partial: base/head
 # Usage of partial function 'head' for lists
 [[ignore]]
-  id = "OBS-STAN-0001-1XF2BN-54:1"
+  id = "OBS-STAN-0001-1XF2BN-73:1"
 # ✦ Category:      #Partial #List
 # ✦ File:          src\Stack\Storage\Project.hs
 #
-#   54 ┃ share [ mkPersist sqlSettings
+#   73 ┃ share [ mkPersist sqlSettings
 
 # Partial: base/head
 # Usage of partial function 'head' for lists
@@ -151,14 +151,14 @@
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-tuE+RG-248:24"
+  id = "OBS-STAN-0203-tuE+RG-249:24"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Build\ExecutePackage.hs
 #
-#   247 ┃
-#   248 ┃   newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL
-#   249 ┃                        ^^^^^^^
+#   248 ┃
+#   249 ┃   newConfigFileRoot <- S8.pack . toFilePath <$> view configFileRootL
+#   250 ┃                        ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]

package.yaml

@@ -201,6 +201,7 @@ library:
   - Stack.Config.ConfigureScript
   - Stack.Config.Docker
   - Stack.Config.Nix
+  - Stack.ConfigureOpts
   - Stack.ConfigCmd
   - Stack.Constants
   - Stack.Constants.Config

src/Stack/Build/Cache.hs

@@ -33,7 +33,7 @@ module Stack.Build.Cache
   , writePrecompiledCache
   , readPrecompiledCache
   -- Exported for testing
-  , BuildCache (..)
+  , BuildFileCache (..)
   ) where
 
 import           Crypto.Hash ( hashWith, SHA256 (..) )
@@ -63,8 +63,8 @@ import           Stack.Storage.User
                    , precompiledCacheKey, savePrecompiledCache
                    )
 import           Stack.Types.Cache
-                   ( BuildCache (..), ConfigCache, ConfigCacheType (..)
-                   , PrecompiledCache (..)
+                   ( BuildFileCache (..), ConfigCache, ConfigCacheType (..)
+                   , FileCache, PrecompiledCache (..)
                    )
 import           Stack.Types.CompilerPaths ( cabalVersionL )
 import           Stack.Types.ComponentUtils
@@ -84,7 +84,6 @@ import           Stack.Types.Installed
                    )
 import           Stack.Types.NamedComponent
                    ( NamedComponent (..), componentCachePath )
-import           Stack.Types.Package ( FileCacheInfo )
 import           Stack.Types.SourceMap ( smRelDir )
 import           System.PosixCompat.Files
                    ( getFileStatus, modificationTime, setFileTimes )
@@ -167,13 +166,13 @@ tryGetBuildCache ::
      -- ^ Package directory.
   -> NamedComponent
      -- ^ Package component.
-  -> RIO env (Maybe (Map FilePath FileCacheInfo))
+  -> RIO env (Maybe FileCache)
 tryGetBuildCache dir component = do
   fp <- buildCacheFile dir component
   ensureDir $ parent fp
-  let decode :: MonadIO m => m BuildCache
+  let decode :: MonadIO m => m BuildFileCache
       decode = Yaml.decodeFileThrow (toFilePath fp)
-  either (const Nothing) (Just . (.times)) <$> liftIO (tryAny decode)
+  either (const Nothing) (Just . (.fileCache)) <$> liftIO (tryAny decode)
 
 -- | Try to read the Cabal configuration cache for the given package directory.
 tryGetConfigCache ::
@@ -230,10 +229,12 @@ writeBuildCache ::
      -- ^ Package directory.
   -> NamedComponent
      -- ^ Package component.
-  -> Map FilePath FileCacheInfo -> RIO env ()
-writeBuildCache dir component times = do
+  -> FileCache
+     -- ^ File cache.
+  -> RIO env ()
+writeBuildCache dir component fileCache = do
   fp <- toFilePath <$> buildCacheFile dir component
-  liftIO $ Yaml.encodeFile fp BuildCache { times = times }
+  liftIO $ Yaml.encodeFile fp BuildFileCache { fileCache }
 
 -- | Write the given Cabal configuration cache for the given package directory.
 writeConfigCache ::
@@ -250,6 +251,7 @@ writeConfigCache dir =
 writeCabalMod ::
      HasEnvConfig env
   => Path Abs Dir
+     -- ^ Package directory.
   -> CTime
   -> RIO env ()
 writeCabalMod dir x = do

src/Stack/Build/ConstructPlan.hs

@@ -34,6 +34,10 @@ import           RIO.Writer ( WriterT (..), pass, tell )
 import           Stack.Build.Cache ( tryGetFlagCache )
 import           Stack.Build.Haddock ( shouldHaddockDeps )
 import           Stack.Build.Source ( loadLocalPackage )
+import           Stack.ConfigureOpts
+                   ( configureOptsFromBase, packageConfigureOptsFromPackage
+                   , renderConfigureOpts
+                   )
 import           Stack.Constants ( compilerOptionsCabalFlag )
 import           Stack.Package
                    ( applyForceCustomBuild, buildableExes, packageUnknownTools
@@ -56,16 +60,14 @@ import           Stack.Types.BuildConfig
 import           Stack.Types.BuildOpts ( BuildOpts (..) )
 import           Stack.Types.BuildOptsCLI
                    ( BuildOptsCLI (..), BuildSubset (..) )
-import           Stack.Types.Cache
-                   ( CachePkgSrc (..), ConfigCache (..), toCachePkgSrc )
+import           Stack.Types.Cache ( CachePkgSrc (..), ConfigCache (..) )
 import           Stack.Types.CompCollection ( collectionMember )
 import           Stack.Types.Compiler ( WhichCompiler (..), getGhcVersion )
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
 import           Stack.Types.ComponentUtils ( unqualCompFromText )
 import           Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
 import           Stack.Types.ConfigureOpts ( BaseConfigOpts (..) )
-import qualified Stack.Types.ConfigureOpts as ConfigureOpts
 import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.Dependency ( DepValue (..), isDepTypeLibrary )
 import           Stack.Types.DumpPackage ( DumpPackage (..), sublibParentPkgId )
@@ -468,7 +470,7 @@ addFinal lp package allInOne buildHaddocks = do
   res <- addPackageDeps package >>= \case
     Left e -> pure $ Left e
     Right (MissingPresentDeps missing present _minLoc) -> do
-      let pkgConfigOpts = ConfigureOpts.packageConfigureOptsFromPackage package
+      let pkgConfigOpts = packageConfigureOptsFromPackage package
       ctx <- ask
       let configOpts = TaskConfigOpts
             { missing
@@ -778,7 +780,7 @@ installPackageGivenDeps allInOne buildHaddocks ps package minstalled
     ctx <- ask
     let loc = psLocation ps
         isMutable = installLocationIsMutable loc <> minMutable
-        pkgConfigOpts = ConfigureOpts.packageConfigureOptsFromPackage package
+        pkgConfigOpts = packageConfigureOptsFromPackage package
         configOpts = TaskConfigOpts
             { missing
             , envConfig = ctx.ctxEnvConfig
@@ -1041,9 +1043,8 @@ checkDirtiness ::
 checkDirtiness ps installed package present buildHaddocks = do
   ctx <- ask
   moldOpts <- runRIO ctx $ tryGetFlagCache installed
-  let packageConfigureOpt =
-        ConfigureOpts.packageConfigureOptsFromPackage package
-      configureOpts = ConfigureOpts.configureOpts
+  let packageConfigureOpt = packageConfigureOptsFromPackage package
+      configureOpts = configureOptsFromBase
         (view envConfigL ctx)
         ctx.baseConfigOpts
         present
@@ -1138,7 +1139,7 @@ describeConfigDiff config old new
                 then id
                 else stripGhcOptions)
            . map T.pack
-           . ConfigureOpts.renderConfigureOpts
+           . renderConfigureOpts
            . (.configureOpts)
    where
     -- options set by Stack
@@ -1286,3 +1287,8 @@ combineMap = Map.merge
   (Map.mapMissing (\_ s -> PIOnlySource s))
   (Map.mapMissing (\_ i -> uncurry PIOnlyInstalled i))
   (Map.zipWithMatched (\_ s i -> combineSourceInstalled s i))
+
+toCachePkgSrc :: PackageSource -> CachePkgSrc
+toCachePkgSrc (PSFilePath lp) =
+  CacheSrcLocal (toFilePath (parent lp.cabalFP))
+toCachePkgSrc PSRemote{} = CacheSrcUpstream

src/Stack/Build/ExecutePackage.hs

@@ -70,6 +70,8 @@ import           Stack.Build.ExecuteEnv
                    )
 import           Stack.Build.Source ( addUnlistedToBuildCache )
 import           Stack.Config.ConfigureScript ( ensureConfigureScript )
+import           Stack.ConfigureOpts
+                   ( configureOptsFromBase, renderConfigureOpts )
 import           Stack.Constants
                    ( bindirSuffix, compilerOptionsCabalFlag, testGhcEnvRelFile )
 import           Stack.Constants.Config
@@ -114,7 +116,6 @@ import           Stack.Types.ComponentUtils
 import           Stack.Types.Config ( Config (..), HasConfig (..) )
 import           Stack.Types.ConfigureOpts
                    ( BaseConfigOpts (..), ConfigureOpts (..) )
-import qualified Stack.Types.ConfigureOpts as ConfigureOpts
 import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.DumpPackage ( DumpPackage (..) )
 import           Stack.Types.EnvConfig
@@ -195,7 +196,7 @@ getConfigCache ee task installedMap enableTest enableBench = do
       -- where it was the opposite resulted in this. It doesn't seem to make any
       -- difference anyway.
       allDepsMap = Map.union missing' task.present
-      configureOpts' = ConfigureOpts.configureOpts
+      configureOpts' = configureOptsFromBase
         cOpts.envConfig
         cOpts.baseConfigOpts
         allDepsMap
@@ -304,7 +305,7 @@ ensureConfig newConfigCache pkgDir buildOpts announce cabal cabalFP task = do
         Right x -> pure $ concat ["--with-", name, "=", x]
     let allOpts =
              concat exes
-          <> ConfigureOpts.renderConfigureOpts newConfigCache.configureOpts
+          <> renderConfigureOpts newConfigCache.configureOpts
     -- Configure cabal with arguments determined by
     -- Stack.Types.Build.configureOpts
     cabal KeepTHLoading $ "configure" : allOpts

src/Stack/Build/Source.hs

@@ -52,6 +52,7 @@ import           Stack.Types.BuildOptsCLI
                    , boptsCLIAllProgOptions
                    )
 import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
+import           Stack.Types.Cache ( FileCache, FileCacheInfo (..) )
 import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
 import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.Curator ( Curator (..) )
@@ -64,9 +65,8 @@ import           Stack.Types.FileDigestCache ( readFileDigest )
 import           Stack.Types.NamedComponent
                    ( NamedComponent (..), isCSubLib, splitComponents )
 import           Stack.Types.Package
-                   ( FileCacheInfo (..), LocalPackage (..), Package (..)
-                   , PackageConfig (..), dotCabalGetPath, memoizeRefWith
-                   , runMemoizedWith
+                   ( LocalPackage (..), Package (..), PackageConfig (..)
+                   , dotCabalGetPath, memoizeRefWith, runMemoizedWith
                    )
 import           Stack.Types.PackageFile
                    ( PackageComponentFile (..), PackageWarning )
@@ -488,9 +488,9 @@ loadLocalPackage pp = do
 -- determine (1) if the files are dirty, and (2) the new cache values.
 checkBuildCache ::
      HasEnvConfig env
-  => Map FilePath FileCacheInfo -- ^ old cache
+  => FileCache -- ^ old cache
   -> [Path Abs File] -- ^ files in package
-  -> RIO env (Set FilePath, Map FilePath FileCacheInfo)
+  -> RIO env (Set FilePath, FileCache)
 checkBuildCache oldCache files = do
   fileDigests <- fmap Map.fromList $ forM files $ \fp -> do
     mdigest <- getFileDigestMaybe (toFilePath fp)
@@ -507,7 +507,7 @@ checkBuildCache oldCache files = do
        FilePath
     -> Maybe SHA256
     -> Maybe FileCacheInfo
-    -> RIO env (Set FilePath, Map FilePath FileCacheInfo)
+    -> RIO env (Set FilePath, FileCache)
   -- Filter out the cabal_macros file to avoid spurious recompilations
   go fp _ _ | takeFileName fp == "cabal_macros.h" = pure (Set.empty, Map.empty)
   -- Common case where it's in the cache and on the filesystem.
@@ -529,7 +529,7 @@ addUnlistedToBuildCache ::
   -> Path Abs File
   -> Set NamedComponent
   -> Map NamedComponent (Map FilePath a)
-  -> RIO env (Map NamedComponent [Map FilePath FileCacheInfo], [PackageWarning])
+  -> RIO env (Map NamedComponent [FileCache], [PackageWarning])
 addUnlistedToBuildCache pkg cabalFP nonLibComponents buildCaches = do
   (componentFiles, warnings) <-
     getPackageFilesForTargets pkg cabalFP nonLibComponents