Skip to content

Commit 9e0127d

Browse files
committed
Add projectConfigShared test
1 parent 5fd1d67 commit 9e0127d

File tree

2 files changed

+119
-2
lines changed

2 files changed

+119
-2
lines changed

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

Lines changed: 88 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,16 +5,29 @@ module IntegrationTests2.ProjectConfig.ParsecTests (parserTests) where
55

66
import qualified Data.ByteString as BS
77
import Data.Either
8-
import Distribution.Client.BuildReports.Types
8+
import Data.Maybe
9+
import Distribution.Client.Dependency.Types (PreSolver (..))
910
import Distribution.Client.DistDirLayout
1011
import Distribution.Client.HttpUtils
12+
import Distribution.Client.IndexUtils.ActiveRepos (ActiveRepoEntry (..), ActiveRepos (..), CombineStrategy (..))
13+
import Distribution.Client.IndexUtils.IndexState (RepoIndexState (..), headTotalIndexState, insertIndexState)
1114
import Distribution.Client.ProjectConfig
1215
import Distribution.Client.ProjectConfig.Parsec
1316
import Distribution.Client.RebuildMonad (runRebuild)
17+
import Distribution.Client.Targets (readUserConstraint)
18+
import Distribution.Client.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDepMod (..), RelaxDepScope (..), RelaxDepSubject (..), RelaxDeps (..), RelaxedDep (..))
19+
import Distribution.Client.Types.RepoName (RepoName (..))
1420
import Distribution.Client.Types.SourceRepo
21+
import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy (..))
22+
import Distribution.Compiler (CompilerFlavor (..))
23+
import Distribution.Parsec (simpleParsec)
24+
import Distribution.Simple.Compiler (PackageDB (..))
1525
import Distribution.Simple.Flag
1626
import Distribution.Simple.InstallDirs (toPathTemplate)
27+
import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
28+
import Distribution.Solver.Types.Settings (AllowBootLibInstalls (..), CountConflicts (..), FineGrainedConflicts (..), MinimizeConflictSet (..), PreferOldest (..), ReorderGoals (..), StrongFlags (..))
1729
import Distribution.Types.CondTree (CondTree (..))
30+
import Distribution.Types.PackageId (PackageIdentifier (..))
1831
import Distribution.Types.PackageName
1932
import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
2033
import Distribution.Types.SourceRepo (KnownRepoType (..), RepoType (..))
@@ -37,6 +50,7 @@ parserTests =
3750
, testCase "read extra-packages" testExtraPackages
3851
, testCase "read source-repository-package" testSourceRepoList
3952
, testCase "read project-config-build-only" testProjectConfigBuildOnly
53+
, testCase "read project-shared" testProjectConfigShared
4054
]
4155

4256
testPackages :: Assertion
@@ -110,6 +124,70 @@ testProjectConfigBuildOnly = do
110124
projectConfigLogsDir = toFlag "logs-directory"
111125
projectConfigClientInstallFlags = mempty -- cli only
112126

127+
testProjectConfigShared :: Assertion
128+
testProjectConfigShared = do
129+
let rootFp = "project-config-shared"
130+
projectFileFp <- projectConfigPath rootFp "cabal.project" ""
131+
let
132+
projectConfigConstraints = getProjectConfigConstraints projectFileFp
133+
expected = ProjectConfigShared{..}
134+
(config, legacy) <- readConfigDefault rootFp
135+
print (projectConfigShared $ condTreeData legacy)
136+
assertConfig expected config legacy (projectConfigShared . condTreeData)
137+
where
138+
projectConfigDistDir = mempty -- cli only
139+
projectConfigConfigFile = mempty -- cli only
140+
projectConfigProjectDir = mempty -- cli only
141+
projectConfigProjectFile = mempty -- cli only
142+
projectConfigIgnoreProject = toFlag True
143+
projectConfigHcFlavor = toFlag GHCJS
144+
projectConfigHcPath = toFlag "/some/path/to/compiler"
145+
projectConfigHcPkg = toFlag "/some/path/to/ghc-pkg"
146+
projectConfigHaddockIndex = toFlag $ toPathTemplate "/path/to/haddock-index"
147+
projectConfigInstallDirs = mempty -- cli only
148+
projectConfigPackageDBs = [Nothing, Just (SpecificPackageDB "foo"), Nothing, Just (SpecificPackageDB "bar"), Just (SpecificPackageDB "baz")]
149+
projectConfigRemoteRepos = mempty -- cli only
150+
projectConfigLocalNoIndexRepos = mempty -- cli only
151+
projectConfigActiveRepos = Flag (ActiveRepos [ActiveRepo (RepoName "hackage.haskell.org") CombineStrategyMerge, ActiveRepo (RepoName "my-repository") CombineStrategyOverride])
152+
projectConfigIndexState =
153+
let
154+
hackageState = IndexStateTime $ fromJust $ simpleParsec "2020-05-06T22:33:27Z"
155+
indexState' = insertIndexState (RepoName "hackage.haskell.org") hackageState headTotalIndexState
156+
headHackageState = IndexStateTime $ fromJust $ simpleParsec "2020-04-29T04:11:05Z"
157+
indexState'' = insertIndexState (RepoName "head.hackage") headHackageState headTotalIndexState
158+
in
159+
toFlag indexState''
160+
projectConfigStoreDir = mempty -- cli only
161+
getProjectConfigConstraints projectFileFp =
162+
let
163+
bar = fromRight (error "error parsing bar") $ readUserConstraint "bar == 2.1"
164+
barFlags = fromRight (error "error parsing bar flags") $ readUserConstraint "bar +foo -baz"
165+
source = ConstraintSourceProjectConfig projectFileFp
166+
in
167+
[(bar, source), (barFlags, source)]
168+
projectConfigPreferences = [PackageVersionConstraint (mkPackageName "foo") (ThisVersion (mkVersion [0, 9])), PackageVersionConstraint (mkPackageName "baz") (LaterVersion (mkVersion [2, 0]))]
169+
projectConfigCabalVersion = Flag (mkVersion [1, 24, 0, 1])
170+
projectConfigSolver = Flag AlwaysModular
171+
projectConfigAllowOlder = Just (AllowOlder $ RelaxDepsSome [RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep")), RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkga") (mkVersion [1, 1, 2]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkg"))])
172+
projectConfigAllowNewer = Just (AllowNewer $ RelaxDepsSome [RelaxedDep (RelaxDepScopePackageId (PackageIdentifier (mkPackageName "pkgb") (mkVersion [1, 2, 3]))) RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "dep-pkgb")), RelaxedDep RelaxDepScopeAll RelaxDepModNone (RelaxDepSubjectPkg (mkPackageName "importantlib"))])
173+
projectConfigWriteGhcEnvironmentFilesPolicy = Flag AlwaysWriteGhcEnvironmentFiles
174+
projectConfigMaxBackjumps = toFlag 42
175+
projectConfigReorderGoals = Flag (ReorderGoals True)
176+
projectConfigCountConflicts = Flag (CountConflicts False)
177+
projectConfigFineGrainedConflicts = Flag (FineGrainedConflicts False)
178+
projectConfigMinimizeConflictSet = Flag (MinimizeConflictSet True)
179+
projectConfigStrongFlags = Flag (StrongFlags True)
180+
projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls True)
181+
projectConfigOnlyConstrained = mempty -- cli only
182+
projectConfigPerComponent = mempty -- cli only
183+
projectConfigIndependentGoals = mempty -- cli only
184+
projectConfigPreferOldest = Flag (PreferOldest True)
185+
projectConfigProgPathExtra = mempty
186+
-- TODO ^ I need to investigate this. The config says the following: extra-prog-path: /foo/bar, /baz/quux
187+
-- but the legacy parser always parses an empty list, maybe we have a bug here
188+
-- this also does not work if using a single path such as extra-prog-path: /foo/bar, list is always empty
189+
projectConfigMultiRepl = toFlag True
190+
113191
readConfigDefault :: FilePath -> IO (ProjectConfigSkeleton, ProjectConfigSkeleton)
114192
readConfigDefault rootFp = readConfig rootFp "cabal.project"
115193

@@ -121,7 +199,7 @@ readConfig rootFp projectFileName = do
121199
extensionName = ""
122200
distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
123201
extensionDescription = "description"
124-
distProjectConfigFp = distProjectFile distDirLayout extensionName
202+
distProjectConfigFp <- projectConfigPath rootFp projectFileName extensionName
125203
exists <- doesFileExist distProjectConfigFp
126204
assertBool ("projectConfig does not exist: " <> distProjectConfigFp) exists
127205
contents <- BS.readFile distProjectConfigFp
@@ -134,6 +212,14 @@ readConfig rootFp projectFileName = do
134212
readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription
135213
return (parsec, legacy)
136214

215+
projectConfigPath :: FilePath -> FilePath -> String -> IO FilePath
216+
projectConfigPath rootFp projectFileName extensionName = do
217+
projectRootDir <- canonicalizePath (basedir </> rootFp)
218+
let projectRoot = ProjectRootExplicit projectRootDir projectFileName
219+
distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing
220+
distProjectConfigFp = distProjectFile distDirLayout extensionName
221+
return distProjectConfigFp
222+
137223
assertConfig' :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> IO ()
138224
assertConfig' expected config access = expected @=? actual
139225
where
Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
ignore-project: True
2+
compiler: ghcjs
3+
with-compiler: /some/path/to/compiler
4+
with-hc-pkg: /some/path/to/ghc-pkg
5+
doc-index-file: /path/to/haddock-index
6+
package-dbs: clear, foo, clear, bar, baz
7+
active-repositories:
8+
, hackage.haskell.org
9+
, my-repository:override
10+
index-state:
11+
, hackage.haskell.org 2020-05-06T22:33:27Z
12+
, head.hackage 2020-04-29T04:11:05Z
13+
constraints: bar == 2.1,
14+
bar +foo -baz
15+
preferences: foo == 0.9,
16+
baz > 2.0
17+
cabal-lib-version: 1.24.0.1
18+
solver: modular
19+
allow-older: dep, pkga-1.1.2:dep-pkg
20+
allow-newer: pkgb-1.2.3:dep-pkgb, importantlib
21+
write-ghc-environment-files: always
22+
max-backjumps: 42
23+
reorder-goals: True
24+
count-conflicts: False
25+
fine-grained-conflicts: False
26+
minimize-conflict-set: True
27+
strong-flags: True
28+
allow-boot-library-installs: True
29+
prefer-oldest: True
30+
extra-prog-path: /foo/bar, /baz/quux
31+
multi-repl: True

0 commit comments

Comments
 (0)