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

package.yaml

@@ -274,6 +274,7 @@ library:
   - Stack.Types.Config.Build
   - Stack.Types.Config.Exception
   - Stack.Types.ConfigMonoid
+  - Stack.Types.Curator
   - Stack.Types.Docker
   - Stack.Types.DockerEntrypoint
   - Stack.Types.DownloadInfo
@@ -294,6 +295,8 @@ library:
   - Stack.Types.Package
   - Stack.Types.PackageName
   - Stack.Types.Platform
+  - Stack.Types.Project
+  - Stack.Types.ProjectConfig
   - Stack.Types.PvpBounds
   - Stack.Types.Resolver
   - Stack.Types.Runner

src/Stack/Build/ConstructPlan.hs

@@ -45,8 +45,9 @@ import           Stack.Types.CompilerPaths
                    ( CompilerPaths (..), HasCompiler (..) )
 import           Stack.Types.Config
                    ( BuildOpts (..), BuildOptsCLI (..), BuildSubset (..)
-                   , Config (..), Curator (..), HasConfig (..), stackRootL
+                   , Config (..), HasConfig (..), stackRootL
                    )
+import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.Dependency
                    ( DepValue (DepValue), DepType (AsLibrary) )
 import           Stack.Types.DumpPackage ( DumpPackage (..) )

src/Stack/Build/Execute.hs

@@ -149,9 +149,9 @@ import           Stack.Types.CompilerPaths
                    )
 import           Stack.Types.Config
                    ( BenchmarkOpts (..), BuildOpts (..), BuildOptsCLI (..)
-                   , CabalVerbosity (..), Config (..), Curator (..)
-                   , HaddockOpts (..), HasConfig (..), TestOpts (..)
-                   , buildOptsL, stackRootL, whichCompilerL
+                   , CabalVerbosity (..), Config (..), HaddockOpts (..)
+                   , HasConfig (..), TestOpts (..), buildOptsL, stackRootL
+                   , whichCompilerL
                    )
 import           Stack.Types.DumpLogs ( DumpLogs (..) )
 import           Stack.Types.DumpPackage ( DumpPackage (..) )
@@ -177,6 +177,7 @@ import           Stack.Types.Package
                    )
 import           Stack.Types.PackageFile ( PackageWarning (..) )
 import           Stack.Types.Platform ( HasPlatform (..) )
+import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.Runner ( HasRunner, globalOptsL, terminalL )
 import           Stack.Types.SourceMap ( Target )
 import           Stack.Types.Version ( withinRange )

src/Stack/Build/Source.hs

@@ -40,9 +40,9 @@ import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
 import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
 import           Stack.Types.Config
                    ( ApplyCLIFlag (..), BuildOpts (..), BuildOptsCLI (..)
-                   , Config (..), Curator (..), HasConfig (..), TestOpts (..)
-                   , buildOptsL
+                   , Config (..), HasConfig (..), TestOpts (..), buildOptsL
                    )
+import           Stack.Types.Curator ( Curator (..) )
 import           Stack.Types.EnvConfig
                    ( EnvConfig (..), HasEnvConfig (..), HasSourceMap (..)
                    , actualCompilerVersionL

src/Stack/Build/Target.hs

@@ -76,11 +76,11 @@ import           Stack.SourceMap ( additionalDepPackage )
 import           Stack.Prelude
 import           Stack.Types.BuildConfig
                    ( BuildConfig (..), HasBuildConfig (..) )
-import           Stack.Types.Config
-                   ( BuildOptsCLI (..), Config (..), ProjectConfig (..) )
+import           Stack.Types.Config ( BuildOptsCLI (..), Config (..) )
 import           Stack.Types.NamedComponent
                    ( NamedComponent (..), renderComponent )
 import           Stack.Types.Build ( BuildPrettyException (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.SourceMap
                    ( DepPackage (..), GlobalPackage (..), PackageType (..)
                    , ProjectPackage, SMActual (..), SMTargets (..)

src/Stack/Config.hs

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

src/Stack/Config/Docker.hs

@@ -13,7 +13,7 @@ import           Data.List ( find )
 import qualified Data.Text as T
 import           Distribution.Version ( simplifyVersionRange )
 import           Stack.Prelude
-import           Stack.Types.Config ( Project (..) )
+import           Stack.Types.Project ( Project (..) )
 import           Stack.Types.Docker
                    ( DockerOpts (..), DockerMonoidRepoOrImage (..)
                    , DockerOptsMonoid (..), dockerImageArgName

src/Stack/ConfigCmd.hs

@@ -38,14 +38,14 @@ import           Stack.Config
                    )
 import           Stack.Constants ( stackDotYaml )
 import           Stack.Prelude
-import           Stack.Types.Config
-                   ( Config (..), HasConfig (..), ProjectConfig (..) )
+import           Stack.Types.Config ( Config (..), HasConfig (..) )
 import           Stack.Types.ConfigMonoid
                    ( configMonoidInstallGHCName, configMonoidSystemGHCName )
 import           Stack.Types.EnvConfig ( EnvConfig )
 import           Stack.Types.EnvSettings ( EnvSettings (..) )
 import           Stack.Types.GHCVariant ( HasGHCVariant )
 import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.Resolver ( AbstractResolver, readAbstractResolver )
 import           Stack.Types.Runner ( globalOptsL )
 import           System.Environment ( getEnvironment )

src/Stack/Init.hs

@@ -47,10 +47,11 @@ import           Stack.Runners
                    ( ShouldReexec (..), withConfig, withGlobalProject )
 import           Stack.SourceMap
                    ( SnapshotCandidate, loadProjectSnapshotCandidate )
-import           Stack.Types.Config ( HasConfig, Project (..) )
+import           Stack.Types.Config ( HasConfig )
 import           Stack.Types.Config.Exception ( ConfigPrettyException (..) )
 import           Stack.Types.GHCVariant ( HasGHCVariant )
 import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Project ( Project (..) )
 import           Stack.Types.Runner (Runner, globalOptsL )
 import           Stack.Types.Resolver ( AbstractResolver, Snapshots (..) )
 import           Stack.Types.Version ( stackMajorVersion )

src/Stack/Options/Completion.hs

@@ -22,9 +22,11 @@ import           Stack.Options.GlobalParser ( globalOptsFromMonoid )
 import           Stack.Runners
 import           Stack.Prelude
 import           Stack.Types.BuildConfig ( BuildConfig (..), HasBuildConfig (..) )
-import           Stack.Types.Config
+import           Stack.Types.Config ( Config (..) )
 import           Stack.Types.EnvConfig ( EnvConfig )
 import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.NamedComponent
 import           Stack.Types.SourceMap
 

src/Stack/Options/GlobalParser.hs

@@ -8,13 +8,14 @@ module Stack.Options.GlobalParser
   ) where
 
 import           Options.Applicative
-                   ( Parser, auto, completer, help, hidden, internal, long
-                   , metavar, option, strOption, value
+                   ( Parser, ReadM, auto, completer, help, hidden, internal
+                   , long, metavar, option, strOption, value
                    )
 import           Options.Applicative.Builder.Extra
                    ( fileExtCompleter, firstBoolFlagsFalse
                    , firstBoolFlagsNoDefault, firstBoolFlagsTrue, optionalFirst
                    )
+import           Options.Applicative.Types ( readerAsk )
 import           Path.IO ( getCurrentDir, resolveDir', resolveFile' )
 import qualified Stack.Docker as Docker
 import           Stack.Prelude
@@ -23,7 +24,6 @@ import           Stack.Options.LogLevelParser ( logLevelOptsParser )
 import           Stack.Options.ResolverParser
                    ( abstractResolverOptsParser, compilerOptsParser )
 import           Stack.Options.Utils ( GlobalOptsContext (..), hideMods )
-import           Stack.Types.Config ( defaultLogLevel, readStyles )
 import           Stack.Types.GlobalOpts ( GlobalOpts (..) )
 import           Stack.Types.GlobalOptsMonoid ( GlobalOptsMonoid (..) )
 import           Stack.Types.LockFileBehavior
@@ -143,3 +143,10 @@ globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = do
                 _ -> LFBReadOnly
         in  fromFirst defLFB globalMonoidLockFileBehavior
     }
+
+-- | Default logging level should be something useful but not crazy.
+defaultLogLevel :: LogLevel
+defaultLogLevel = LevelInfo
+
+readStyles :: ReadM StylesUpdate
+readStyles = parseStylesUpdateFromString <$> readerAsk

src/Stack/Types/BuildConfig.hs

@@ -15,8 +15,8 @@ module Stack.Types.BuildConfig
 import           Path ( (</>), parent )
 import           RIO.Process ( HasProcessContext (..) )
 import           Stack.Prelude
-import           Stack.Types.Config
-                   ( Config, Curator, HasConfig (..), workDirL )
+import           Stack.Types.Config ( Config, HasConfig (..), workDirL )
+import           Stack.Types.Curator ( Curator )
 import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
 import           Stack.Types.Platform ( HasPlatform (..) )
 import           Stack.Types.Runner ( HasRunner (..) )

src/Stack/Types/Config.hs

@@ -20,19 +20,11 @@ module Stack.Types.Config
   , askLatestSnapshotUrl
   , configProjectRoot
   -- * Details
-  -- ** GlobalOpts & GlobalOptsMonoid
-  , defaultLogLevel
   -- ** Project & ProjectAndConfigMonoid
-  , Project (..)
-  , ProjectConfig (..)
-  , Curator (..)
   , ProjectAndConfigMonoid (..)
   , parseProjectAndConfigMonoid
-  -- ** Styles
-  , readStyles
   -- * Paths
   , bindirSuffix
-  , GlobalInfoSource (..)
   , docDirSuffix
   , platformOnlyRelDir
   , workDirL
@@ -50,24 +42,17 @@ module Stack.Types.Config
   , envOverrideSettingsL
   -- * Helper logging functions
   , prettyStackDevL
-  -- * Lens reexport
-  , view
-  , to
   ) where
 
 import           Pantry.Internal.AesonExtended
-                   ( FromJSON (..), ToJSON (..), Value, WithJSONWarnings (..)
-                   , (.=), (...:), (..:?), (..!=), jsonSubWarnings
-                   , jsonSubWarningsT, jsonSubWarningsTT, object
+                   ( Value, WithJSONWarnings (..), (...:), (..:?), (..!=)
+                   , jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT
                    , withObjectWarnings
                    )
-import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Yaml as Yaml
 import           Distribution.System ( Platform )
 import           Generics.Deriving.Monoid ( mappenddefault, memptydefault )
-import           Options.Applicative ( ReadM )
-import qualified Options.Applicative.Types as OA
 import           Path ( (</>), parent, reldir, relfile )
 import           RIO.Process ( HasProcessContext (..), ProcessContext )
 import           Stack.Constants ( bindirSuffix, docDirSuffix )
@@ -90,6 +75,8 @@ import           Stack.Types.Nix ( NixOpts )
 import           Stack.Types.Platform
                    ( HasPlatform (..), PlatformVariant, platformOnlyRelDir
                    )
+import           Stack.Types.Project ( Project (..) )
+import           Stack.Types.ProjectConfig ( ProjectConfig (..) )
 import           Stack.Types.PvpBounds ( PvpBounds )
 import           Stack.Types.Resolver ( AbstractResolver )
 import           Stack.Types.Runner ( HasRunner (..), Runner, globalOptsL )
@@ -237,103 +224,6 @@ configProjectRoot c =
     PCGlobalProject -> Nothing
     PCNoProject _deps -> Nothing
 
--- | Project configuration information. Not every run of Stack has a
--- true local project; see constructors below.
-data ProjectConfig a
-  = PCProject a
-    -- ^ Normal run: we want a project, and have one. This comes from
-    -- either 'SYLDefault' or 'SYLOverride'.
-  | PCGlobalProject
-    -- ^ No project was found when using 'SYLDefault'. Instead, use
-    -- the implicit global.
-  | PCNoProject ![PackageIdentifierRevision]
-    -- ^ Use a no project run. This comes from 'SYLNoProject'.
-
--- | Default logging level should be something useful but not crazy.
-defaultLogLevel :: LogLevel
-defaultLogLevel = LevelInfo
-
-readStyles :: ReadM StylesUpdate
-readStyles = parseStylesUpdateFromString <$> OA.readerAsk
-
--- | A project is a collection of packages. We can have multiple stack.yaml
--- files, but only one of them may contain project information.
-data Project = Project
-  { projectUserMsg :: !(Maybe String)
-    -- ^ A warning message to display to the user when the auto generated
-    -- config may have issues.
-  , projectPackages :: ![RelFilePath]
-    -- ^ Packages which are actually part of the project (as opposed
-    -- to dependencies).
-  , projectDependencies :: ![RawPackageLocation]
-    -- ^ Dependencies defined within the stack.yaml file, to be applied on top
-    -- of the snapshot.
-  , projectFlags :: !(Map PackageName (Map FlagName Bool))
-    -- ^ Flags to be applied on top of the snapshot flags.
-  , projectResolver :: !RawSnapshotLocation
-    -- ^ How we resolve which @Snapshot@ to use
-  , projectCompiler :: !(Maybe WantedCompiler)
-    -- ^ Override the compiler in 'projectResolver'
-  , projectExtraPackageDBs :: ![FilePath]
-  , projectCurator :: !(Maybe Curator)
-    -- ^ Extra configuration intended exclusively for usage by the curator tool.
-    -- In other words, this is /not/ part of the documented and exposed Stack
-    -- API. SUBJECT TO CHANGE.
-  , projectDropPackages :: !(Set PackageName)
-    -- ^ Packages to drop from the 'projectResolver'.
-  }
-  deriving Show
-
-instance ToJSON Project where
-  -- Expanding the constructor fully to ensure we don't miss any fields.
-  toJSON (Project userMsg packages extraDeps flags resolver mcompiler extraPackageDBs mcurator drops) = object $ concat
-    [ maybe [] (\cv -> ["compiler" .= cv]) mcompiler
-    , maybe [] (\msg -> ["user-message" .= msg]) userMsg
-    , [ "extra-package-dbs" .= extraPackageDBs | not (null extraPackageDBs) ]
-    , [ "extra-deps" .= extraDeps | not (null extraDeps) ]
-    , [ "flags" .= fmap toCabalStringMap (toCabalStringMap flags)
-      | not (Map.null flags)
-      ]
-    , ["packages" .= packages]
-    , ["resolver" .= resolver]
-    , maybe [] (\c -> ["curator" .= c]) mcurator
-    , [ "drop-packages" .= Set.map CabalString drops | not (Set.null drops) ]
-    ]
-
--- | Extra configuration intended exclusively for usage by the curator tool. In
--- other words, this is /not/ part of the documented and exposed Stack API.
--- SUBJECT TO CHANGE.
-data Curator = Curator
-  { curatorSkipTest :: !(Set PackageName)
-  , curatorExpectTestFailure :: !(Set PackageName)
-  , curatorSkipBenchmark :: !(Set PackageName)
-  , curatorExpectBenchmarkFailure :: !(Set PackageName)
-  , curatorSkipHaddock :: !(Set PackageName)
-  , curatorExpectHaddockFailure :: !(Set PackageName)
-  }
-  deriving Show
-
-instance ToJSON Curator where
-  toJSON c = object
-    [ "skip-test" .= Set.map CabalString (curatorSkipTest c)
-    , "expect-test-failure" .= Set.map CabalString (curatorExpectTestFailure c)
-    , "skip-bench" .= Set.map CabalString (curatorSkipBenchmark c)
-    , "expect-benchmark-failure" .=
-        Set.map CabalString (curatorExpectTestFailure c)
-    , "skip-haddock" .= Set.map CabalString (curatorSkipHaddock c)
-    , "expect-test-failure" .=
-        Set.map CabalString (curatorExpectHaddockFailure c)
-    ]
-
-instance FromJSON (WithJSONWarnings Curator) where
-  parseJSON = withObjectWarnings "Curator" $ \o -> Curator
-    <$> fmap (Set.map unCabalString) (o ..:? "skip-test" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-test-failure" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "skip-bench" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-benchmark-failure" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "skip-haddock" ..!= mempty)
-    <*> fmap (Set.map unCabalString) (o ..:? "expect-haddock-failure" ..!= mempty)
-
 -- | Get the URL to request the information on the latest snapshots
 askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text
 askLatestSnapshotUrl = view $ configL.to configLatestSnapshot
@@ -354,14 +244,6 @@ ghcInstallHook = do
   hd <- hooksDir
   pure (hd </> [relfile|ghc-install.sh|])
 
--- | Where do we get information on global packages for loading up a
--- 'LoadedSnapshot'?
-data GlobalInfoSource
-  = GISSnapshotHints
-    -- ^ Accept the hints in the snapshot definition
-  | GISCompiler ActualCompiler
-    -- ^ Look up the actual information in the installed compiler
-
 data ProjectAndConfigMonoid
   = ProjectAndConfigMonoid !Project !ConfigMonoid