diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs index 1b10f0227a1..cebf2993ea2 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs @@ -7,7 +7,7 @@ import Distribution.Client.IndexUtils.ActiveRepos ( ActiveRepos ) import Distribution.Client.IndexUtils.IndexState (TotalIndexState) -import Distribution.Client.ProjectConfig.Types (MapMappend, PackageConfig, ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance, ProjectConfigShared) +import Distribution.Client.ProjectConfig.Types (MapLast, MapMappend, PackageConfig, ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance, ProjectConfigShared) import qualified Distribution.Client.ProjectConfig.Types as T import Distribution.Client.Targets (UserConstraint) import Distribution.Client.Types.AllowNewer (AllowNewer, AllowOlder) @@ -304,6 +304,14 @@ projectConfigMultiRepl :: Lens' ProjectConfigShared (Flag Bool) projectConfigMultiRepl f s = fmap (\x -> s{T.projectConfigMultiRepl = x}) (f (T.projectConfigMultiRepl s)) {-# INLINEABLE projectConfigMultiRepl #-} +packageConfigProgramPaths :: Lens' PackageConfig (MapLast String FilePath) +packageConfigProgramPaths f s = fmap (\x -> s{T.packageConfigProgramPaths = x}) (f (T.packageConfigProgramPaths s)) +{-# INLINEABLE packageConfigProgramPaths #-} + +packageConfigProgramArgs :: Lens' PackageConfig (MapMappend String [String]) +packageConfigProgramArgs f s = fmap (\x -> s{T.packageConfigProgramArgs = x}) (f (T.packageConfigProgramArgs s)) +{-# INLINEABLE packageConfigProgramArgs #-} + packageConfigProgramPathExtra :: Lens' PackageConfig (NubList FilePath) packageConfigProgramPathExtra f s = fmap (\x -> s{T.packageConfigProgramPathExtra = x}) (f (T.packageConfigProgramPathExtra s)) {-# INLINEABLE packageConfigProgramPathExtra #-} diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs index 13dae49231c..7cfe70e79ee 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Parsec.hs @@ -247,17 +247,17 @@ parseSection programDb (MkSection (Name pos name) args secFields) verifyNullSubsections verifyNullSectionArgs srp <- lift $ parseFieldGrammar cabalSpec fields sourceRepositoryPackageGrammar - stateConfig . L.projectPackagesRepo %= (++ [srp]) + stateConfig . L.projectPackagesRepo %= (<> [srp]) | name == "program-options" = do verifyNullSubsections verifyNullSectionArgs - opts <- lift $ parseProgramArgs Warn programDb fields - stateConfig . L.projectConfigLocalPackages %= (\cfg -> cfg{packageConfigProgramArgs = (opts <> packageConfigProgramArgs cfg)}) + opts' <- lift $ parseProgramArgs Warn programDb fields + stateConfig . L.projectConfigLocalPackages . L.packageConfigProgramArgs %= (opts' <>) | name == "program-locations" = do verifyNullSubsections verifyNullSectionArgs - paths <- lift $ parseProgramPaths Warn programDb fields - stateConfig . L.projectConfigLocalPackages %= (\cfg -> cfg{packageConfigProgramPaths = (paths <> packageConfigProgramPaths cfg)}) + paths' <- lift $ parseProgramPaths Warn programDb fields + stateConfig . L.projectConfigLocalPackages . L.packageConfigProgramPaths %= (paths' <>) | name == "repository" = do verifyNullSubsections mRepoName <- lift $ parseRepoName pos args @@ -266,8 +266,8 @@ parseSection programDb (MkSection (Name pos name) args secFields) remoteRepo <- lift $ parseFieldGrammar cabalSpec fields (remoteRepoGrammar repoName) remoteOrLocalRepo <- lift $ postProcessRemoteRepo pos remoteRepo case remoteOrLocalRepo of - Left local -> stateConfig . L.projectConfigShared %= (\pcs -> pcs{projectConfigLocalNoIndexRepos = (projectConfigLocalNoIndexRepos pcs <> toNubList [local])}) - Right remote -> stateConfig . L.projectConfigShared %= (\pcs -> pcs{projectConfigRemoteRepos = (projectConfigRemoteRepos pcs <> toNubList [remote])}) + Left local -> stateConfig . L.projectConfigShared . L.projectConfigLocalNoIndexRepos %= (<> toNubList [local]) + Right remote -> stateConfig . L.projectConfigShared . L.projectConfigRemoteRepos %= (<> toNubList [remote]) Nothing -> lift $ parseFailure pos "a 'repository' section requires the repository name as an argument" | name == "package" = do verifyNullSubsections @@ -275,10 +275,10 @@ parseSection programDb (MkSection (Name pos name) args secFields) case package of Just AllPackages -> do packageCfg' <- parsePackageConfig - stateConfig . L.projectConfigAllPackages %= (\packageCfg -> packageCfg' <> packageCfg) + stateConfig . L.projectConfigAllPackages %= (packageCfg' <>) Just (SpecificPackage packageName) -> do packageCfg <- parsePackageConfig - stateConfig . L.projectConfigSpecificPackage %= (\spcs -> spcs <> MapMappend (Map.singleton packageName packageCfg)) + stateConfig . L.projectConfigSpecificPackage %= (<> MapMappend (Map.singleton packageName packageCfg)) Nothing -> do lift $ parseWarning pos PWTUnknownSection "target package name or * required" return ()