Re #2407 Move ExtraDirs out of Stack.Types.Config

Author: mpilgrem

package.yaml

@@ -282,6 +282,7 @@ library:
   - Stack.Types.DumpPackage
   - Stack.Types.EnvConfig
   - Stack.Types.EnvSettings
+  - Stack.Types.ExtraDirs
   - Stack.Types.GHCDownloadInfo
   - Stack.Types.GHCVariant
   - Stack.Types.GhcOptionKey
@@ -296,6 +297,7 @@ library:
   - Stack.Types.PackageName
   - Stack.Types.Platform
   - Stack.Types.Project
+  - Stack.Types.ProjectAndConfigMonoid
   - Stack.Types.ProjectConfig
   - Stack.Types.PvpBounds
   - Stack.Types.Resolver

src/Stack/Build/Execute.hs

@@ -141,7 +141,7 @@ import           Stack.Types.BuildConfig
                    ( BuildConfig (..), HasBuildConfig (..), projectRootL )
 import           Stack.Types.Compiler
                    ( ActualCompiler (..), WhichCompiler (..)
-                   , compilerVersionString, getGhcVersion
+                   , compilerVersionString, getGhcVersion, whichCompilerL
                    )
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..)
@@ -151,7 +151,6 @@ import           Stack.Types.Config
                    ( BenchmarkOpts (..), BuildOpts (..), BuildOptsCLI (..)
                    , CabalVerbosity (..), Config (..), HaddockOpts (..)
                    , HasConfig (..), TestOpts (..), buildOptsL, stackRootL
-                   , whichCompilerL
                    )
 import           Stack.Types.DumpLogs ( DumpLogs (..) )
 import           Stack.Types.DumpPackage ( DumpPackage (..) )

src/Stack/Config.hs

@@ -105,9 +105,8 @@ import           Stack.Types.ColorWhen ( ColorWhen (..) )
 import           Stack.Types.Compiler ( defaultCompilerRepository )
 import           Stack.Types.Config
                    ( BuildOpts (..), Config (..), HasConfig (..)
-                   , ProjectAndConfigMonoid (..), askLatestSnapshotUrl
-                   , configProjectRoot, parseProjectAndConfigMonoid
-                   , platformOnlyRelDir, stackRootL, workDirL
+                   , askLatestSnapshotUrl, configProjectRoot, platformOnlyRelDir
+                   , stackRootL, workDirL
                    )
 import           Stack.Types.Config.Exception
                    ( ConfigException (..), ConfigPrettyException (..)
@@ -120,6 +119,8 @@ import           Stack.Types.GlobalOpts (  GlobalOpts (..) )
 import           Stack.Types.Nix ( nixEnable )
 import           Stack.Types.Platform ( PlatformVariant (..) )
 import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectAndConfigMonoid
+                   ( ProjectAndConfigMonoid (..), parseProjectAndConfigMonoid )
 import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.PvpBounds ( PvpBounds (..), PvpBoundsType (..) )
 import           Stack.Types.Resolver ( AbstractResolver (..), Snapshots (..) )

src/Stack/Setup.hs

@@ -117,17 +117,16 @@ import           Stack.Types.Compiler
                    ( ActualCompiler (..), CompilerException (..)
                    , CompilerRepository (..), WhichCompiler (..)
                    , compilerVersionText, getGhcVersion, isWantedCompiler
-                   , wantedToActual, whichCompiler
+                   , wantedToActual, whichCompiler, whichCompilerL
                    )
 import           Stack.Types.CompilerBuild
                    ( CompilerBuild (..), compilerBuildName, compilerBuildSuffix
                    )
 import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), GhcPkgExe (..), HasCompiler (..) )
 import           Stack.Types.Config
-                   ( BuildOptsCLI (..), Config (..), ExtraDirs (..)
-                   , HasConfig (..), envOverrideSettingsL
-                   , ghcInstallHook, platformOnlyRelDir, whichCompilerL
+                   ( BuildOptsCLI (..), Config (..), HasConfig (..)
+                   , envOverrideSettingsL, ghcInstallHook
                    )
 import           Stack.Types.Docker ( dockerStackExeArgName )
 import           Stack.Types.DownloadInfo ( DownloadInfo (..) )
@@ -138,12 +137,15 @@ import           Stack.Types.EnvConfig
                    , packageDatabaseLocal
                    )
 import           Stack.Types.EnvSettings ( EnvSettings (..), minimalEnvSettings )
+import           Stack.Types.ExtraDirs ( ExtraDirs (..) )
 import           Stack.Types.GHCDownloadInfo ( GHCDownloadInfo (..) )
 import           Stack.Types.GHCVariant
                    ( GHCVariant (..), HasGHCVariant (..), ghcVariantName
                    , ghcVariantSuffix
                    )
-import           Stack.Types.Platform ( HasPlatform (..), PlatformVariant (..) )
+import           Stack.Types.Platform
+                   ( HasPlatform (..), PlatformVariant (..)
+                   , platformOnlyRelDir )
 import           Stack.Types.Runner ( HasRunner (..) )
 import           Stack.Types.SetupInfo ( SetupInfo (..) )
 import           Stack.Types.SourceMap ( SMActual (..), SourceMap (..) )

src/Stack/Setup/Installed.hs

@@ -33,7 +33,8 @@ import           RIO.Process
 import           Stack.Constants
 import           Stack.Prelude
 import           Stack.Types.Compiler
-import           Stack.Types.Config
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.ExtraDirs ( ExtraDirs (..) )
 
 data Tool
   = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512

src/Stack/Types/Compiler.hs

@@ -17,6 +17,7 @@ module Stack.Types.Compiler
   , wantedToActual
   , actualToWanted
   , parseActualCompiler
+  , whichCompilerL
   ) where
 
 import           Data.Aeson
@@ -141,3 +142,6 @@ instance FromJSON CompilerRepository where
 defaultCompilerRepository :: CompilerRepository
 defaultCompilerRepository =
   CompilerRepository "https://gitlab.haskell.org/ghc/ghc.git"
+
+whichCompilerL :: Getting r ActualCompiler WhichCompiler
+whichCompilerL = to whichCompiler

src/Stack/Types/Config.hs

@@ -20,9 +20,6 @@ module Stack.Types.Config
   , askLatestSnapshotUrl
   , configProjectRoot
   -- * Details
-  -- ** Project & ProjectAndConfigMonoid
-  , ProjectAndConfigMonoid (..)
-  , parseProjectAndConfigMonoid
   -- * Paths
   , bindirSuffix
   , docDirSuffix
@@ -32,40 +29,26 @@ module Stack.Types.Config
   -- * Command-related types
   , module X
   -- * Lens helpers
-  , ExtraDirs (..)
   , buildOptsL
   , globalOptsL
   , globalOptsBuildOptsMonoidL
   , stackRootL
   , stackGlobalConfigL
-  , whichCompilerL
   , envOverrideSettingsL
   -- * Helper logging functions
   , prettyStackDevL
   ) where
 
-import           Pantry.Internal.AesonExtended
-                   ( Value, WithJSONWarnings (..), (...:), (..:?), (..!=)
-                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
-                   , withObjectWarnings
-                   )
-import qualified Data.Set as Set
-import qualified Data.Yaml as Yaml
 import           Distribution.System ( Platform )
-import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
 import           Path ( (</>), parent, reldir, relfile )
 import           RIO.Process ( HasProcessContext (..), ProcessContext )
 import           Stack.Constants ( bindirSuffix, docDirSuffix )
 import           Stack.Prelude
 import           Stack.Types.ApplyGhcOptions ( ApplyGhcOptions (..) )
 import           Stack.Types.CabalConfigKey ( CabalConfigKey )
-import           Stack.Types.Compiler
-                   ( ActualCompiler (..), CompilerRepository, WhichCompiler
-                   , whichCompiler
-                   )
+import           Stack.Types.Compiler ( CompilerRepository )
 import           Stack.Types.CompilerBuild ( CompilerBuild )
-import           Stack.Types.ConfigMonoid
-                   ( ConfigMonoid (..), parseConfigMonoidObject)
+import           Stack.Types.ConfigMonoid ( ConfigMonoid (..) )
 import           Stack.Types.Docker ( DockerOpts )
 import           Stack.Types.DumpLogs ( DumpLogs )
 import           Stack.Types.EnvSettings ( EnvSettings )
@@ -244,46 +227,6 @@ ghcInstallHook = do
   hd <- hooksDir
   pure (hd </> [relfile|ghc-install.sh|])
 
-data ProjectAndConfigMonoid
-  = ProjectAndConfigMonoid !Project !ConfigMonoid
-
-parseProjectAndConfigMonoid ::
-     Path Abs Dir
-  -> Value
-  -> Yaml.Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
-parseProjectAndConfigMonoid rootDir =
-  withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
-    packages <- o ..:? "packages" ..!= [RelFilePath "."]
-    deps <- jsonSubWarningsTT (o ..:? "extra-deps") ..!= []
-    flags' <- o ..:? "flags" ..!= mempty
-    let flags = unCabalStringMap <$> unCabalStringMap
-                (flags' :: Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
-
-    resolver <- jsonSubWarnings $ o ...: ["snapshot", "resolver"]
-    mcompiler <- o ..:? "compiler"
-    msg <- o ..:? "user-message"
-    config <- parseConfigMonoidObject rootDir o
-    extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
-    mcurator <- jsonSubWarningsT (o ..:? "curator")
-    drops <- o ..:? "drop-packages" ..!= mempty
-    pure $ do
-      deps' <- mapM (resolvePaths (Just rootDir)) deps
-      resolver' <- resolvePaths (Just rootDir) resolver
-      let project = Project
-            { projectUserMsg = msg
-            , projectResolver = resolver'
-            , projectCompiler = mcompiler -- FIXME make sure resolver' isn't SLCompiler
-            , projectExtraPackageDBs = extraPackageDBs
-            , projectPackages = packages
-            , projectDependencies =
-                concatMap toList (deps' :: [NonEmpty RawPackageLocation])
-            , projectFlags = flags
-            , projectCurator = mcurator
-            , projectDropPackages = Set.map unCabalString drops
-            }
-      pure $ ProjectAndConfigMonoid project config
-
-
 -----------------------------------
 -- Lens classes
 -----------------------------------
@@ -344,20 +287,6 @@ stackGlobalConfigL :: HasConfig s => Lens' s (Path Abs File)
 stackGlobalConfigL =
   configL.lens configUserConfigPath (\x y -> x { configUserConfigPath = y })
 
-data ExtraDirs = ExtraDirs
-  { edBins :: ![Path Abs Dir]
-  , edInclude :: ![Path Abs Dir]
-  , edLib :: ![Path Abs Dir]
-  }
-  deriving (Show, Generic)
-
-instance Semigroup ExtraDirs where
-  (<>) = mappenddefault
-
-instance Monoid ExtraDirs where
-  mempty = memptydefault
-  mappend = (<>)
-
 buildOptsL :: HasConfig s => Lens' s BuildOpts
 buildOptsL = configL.lens
   configBuild
@@ -373,9 +302,6 @@ globalOptsBuildOptsMonoidL =
     configMonoidBuildOpts
     (\x y -> x { configMonoidBuildOpts = y })
 
-whichCompilerL :: Getting r ActualCompiler WhichCompiler
-whichCompilerL = to whichCompiler
-
 envOverrideSettingsL ::
      HasConfig env
   => Lens' env (EnvSettings -> IO ProcessContext)

src/Stack/Types/ExtraDirs.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Stack.Types.ExtraDirs
+  ( ExtraDirs (..)
+  ) where
+
+import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
+import           Stack.Prelude
+
+data ExtraDirs = ExtraDirs
+  { edBins :: ![Path Abs Dir]
+  , edInclude :: ![Path Abs Dir]
+  , edLib :: ![Path Abs Dir]
+  }
+  deriving (Show, Generic)
+
+instance Semigroup ExtraDirs where
+  (<>) = mappenddefault
+
+instance Monoid ExtraDirs where
+  mempty = memptydefault
+  mappend = (<>)

src/Stack/Types/ProjectAndConfigMonoid.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Stack.Types.ProjectAndConfigMonoid
+  ( ProjectAndConfigMonoid (..)
+  , parseProjectAndConfigMonoid
+  ) where
+
+import qualified Data.Set as Set
+import qualified Data.Yaml as Yaml
+import           Pantry.Internal.AesonExtended
+                   ( WithJSONWarnings, Value, (...:), (..:?), (..!=)
+                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
+                   , withObjectWarnings )
+import           Stack.Prelude
+import           Stack.Types.ConfigMonoid
+                   ( ConfigMonoid, parseConfigMonoidObject )
+import           Stack.Types.Project ( Project (..) )
+
+data ProjectAndConfigMonoid
+  = ProjectAndConfigMonoid !Project !ConfigMonoid
+
+parseProjectAndConfigMonoid ::
+     Path Abs Dir
+  -> Value
+  -> Yaml.Parser (WithJSONWarnings (IO ProjectAndConfigMonoid))
+parseProjectAndConfigMonoid rootDir =
+  withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do
+    packages <- o ..:? "packages" ..!= [RelFilePath "."]
+    deps <- jsonSubWarningsTT (o ..:? "extra-deps") ..!= []
+    flags' <- o ..:? "flags" ..!= mempty
+    let flags = unCabalStringMap <$> unCabalStringMap
+                (flags' :: Map (CabalString PackageName) (Map (CabalString FlagName) Bool))
+
+    resolver <- jsonSubWarnings $ o ...: ["snapshot", "resolver"]
+    mcompiler <- o ..:? "compiler"
+    msg <- o ..:? "user-message"
+    config <- parseConfigMonoidObject rootDir o
+    extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
+    mcurator <- jsonSubWarningsT (o ..:? "curator")
+    drops <- o ..:? "drop-packages" ..!= mempty
+    pure $ do
+      deps' <- mapM (resolvePaths (Just rootDir)) deps
+      resolver' <- resolvePaths (Just rootDir) resolver
+      let project = Project
+            { projectUserMsg = msg
+            , projectResolver = resolver'
+            , projectCompiler = mcompiler -- FIXME make sure resolver' isn't SLCompiler
+            , projectExtraPackageDBs = extraPackageDBs
+            , projectPackages = packages
+            , projectDependencies =
+                concatMap toList (deps' :: [NonEmpty RawPackageLocation])
+            , projectFlags = flags
+            , projectCurator = mcurator
+            , projectDropPackages = Set.map unCabalString drops
+            }
+      pure $ ProjectAndConfigMonoid project config

src/test/Stack/ConfigSpec.hs

@@ -28,13 +28,14 @@ import           Stack.Runners
 import           Stack.Types.BuildConfig ( BuildConfig (..), projectRootL )
 import           Stack.Types.Config
                    ( BenchmarkOpts (..), BuildOpts (..), CabalVerbosity (..)
-                   , Config (..), ProjectAndConfigMonoid (..), TestOpts (..)
-                   , parseProjectAndConfigMonoid
+                   , Config (..), TestOpts (..)
                    )
 import           Stack.Types.ConfigMonoid
                    ( ConfigMonoid (..), parseConfigMonoid )
 import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
 import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectAndConfigMonoid
+                   ( ProjectAndConfigMonoid (..), parseProjectAndConfigMonoid )
 import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
 import           System.Directory
 import           System.Environment

stack.cabal

@@ -262,6 +262,7 @@ library
       Stack.Types.DumpPackage
       Stack.Types.EnvConfig
       Stack.Types.EnvSettings
+      Stack.Types.ExtraDirs
       Stack.Types.GHCDownloadInfo
       Stack.Types.GHCVariant
       Stack.Types.GhcOptionKey
@@ -276,6 +277,7 @@ library
       Stack.Types.PackageName
       Stack.Types.Platform
       Stack.Types.Project
+      Stack.Types.ProjectAndConfigMonoid
       Stack.Types.ProjectConfig
       Stack.Types.PvpBounds
       Stack.Types.Resolver