Add testPackages Parsec test

cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs

@@ -5,6 +5,8 @@
 module Distribution.Client.ProjectConfig.Parsec (
   -- * Package configuration
   parseProjectSkeleton,
+  ProjectConfigSkeleton,
+  ProjectConfig (..),
 
   -- ** Parsing
   ParseResult,
@@ -17,7 +19,7 @@ import Distribution.FieldGrammar
 -- TODO #6101 .Legacy -> ProjectConfigSkeleton should probably be moved here
 import Distribution.Client.ProjectConfig.FieldGrammar (projectConfigFieldGrammar)
 import Distribution.Client.ProjectConfig.Legacy (ProjectConfigSkeleton, ProjectConfigImport)
-import Distribution.Client.ProjectConfig.Types (ProjectConfig)
+import Distribution.Client.ProjectConfig.Types (ProjectConfig (..))
 import Distribution.Fields.ConfVar                   (parseConditionConfVar)
 import Distribution.Fields.ParseResult
 -- AST type

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

@@ -13,23 +13,24 @@ import Distribution.Client.HttpUtils
 import Distribution.Client.DistDirLayout
 import Distribution.Client.ProjectConfig
 import Distribution.Client.RebuildMonad (runRebuild)
+import Distribution.Types.CondTree (CondTree (..))
 import Distribution.Verbosity
 
 -- TODO create tests:
 -- - parser tests to read and compare to expected values
 -- - golden tests for warnings and errors
 parserTests :: [TestTree]
 parserTests = [
-  testCase "read with legacy parser" testLegacyRead
+  -- testCase "read with legacy parser" testLegacyRead
+  testCase "read packages" testPackages
   ]
 
 -- Currently I compare the results of legacy parser with the new parser
 -- When the parser is implemented I will migrate it to compare to actual values
 testLegacyRead :: Assertion
 testLegacyRead = do
   httpTransport <- configureTransport verbosity [] Nothing
-  let testdir = "ProjectConfig/files/"
-  projectRootDir <- canonicalizePath (basedir </> testdir)
+  projectRootDir <- canonicalizePath basedir
 
   -- let projectRoot = ProjectRootImplicit projectRootDir
   let projectFileName = "cabal-minimal.project"
@@ -47,6 +48,33 @@ testLegacyRead = do
     readProjectFileSkeleton verbosity httpTransport distDirLayout extensionName extensionDescription
   projectConfigSkeleton @?= projectConfigSkeletonLegacy
 
+testPackages :: Assertion
+testPackages = do
+  let expected = [".", "packages/packages.cabal"] -- TODO https link, what does legacy parse?
+  config <- readConfig "packages" "packages.project"
+  assertConfig expected config (projectPackages . condTreeData)
+
+readConfig :: FilePath -> FilePath -> IO ProjectConfigSkeleton
+readConfig rootFp projectFileName = do
+  -- TODO extract argument so it can be mocked
+  httpTransport <- configureTransport verbosity [] Nothing
+  projectRootDir <- canonicalizePath (basedir </> rootFp)
+
+  let projectRoot = ProjectRootExplicit projectRootDir projectFileName
+      extensionName = ""
+      distDirLayout = defaultDistDirLayout projectRoot Nothing
+      extensionDescription = "description"
+      distProjectConfigFp = distProjectFile distDirLayout extensionName
+  exists <- doesFileExist distProjectConfigFp
+  assertBool ("projectConfig does not exist: " <> distProjectConfigFp) exists
+  runRebuild projectRootDir $
+    readProjectFileSkeleton verbosity httpTransport distDirLayout extensionName extensionDescription
+
+assertConfig :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> IO ()
+assertConfig expected config access = expected @=? actual
+  where
+    actual = access config
+
 -- | Test Utilities
 emptyProjectConfig :: ProjectConfig
 emptyProjectConfig = mempty
@@ -55,4 +83,4 @@ verbosity :: Verbosity
 verbosity = minBound --normal --verbose --maxBound --minBound
 
 basedir :: FilePath
-basedir = "tests" </> "IntegrationTests2"
+basedir = "tests" </> "IntegrationTests2" </> "ProjectConfig" </> "files"