Add projectConfigShared test

cabal-install/tests/IntegrationTests2/ProjectConfig/ParsecTests.hs

@@ -5,16 +5,29 @@ module IntegrationTests2.ProjectConfig.ParsecTests (parserTests) where
 
 import qualified Data.ByteString as BS
 import Data.Either
-import Distribution.Client.BuildReports.Types
+import Data.Maybe
+import Distribution.Client.Dependency.Types (PreSolver (..))
 import Distribution.Client.DistDirLayout
 import Distribution.Client.HttpUtils
+import Distribution.Client.IndexUtils.ActiveRepos (ActiveRepoEntry (..), ActiveRepos (..), CombineStrategy (..))
+import Distribution.Client.IndexUtils.IndexState (RepoIndexState (..), headTotalIndexState, insertIndexState)
 import Distribution.Client.ProjectConfig
 import Distribution.Client.ProjectConfig.Parsec
 import Distribution.Client.RebuildMonad (runRebuild)
+import Distribution.Client.Targets (readUserConstraint)
+import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDepMod (..), RelaxDepScope (..), RelaxDepSubject (..), RelaxDeps (..), RelaxedDep (..))
+import Distribution.Client.Types.RepoName (RepoName (..))
 import Distribution.Client.Types.SourceRepo
+import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy (..))
+import Distribution.Compiler (CompilerFlavor (..))
+import Distribution.Parsec (simpleParsec)
+import Distribution.Simple.Compiler (PackageDB (..))
 import Distribution.Simple.Flag
 import Distribution.Simple.InstallDirs (toPathTemplate)
+import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
+import Distribution.Solver.Types.Settings (AllowBootLibInstalls (..), CountConflicts (..), FineGrainedConflicts (..), MinimizeConflictSet (..), PreferOldest (..), ReorderGoals (..), StrongFlags (..))
 import Distribution.Types.CondTree (CondTree (..))
+import Distribution.Types.PackageId (PackageIdentifier (..))
 import Distribution.Types.PackageName
 import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
 import Distribution.Types.SourceRepo (KnownRepoType (..), RepoType (..))
@@ -37,6 +50,7 @@ parserTests =
   , testCase "read extra-packages" testExtraPackages
   , testCase "read source-repository-package" testSourceRepoList
   , testCase "read project-config-build-only" testProjectConfigBuildOnly
+  , testCase "read project-shared" testProjectConfigShared
   ]
 
 testPackages :: Assertion
@@ -110,6 +124,70 @@ testProjectConfigBuildOnly = do
     projectConfigLogsDir = toFlag "logs-directory"
     projectConfigClientInstallFlags = mempty -- cli only
 
+testProjectConfigShared :: Assertion
+testProjectConfigShared = do
+  let rootFp = "project-config-shared"
+  projectFileFp <- projectConfigPath rootFp "cabal.project" ""
+  let
+    projectConfigConstraints = getProjectConfigConstraints projectFileFp
+    expected = ProjectConfigShared{..}
+  (config, legacy) <- readConfigDefault rootFp
+  print (projectConfigShared $ condTreeData legacy)
+  assertConfig expected config legacy (projectConfigShared . condTreeData)
+  where
+    projectConfigDistDir = mempty -- cli only
+    projectConfigConfigFile = mempty -- cli only
+    projectConfigProjectDir = mempty -- cli only
+    projectConfigProjectFile = mempty -- cli only
+    projectConfigIgnoreProject = toFlag True
+    projectConfigHcFlavor = toFlag GHCJS
+    projectConfigHcPath = toFlag "/some/path/to/compiler"
+    projectConfigHcPkg = toFlag "/some/path/to/ghc-pkg"
+    projectConfigHaddockIndex = toFlag $ toPathTemplate "/path/to/haddock-index"
+    projectConfigInstallDirs = mempty -- cli only
+    projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
+    projectConfigRemoteRepos = mempty -- cli only
+    projectConfigLocalNoIndexRepos = mempty -- cli only
+    projectConfigActiveRepos = Flag (ActiveRepos [ActiveRepo (RepoName "hackage.haskell.org") CombineStrategyMerge, ActiveRepo (RepoName "my-repository") CombineStrategyOverride])
+    projectConfigIndexState =
+      let
+        hackageState = IndexStateTime $ fromJust $ simpleParsec "2020-05-06T22:33:27Z"
+        indexState' = insertIndexState (RepoName "hackage.haskell.org") hackageState headTotalIndexState
+        headHackageState = IndexStateTime $ fromJust $ simpleParsec "2020-04-29T04:11:05Z"
+        indexState'' = insertIndexState (RepoName "head.hackage") headHackageState headTotalIndexState
+       in
+        toFlag indexState''
+    projectConfigStoreDir = mempty -- cli only
+    getProjectConfigConstraints projectFileFp =
+      let
+        bar = fromRight (error "error parsing bar") $ readUserConstraint "bar == 2.1"
+        barFlags = fromRight (error "error parsing bar flags") $ readUserConstraint "bar +foo -baz"
+        source = ConstraintSourceProjectConfig projectFileFp
+       in
+        [(bar, source), (barFlags, source)]
+    projectConfigPreferences = [PackageVersionConstraint (mkPackageName "foo") (ThisVersion (mkVersion [0, 9])), PackageVersionConstraint (mkPackageName "baz") (LaterVersion (mkVersion [2, 0]))]
+    projectConfigCabalVersion = Flag (mkVersion [1, 24, 0, 1])
+    projectConfigSolver = Flag AlwaysModular
+    projectConfigAllowOlder = Just (AllowOlder $ RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep")), RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkga") (mkVersion [1, 1, 2]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkg"))])
+    projectConfigAllowNewer = Just (AllowNewer $ RelaxDepsSome [RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkgb") (mkVersion [1, 2, 3]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkgb")), RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "importantlib"))])
+    projectConfigWriteGhcEnvironmentFilesPolicy = Flag AlwaysWriteGhcEnvironmentFiles
+    projectConfigMaxBackjumps = toFlag 42
+    projectConfigReorderGoals = Flag (ReorderGoals True)
+    projectConfigCountConflicts = Flag (CountConflicts False)
+    projectConfigFineGrainedConflicts = Flag (FineGrainedConflicts False)
+    projectConfigMinimizeConflictSet = Flag (MinimizeConflictSet True)
+    projectConfigStrongFlags = Flag (StrongFlags True)
+    projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls True)
+    projectConfigOnlyConstrained = mempty -- cli only
+    projectConfigPerComponent = mempty -- cli only
+    projectConfigIndependentGoals = mempty -- cli only
+    projectConfigPreferOldest = Flag (PreferOldest True)
+    projectConfigProgPathExtra = mempty
+    -- TODO ^ I need to investigate this. The project file of this test says the following: extra-prog-path: /foo/bar, /baz/quux
+    -- but the legacy parser always parses an empty list, maybe we have a bug here
+    -- this also does not work if using a single path such as extra-prog-path: /foo/bar, list is always empty
+    projectConfigMultiRepl = toFlag True
+
 readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
 readConfigDefault rootFp = readConfig rootFp "cabal.project"
 
@@ -121,7 +199,7 @@ readConfig rootFp projectFileName = do
       extensionName = ""
       distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
       extensionDescription = "description"
-      distProjectConfigFp = distProjectFile distDirLayout extensionName
+  distProjectConfigFp <- projectConfigPath rootFp projectFileName extensionName
   exists <- doesFileExist distProjectConfigFp
   assertBool ("projectConfig does not exist: " <> distProjectConfigFp) exists
   contents <- BS.readFile distProjectConfigFp
@@ -134,6 +212,14 @@ readConfig rootFp projectFileName = do
       readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription
   return (parsec, legacy)
 
+projectConfigPath :: FilePath -> FilePath -> String -> IO FilePath
+projectConfigPath rootFp projectFileName extensionName = do
+  projectRootDir <- canonicalizePath (basedir </> rootFp)
+  let projectRoot = ProjectRootExplicit projectRootDir projectFileName
+      distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
+      distProjectConfigFp = distProjectFile distDirLayout extensionName
+  return distProjectConfigFp
+
 assertConfig' :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> IO ()
 assertConfig' expected config access = expected @=? actual
   where

cabal-install/tests/IntegrationTests2/ProjectConfig/files/project-config-shared/cabal.project

@@ -0,0 +1,31 @@
+ignore-project: True
+compiler: ghcjs
+with-compiler: /some/path/to/compiler
+with-hc-pkg: /some/path/to/ghc-pkg
+doc-index-file: /path/to/haddock-index
+package-dbs: clear, foo, clear, bar, baz
+active-repositories:
+  , hackage.haskell.org
+  , my-repository:override
+index-state:
+  , hackage.haskell.org 2020-05-06T22:33:27Z
+  , head.hackage 2020-04-29T04:11:05Z
+constraints: bar == 2.1,
+             bar +foo -baz
+preferences: foo == 0.9,
+             baz > 2.0
+cabal-lib-version: 1.24.0.1
+solver: modular
+allow-older: dep, pkga-1.1.2:dep-pkg
+allow-newer: pkgb-1.2.3:dep-pkgb, importantlib
+write-ghc-environment-files: always
+max-backjumps: 42
+reorder-goals: True
+count-conflicts: False
+fine-grained-conflicts: False
+minimize-conflict-set: True
+strong-flags: True
+allow-boot-library-installs: True
+prefer-oldest: True
+extra-prog-path: /foo/bar, /baz/quux
+multi-repl: True