Reformatting, for consistency

commercialhaskell · Nov 30, 2023 · 1d99fee · 1d99fee
1 parent b5e5cb5
commit 1d99fee
Show file tree

Hide file tree

Showing 17 changed files with 230 additions and 159 deletions.
diff --git a/.stan.toml b/.stan.toml
@@ -28,6 +28,7 @@
   id = "OBS-STAN-0102-luLR/n-522:30"
 # ✦ Category:      #Infinite #List
 # ✦ File:          src\Stack\New.hs
+#
 #  522 ┃
 #  523 ┃   let isPkgSpec f = ".cabal" `L.isSuffixOf` f || "package.yaml" `L.isSuffixOf` f
 #  524 ┃                              ^^^^^^^^^^^^^^
@@ -38,6 +39,7 @@
   id = "OBS-STAN-0102-luLR/n-522:65"
 # ✦ Category:      #Infinite #List
 # ✦ File:          src\Stack\New.hs
+#
 #  522 ┃
 #  523 ┃   let isPkgSpec f = ".cabal" `L.isSuffixOf` f || "package.yaml" `L.isSuffixOf` f
 #  524 ┃                                                                 ^^^^^^^^^^^^^^
@@ -52,32 +54,33 @@
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-fki0nd-1127:21"
+  id = "OBS-STAN-0203-fki0nd-1128:21"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Build\Execute.hs
 #
-#  1126 ┃
-#  1127 ┃   newProjectRoot <- S8.pack . toFilePath <$> view projectRootL
-#  1128 ┃                     ^^^^^^^
+#  1127 ┃
+#  1128 ┃   newProjectRoot <- S8.pack . toFilePath <$> view projectRootL
+#  1129 ┃                     ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
-  id = "OBS-STAN-0203-fki0nd-2669:3"
+  id = "OBS-STAN-0203-fki0nd-2672:3"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Build\Execute.hs
 #
-# 2668 ┃
-# 2669 ┃   S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q"
-# 2670 ┃   ^^^^^^^
+#  2671 ┃
+#  2672 ┃   S8.pack . formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S%6Q"
+#  2673 ┃   ^^^^^^^
 
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
   id = "OBS-STAN-0203-hTeu0Y-380:17"
 # ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
 # ✦ Category:      #AntiPattern
 # ✦ File:          src\Stack\Init.hs
+#
 #  378 ┃
 #  379 ┃   commentHelp = BC.pack .  intercalate "\n" . map commentLine
 #  380 ┃                 ^^^^^^^

diff --git a/package.yaml b/package.yaml
@@ -265,6 +265,7 @@ library:
   - Stack.Types.ApplyGhcOptions
   - Stack.Types.ApplyProgOptions
   - Stack.Types.Build
+  - Stack.Types.Build.ConstructPlan
   - Stack.Types.Build.Exception
   - Stack.Types.BuildConfig
   - Stack.Types.BuildOpts
@@ -277,6 +278,7 @@ library:
   - Stack.Types.CompilerPaths
   - Stack.Types.Compiler
   - Stack.Types.Component
+  - Stack.Types.ComponentUtils
   - Stack.Types.Config
   - Stack.Types.Config.Exception
   - Stack.Types.ConfigMonoid

diff --git a/src/Stack/Build.hs b/src/Stack/Build.hs
@@ -62,7 +62,8 @@ import           Stack.Types.GlobalOpts ( globalOptsBuildOptsMonoidL )
 import           Stack.Types.NamedComponent ( exeComponents )
 import           Stack.Types.Package
                    ( InstallLocation (..), LocalPackage (..), Package (..)
-                   , PackageConfig (..), lpFiles, lpFilesForComponents )
+                   , PackageConfig (..), lpFiles, lpFilesForComponents
+                   )
 import           Stack.Types.Platform ( HasPlatform (..) )
 import           Stack.Types.Runner ( Runner, globalOptsL )
 import           Stack.Types.SourceMap

diff --git a/src/Stack/Build/Cache.hs b/src/Stack/Build/Cache.hs
@@ -72,10 +72,11 @@ import           Stack.Types.EnvConfig
                    )
 import           Stack.Types.GhcPkgId ( GhcPkgId, ghcPkgIdString )
 import           Stack.Types.NamedComponent ( NamedComponent (..) )
+import           Stack.Types.Package
+                   (InstalledLibraryInfo (..), installedGhcPkgId )
 import           Stack.Types.SourceMap ( smRelDir )
 import           System.PosixCompat.Files
                    ( modificationTime, getFileStatus, setFileTimes )
-import           Stack.Types.Package (installedGhcPkgId, InstalledLibraryInfo (iliId))
 
 -- | Directory containing files to mark an executable as installed
 exeInstalledDir :: (HasEnvConfig env)
@@ -265,13 +266,9 @@ flagCacheKey installed = do
   case installed of
     Library _ installedInfo -> do
       let gid = iliId installedInfo
-      pure $
-        configCacheKey installationRoot (ConfigCacheTypeFlagLibrary gid)
-    Executable ident ->
-      pure $
-        configCacheKey
-          installationRoot
-          (ConfigCacheTypeFlagExecutable ident)
+      pure $ configCacheKey installationRoot (ConfigCacheTypeFlagLibrary gid)
+    Executable ident -> pure $
+      configCacheKey installationRoot (ConfigCacheTypeFlagExecutable ident)
 
 -- | Loads the flag cache for the given installed extra-deps
 tryGetFlagCache :: HasEnvConfig env
@@ -380,26 +377,36 @@ writePrecompiledCache ::
   -> [GhcPkgId] -- ^ sub-libraries, in the GhcPkgId format
   -> Set Text -- ^ executables
   -> RIO env ()
-writePrecompiledCache baseConfigOpts loc copts buildHaddocks mghcPkgId subLibs exes = do
-  key <- getPrecompiledCacheKey loc copts buildHaddocks
-  ec <- view envConfigL
-  let stackRootRelative = makeRelative (view stackRootL ec)
-  mlibpath <- traverse (pathFromPkgId stackRootRelative) (installedGhcPkgId mghcPkgId)
-  subLibPaths <- mapM (pathFromPkgId stackRootRelative) subLibs
-  exes' <- forM (Set.toList exes) $ \exe -> do
-    name <- parseRelFile $ T.unpack exe
-    stackRootRelative $ bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
-  let precompiled = PrecompiledCache
-        { pcLibrary = mlibpath
-        , pcSubLibs = subLibPaths
-        , pcExes = exes'
-        }
-  savePrecompiledCache key precompiled
-  -- reuse precompiled cache with haddocks also in case when haddocks are not
-  -- required
-  when buildHaddocks $ do
-    key' <- getPrecompiledCacheKey loc copts False
-    savePrecompiledCache key' precompiled
+writePrecompiledCache
+    baseConfigOpts
+    loc
+    copts
+    buildHaddocks
+    mghcPkgId
+    subLibs
+    exes
+  = do
+      key <- getPrecompiledCacheKey loc copts buildHaddocks
+      ec <- view envConfigL
+      let stackRootRelative = makeRelative (view stackRootL ec)
+      mlibpath <-
+        traverse (pathFromPkgId stackRootRelative) (installedGhcPkgId mghcPkgId)
+      subLibPaths <- mapM (pathFromPkgId stackRootRelative) subLibs
+      exes' <- forM (Set.toList exes) $ \exe -> do
+        name <- parseRelFile $ T.unpack exe
+        stackRootRelative $
+          bcoSnapInstallRoot baseConfigOpts </> bindirSuffix </> name
+      let precompiled = PrecompiledCache
+            { pcLibrary = mlibpath
+            , pcSubLibs = subLibPaths
+            , pcExes = exes'
+            }
+      savePrecompiledCache key precompiled
+      -- reuse precompiled cache with haddocks also in case when haddocks are
+      -- not required
+      when buildHaddocks $ do
+        key' <- getPrecompiledCacheKey loc copts False
+        savePrecompiledCache key' precompiled
  where
   pathFromPkgId stackRootRelative ipid = do
     ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf"

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -27,8 +27,8 @@ import           Stack.Build.Haddock ( shouldHaddockDeps )
 import           Stack.Build.Source ( loadLocalPackage )
 import           Stack.Constants ( compilerOptionsCabalFlag )
 import           Stack.Package
-                   ( applyForceCustomBuild, buildableExes
-                   , packageUnknownTools, processPackageDepsToList
+                   ( applyForceCustomBuild, buildableExes, packageUnknownTools
+                   , processPackageDepsToList
                    )
 import           Stack.Prelude hiding ( loadPackage )
 import           Stack.SourceMap ( getPLIVersion, mkProjectPackage )
@@ -38,6 +38,11 @@ import           Stack.Types.Build
                    , installLocationIsMutable, taskIsTarget, taskLocation
                    , taskProvides, taskTargetIsMutable, toCachePkgSrc
                    )
+import           Stack.Types.Build.ConstructPlan
+                   ( AddDepRes (..), CombinedMap, Ctx (..), M, NotOnlyLocal (..)
+                   , PackageInfo (..), ToolWarning(..), UnregisterState (..)
+                   , W (..), adrHasLibrary, adrVersion, toTask
+                   )
 import           Stack.Types.Build.Exception
                    ( BadDependency (..), BuildException (..)
                    , BuildPrettyException (..), ConstructPlanException (..)
@@ -53,16 +58,10 @@ import           Stack.Types.CompilerPaths
 import           Stack.Types.Config ( Config (..), HasConfig (..), stackRootL )
 import           Stack.Types.ConfigureOpts
                    ( BaseConfigOpts (..), ConfigureOpts (..), configureOpts )
-import Stack.Types.Build.ConstructPlan
-    ( UnregisterState(..), NotOnlyLocal(NotOnlyLocal), ToolWarning(..),
-      Ctx(..), M, CombinedMap, AddDepRes(..),
-      W(..), PackageInfo(..), toTask, adrVersion, adrHasLibrary
-    )
 import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.Dependency ( DepValue (..), isDepTypeLibrary )
 import           Stack.Types.DumpPackage ( DumpPackage (..), dpParentLibIdent )
-import           Stack.Types.EnvConfig
-                   ( EnvConfig (..), HasEnvConfig (..) )
+import           Stack.Types.EnvConfig ( EnvConfig (..), HasEnvConfig (..) )
 import           Stack.Types.EnvSettings
                    ( EnvSettings (..), minimalEnvSettings )
 import           Stack.Types.GhcPkgId ( GhcPkgId )
@@ -72,8 +71,8 @@ import           Stack.Types.NamedComponent ( exeComponents, renderComponent )
 import           Stack.Types.Package
                    ( ExeName (..), InstallLocation (..), Installed (..)
                    , InstalledMap, LocalPackage (..), Package (..)
-                   , PackageSource (..), installedVersion, packageIdentifier
-                   , psVersion, runMemoizedWith, installedMapGhcPkgId
+                   , PackageSource (..), installedMapGhcPkgId, installedVersion
+                   , packageIdentifier, psVersion, runMemoizedWith
                    )
 import           Stack.Types.ProjectConfig ( isPCGlobalProject )
 import           Stack.Types.Runner ( HasRunner (..), globalOptsL )
@@ -82,7 +81,9 @@ import           Stack.Types.SourceMap
                    , GlobalPackage (..), SMTargets (..), SourceMap (..)
                    )
 import           Stack.Types.Version
-                   ( latestApplicableVersion, versionRangeText, withinRange, VersionRange )
+                   ( VersionRange, latestApplicableVersion, versionRangeText
+                   , withinRange
+                   )
 import           System.Environment ( lookupEnv )
 
 -- | Computes a build plan. This means figuring out which build 'Task's to take,
@@ -986,7 +987,10 @@ processAdr adr = case adr of
   ADRFound loc (Executable _) ->
     (Set.empty, Map.empty, installLocationIsMutable loc)
   ADRFound loc (Library ident installedInfo) ->
-    (Set.empty, installedMapGhcPkgId ident installedInfo, installLocationIsMutable loc)
+    ( Set.empty
+    , installedMapGhcPkgId ident installedInfo
+    , installLocationIsMutable loc
+    )
 
 checkDirtiness ::
      PackageSource
@@ -1235,4 +1239,4 @@ combineMap :: Map PackageName PackageSource -> InstalledMap -> CombinedMap
 combineMap = Map.merge
   (Map.mapMissing (\_ s -> PIOnlySource s))
   (Map.mapMissing (\_ i -> uncurry PIOnlyInstalled i))
-  (Map.zipWithMatched (\_ s i -> combineSourceInstalled s i))
+  (Map.zipWithMatched (\_ s i -> combineSourceInstalled s i))
diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs
@@ -150,7 +150,7 @@ import           Stack.Types.BuildOpts
                    )
 import           Stack.Types.CompCollection
                    ( collectionKeyValueList, collectionLookup
-                   , getBuildableListText, getBuildableListAs
+                   , getBuildableListAs, getBuildableListText
                    )
 import           Stack.Types.Compiler
                    ( ActualCompiler (..), WhichCompiler (..)
@@ -184,10 +184,12 @@ import           Stack.Types.NamedComponent
                    , isCTest, renderComponent, testComponents
                    )
 import           Stack.Types.Package
-                   ( InstallLocation (..), Installed (..), InstalledMap
-                   , LocalPackage (..), Package (..), InstalledLibraryInfo (..)
-                   , installedPackageIdentifier, packageIdentifier, runMemoizedWith
-                   , installedMapGhcPkgId, toCabalMungedPackageName, simpleInstalledLib
+                   ( InstallLocation (..), Installed (..)
+                   , InstalledLibraryInfo (..), InstalledMap, LocalPackage (..)
+                   , Package (..), installedMapGhcPkgId
+                   , installedPackageIdentifier, packageIdentifier
+                   , runMemoizedWith, simpleInstalledLib
+                   , toCabalMungedPackageName
                    )
 import           Stack.Types.PackageFile ( PackageWarning (..) )
 import           Stack.Types.Platform ( HasPlatform (..) )

diff --git a/src/Stack/Build/Installed.hs b/src/Stack/Build/Installed.hs
@@ -10,6 +10,7 @@ module Stack.Build.Installed
 
 import           Data.Conduit ( ZipSink (..), getZipSink )
 import qualified Data.Conduit.List as CL
+import           Data.Foldable ( Foldable (..) )
 import qualified Data.Set as Set
 import qualified Data.Map.Strict as Map
 import           Stack.Build.Cache ( getInstalledExes )
@@ -19,21 +20,23 @@ import           Stack.PackageDump
 import           Stack.Prelude
 import           Stack.SourceMap ( getPLIVersion, loadVersion )
 import           Stack.Types.CompilerPaths ( getGhcPkgExe )
-import           Stack.Types.DumpPackage ( DumpPackage (..), dpParentLibIdent, SublibDump (..), sdPackageName )
+import           Stack.Types.DumpPackage
+                   ( DumpPackage (..), SublibDump (..), dpParentLibIdent
+                   , sdPackageName
+                   )
 import           Stack.Types.EnvConfig
                     ( HasEnvConfig, packageDatabaseDeps, packageDatabaseExtra
                     , packageDatabaseLocal
                     )
 import           Stack.Types.GhcPkgId ( GhcPkgId )
 import           Stack.Types.Package
                    ( InstallLocation (..), InstallMap, Installed (..)
-                   , InstalledMap, InstalledPackageLocation (..)
-                   , PackageDatabase (..), PackageDbVariety (..)
-                   , toPackageDbVariety, InstalledLibraryInfo (InstalledLibraryInfo, iliSublib, iliId)
+                   , InstalledLibraryInfo (..), InstalledMap
+                   , InstalledPackageLocation (..), PackageDatabase (..)
+                   , PackageDbVariety (..), toPackageDbVariety
                    )
 import           Stack.Types.SourceMap
                    ( DepPackage (..), ProjectPackage (..), SourceMap (..) )
-import Data.Foldable (Foldable(..))
 
 toInstallMap :: MonadIO m => SourceMap -> m InstallMap
 toInstallMap sourceMap = do
@@ -76,7 +79,8 @@ getInstalled {-opts-} installMap = do
     loadDatabase' (UserPkgDb (InstalledTo Snap) snapDBPath) installedLibs1
   (installedLibs3, localDumpPkgs) <-
     loadDatabase' (UserPkgDb (InstalledTo Local) localDBPath) installedLibs2
-  let installedLibs = foldr' gatherAndTransformSubLoadHelper mempty installedLibs3
+  let installedLibs =
+        foldr' gatherAndTransformSubLoadHelper mempty installedLibs3
 
   -- Add in the executables that are installed, making sure to only trust a
   -- listed installation under the right circumstances (see below)
@@ -280,27 +284,39 @@ toLoadHelper pkgDb dp = LoadHelper
   toInstallLocation WriteOnlyDb = Snap
   toInstallLocation MutableDb = Local
 
--- | This is where sublibraries and main libraries are assembled into
--- a single entity Installed package, where all ghcPkgId live.
+-- | This is where sublibraries and main libraries are assembled into a single
+-- entity Installed package, where all ghcPkgId live.
 gatherAndTransformSubLoadHelper ::
-  LoadHelper
+     LoadHelper
   -> Map PackageName (InstallLocation, Installed)
   -> Map PackageName (InstallLocation, Installed)
 gatherAndTransformSubLoadHelper lh =
   Map.insertWith onPreviousLoadHelper key value
-  where
-    -- here we assume that both have the same location
-    -- which already was a prior assumption in stack
-    onPreviousLoadHelper (pLoc, Library pn incomingLibInfo) (_, Library _ existingLibInfo) =
-          (pLoc, Library pn existingLibInfo{
-            iliSublib=Map.union (iliSublib incomingLibInfo) (iliSublib existingLibInfo),
-            iliId=if isJust $ lhSublibrary lh then iliId existingLibInfo else iliId incomingLibInfo
-            })
-    onPreviousLoadHelper newVal _oldVal = newVal
-    (key, value) = case lhSublibrary lh of
-      Nothing -> (rawPackageName, rawValue)
-      Just sd -> (sdPackageName sd, updateAsSublib sd <$> rawValue)
-    (rawPackageName, rawValue) = lhPair lh
-    updateAsSublib sd (Library (PackageIdentifier _sublibMungedPackageName version) libInfo) =
-      Library (PackageIdentifier key version) libInfo{iliSublib=Map.singleton (sdLibraryName sd) (iliId libInfo)}
-    updateAsSublib _ v = v
+ where
+  -- Here we assume that both have the same location which already was a prior
+  -- assumption in Stack.
+  onPreviousLoadHelper
+      (pLoc, Library pn incomingLibInfo)
+      (_, Library _ existingLibInfo)
+    = ( pLoc
+      , Library pn existingLibInfo
+          { iliSublib = Map.union
+              (iliSublib incomingLibInfo)
+              (iliSublib existingLibInfo)
+          , iliId = if isJust $ lhSublibrary lh
+                      then iliId existingLibInfo
+                      else iliId incomingLibInfo
+          }
+      )
+  onPreviousLoadHelper newVal _oldVal = newVal
+  (key, value) = case lhSublibrary lh of
+    Nothing -> (rawPackageName, rawValue)
+    Just sd -> (sdPackageName sd, updateAsSublib sd <$> rawValue)
+  (rawPackageName, rawValue) = lhPair lh
+  updateAsSublib
+      sd
+      (Library (PackageIdentifier _sublibMungedPackageName version) libInfo)
+    = Library
+        (PackageIdentifier key version)
+        libInfo {iliSublib = Map.singleton (sdLibraryName sd) (iliId libInfo)}
+  updateAsSublib _ v = v
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
@@ -99,7 +99,8 @@ import           Stack.Types.Package
                    ( BioInput(..), BuildInfoOpts (..), InstallMap
                    , Installed (..), InstalledMap, Package (..)
                    , PackageConfig (..), PackageException (..)
-                   , dotCabalCFilePath, packageIdentifier, installedToPackageIdOpt
+                   , dotCabalCFilePath, installedToPackageIdOpt
+                   , packageIdentifier
                    )
 import           Stack.Types.PackageFile
                    ( DotCabalPath, PackageComponentFile (..) )