From 0adc71d89cfbebd23495189a9a969a62ba50e16f Mon Sep 17 00:00:00 2001 From: jgotoh <18658140+jgotoh@users.noreply.github.com> Date: Fri, 31 May 2024 14:09:50 +0200 Subject: [PATCH] Add parsing of ClientInstallFlags --- .../Client/CmdInstall/ClientInstallFlags.hs | 45 +++++++++++++++++++ .../Client/ProjectConfig/FieldGrammar.hs | 3 +- .../Distribution/Client/ProjectConfig/Lens.hs | 5 +++ .../ProjectConfig/Parsec/cabal.test.hs | 12 ++++- .../project-config-build-only/cabal.project | 7 +++ 5 files changed, 70 insertions(+), 2 deletions(-) diff --git a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs index d5bbd5309f7..b7f12466b7b 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall/ClientInstallFlags.hs @@ -1,14 +1,18 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Distribution.Client.CmdInstall.ClientInstallFlags ( InstallMethod (..) , ClientInstallFlags (..) , defaultClientInstallFlags , clientInstallOptions + , clientInstallFlagsGrammar ) where import Distribution.Client.Compat.Prelude +import Distribution.Compat.Lens (Lens') +import Distribution.FieldGrammar import Prelude () import Distribution.ReadE @@ -34,6 +38,7 @@ import Distribution.Client.Types.InstallMethod import Distribution.Client.Types.OverwritePolicy ( OverwritePolicy (..) ) +import Distribution.Client.Utils.Parsec import qualified Distribution.Compat.CharParsing as P @@ -113,6 +118,26 @@ clientInstallOptions _ = $ reqArg "DIR" (succeedReadE Flag) flagToList ] +clientInstallFlagsGrammar + :: ( FieldGrammar c g + , Applicative (g ClientInstallFlags) + , c (Identity (Flag Bool)) + , c ((Flag' FilePathNT FilePath)) + , c (Identity (Flag OverwritePolicy)) + , c (Identity (Flag InstallMethod)) + ) + => g ClientInstallFlags ClientInstallFlags +clientInstallFlagsGrammar = + ClientInstallFlags + <$> optionalFieldDef "lib" cinstInstallLibsLens mempty + <*> ( optionalFieldDefAla "package-env" (alaFlag FilePathNT) cinstEnvironmentPathLens mempty + <* optionalFieldDefAla "env" (alaFlag FilePathNT) cinstEnvironmentPathLens mempty + ) + <*> optionalFieldDef "overwrite-policy" cinstOverwritePolicyLens mempty + <*> optionalFieldDef "install-method" cinstInstallMethodLens mempty + <*> optionalFieldDefAla "installdir" (alaFlag FilePathNT) cinstInstalldirLens mempty +{-# SPECIALIZE clientInstallFlagsGrammar :: ParsecFieldGrammar' ClientInstallFlags #-} + parsecInstallMethod :: CabalParsing m => m InstallMethod parsecInstallMethod = do name <- P.munch1 isAlpha @@ -120,3 +145,23 @@ parsecInstallMethod = do "copy" -> pure InstallMethodCopy "symlink" -> pure InstallMethodSymlink _ -> P.unexpected $ "InstallMethod: " ++ name + +cinstInstallLibsLens :: Lens' ClientInstallFlags (Flag Bool) +cinstInstallLibsLens f c = fmap (\x -> c{cinstInstallLibs = x}) (f (cinstInstallLibs c)) +{-# INLINEABLE cinstInstallLibsLens #-} + +cinstEnvironmentPathLens :: Lens' ClientInstallFlags (Flag FilePath) +cinstEnvironmentPathLens f c = fmap (\x -> c{cinstEnvironmentPath = x}) (f (cinstEnvironmentPath c)) +{-# INLINEABLE cinstEnvironmentPathLens #-} + +cinstOverwritePolicyLens :: Lens' ClientInstallFlags (Flag OverwritePolicy) +cinstOverwritePolicyLens f c = fmap (\x -> c{cinstOverwritePolicy = x}) (f (cinstOverwritePolicy c)) +{-# INLINEABLE cinstOverwritePolicyLens #-} + +cinstInstallMethodLens :: Lens' ClientInstallFlags (Flag InstallMethod) +cinstInstallMethodLens f c = fmap (\x -> c{cinstInstallMethod = x}) (f (cinstInstallMethod c)) +{-# INLINEABLE cinstInstallMethodLens #-} + +cinstInstalldirLens :: Lens' ClientInstallFlags (Flag FilePath) +cinstInstalldirLens f c = fmap (\x -> c{cinstInstalldir = x}) (f (cinstInstalldir c)) +{-# INLINEABLE cinstInstalldirLens #-} diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs index ceec2a0452f..729a41e43f6 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs @@ -9,6 +9,7 @@ module Distribution.Client.ProjectConfig.FieldGrammar import qualified Data.ByteString.Char8 as BS import qualified Data.Set as Set import Distribution.CabalSpecVersion (CabalSpecVersion (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (clientInstallFlagsGrammar) import qualified Distribution.Client.ProjectConfig.Lens as L import Distribution.Client.ProjectConfig.Types (PackageConfig (..), ProjectConfig (..), ProjectConfigBuildOnly (..), ProjectConfigProvenance (..), ProjectConfigShared (..)) import Distribution.Client.Utils.Parsec @@ -62,7 +63,7 @@ projectConfigBuildOnlyFieldGrammar = <*> optionalFieldDef "ignore-expiry" L.projectConfigIgnoreExpiry mempty <*> optionalFieldDefAla "remote-repo-cache" (alaFlag FilePathNT) L.projectConfigCacheDir mempty <*> optionalFieldDefAla "logs-dir" (alaFlag FilePathNT) L.projectConfigLogsDir mempty - <*> pure mempty -- cli flag: projectConfigClientInstallFlags + <*> blurFieldGrammar L.projectConfigClientInstallFlags clientInstallFlagsGrammar projectConfigSharedFieldGrammar :: ProjectConfigPath -> ParsecFieldGrammar' ProjectConfigShared projectConfigSharedFieldGrammar source = diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs index b43eed7d163..4edfd3dc677 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs @@ -1,6 +1,7 @@ module Distribution.Client.ProjectConfig.Lens where import Distribution.Client.BuildReports.Types (ReportLevel (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (..)) import Distribution.Client.Dependency.Types (PreSolver (..)) import Distribution.Client.IndexUtils.ActiveRepos ( ActiveRepos @@ -157,6 +158,10 @@ projectConfigLogsDir :: Lens' ProjectConfigBuildOnly (Flag FilePath) projectConfigLogsDir f s = fmap (\x -> s{T.projectConfigLogsDir = x}) (f (T.projectConfigLogsDir s)) {-# INLINEABLE projectConfigLogsDir #-} +projectConfigClientInstallFlags :: Lens' ProjectConfigBuildOnly (ClientInstallFlags) +projectConfigClientInstallFlags f s = fmap (\x -> s{T.projectConfigClientInstallFlags = x}) (f (T.projectConfigClientInstallFlags s)) +{-# INLINEABLE projectConfigClientInstallFlags #-} + projectConfigDistDir :: Lens' ProjectConfigShared (Flag FilePath) projectConfigDistDir f s = fmap (\x -> s{T.projectConfigDistDir = x}) (f (T.projectConfigDistDir s)) {-# INLINEABLE projectConfigDistDir #-} diff --git a/cabal-testsuite/PackageTests/ProjectConfig/Parsec/cabal.test.hs b/cabal-testsuite/PackageTests/ProjectConfig/Parsec/cabal.test.hs index 385b8ef51f1..cb5bf5d7acd 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/Parsec/cabal.test.hs +++ b/cabal-testsuite/PackageTests/ProjectConfig/Parsec/cabal.test.hs @@ -8,6 +8,7 @@ import qualified Data.Map as Map import Data.Maybe import qualified Data.Set as Set import Distribution.Client.BuildReports.Types (ReportLevel (..)) +import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (..)) import Distribution.Client.Dependency.Types (PreSolver (..)) import Distribution.Client.DistDirLayout import Distribution.Client.HttpUtils @@ -18,6 +19,8 @@ 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.InstallMethod (InstallMethod (..)) +import Distribution.Client.Types.OverwritePolicy (OverwritePolicy (..)) import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.Client.Types.SourceRepo import Distribution.Client.Types.WriteGhcEnvironmentFilesPolicy (WriteGhcEnvironmentFilesPolicy (..)) @@ -142,7 +145,14 @@ testProjectConfigBuildOnly = do projectConfigIgnoreExpiry = toFlag True projectConfigCacheDir = toFlag "some-cache-dir" projectConfigLogsDir = toFlag "logs-directory" - projectConfigClientInstallFlags = mempty -- cli only + projectConfigClientInstallFlags = + ClientInstallFlags + { cinstInstallLibs = Flag True + , cinstEnvironmentPath = Flag "path/to/env" + , cinstOverwritePolicy = Flag AlwaysOverwrite + , cinstInstallMethod = Flag InstallMethodSymlink + , cinstInstalldir = Flag "path/to/installdir" + } testProjectConfigShared :: TestM () testProjectConfigShared = do diff --git a/cabal-testsuite/PackageTests/ProjectConfig/Parsec/tests/project-config-build-only/cabal.project b/cabal-testsuite/PackageTests/ProjectConfig/Parsec/tests/project-config-build-only/cabal.project index 7502a29b796..eac06d8aadd 100644 --- a/cabal-testsuite/PackageTests/ProjectConfig/Parsec/tests/project-config-build-only/cabal.project +++ b/cabal-testsuite/PackageTests/ProjectConfig/Parsec/tests/project-config-build-only/cabal.project @@ -13,3 +13,10 @@ http-transport: wget ignore-expiry: True remote-repo-cache: some-cache-dir logs-dir: logs-directory + +-- clientInstallFlags +lib: True +package-env: path/to/env +overwrite-policy: always +install-method: symlink +installdir: path/to/installdir