Skip to content

Commit 05b8dfa

Browse files
phadejphadej
authored
Merge pull request #6734 from phadej/add-project-flags
Add ProjectFlags, use in sdist
2 parents 1a6dbcf + 78da242 commit 05b8dfa

File tree

7 files changed

+94
-43
lines changed

7 files changed

+94
-43
lines changed

‎Cabal/Distribution/Simple/Command.hs

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -56,7 +56,7 @@ module Distribution.Simple.Command (
5656
option, multiOption,
5757

5858
-- ** Liftings & Projections
59-
liftOption,
59+
liftOption, liftOptionL,
6060

6161
-- * Option Descriptions
6262
OptDescr(..), Description, SFlags, LFlags, OptFlags, ArgPlaceHolder,
@@ -74,6 +74,7 @@ import Distribution.Compat.Prelude hiding (get)
7474
import qualified Distribution.GetOpt as GetOpt
7575
import Distribution.ReadE
7676
import Distribution.Simple.Utils
77+
import Distribution.Compat.Lens (ALens', (^#), (#~))
7778

7879

7980
data CommandUI flags = CommandUI {
@@ -251,6 +252,10 @@ liftOption :: (b -> a) -> (a -> (b -> b)) -> OptionField a -> OptionField b
251252
liftOption get' set' opt =
252253
opt { optionDescr = liftOptDescr get' set' `map` optionDescr opt}
253254

255+
-- | @since 3.4.0.0
256+
liftOptionL :: ALens' b a -> OptionField a -> OptionField b
257+
liftOptionL l = liftOption (^# l) (l #~)
258+
254259

255260
liftOptDescr :: (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b
256261
liftOptDescr get' set' (ChoiceOpt opts) =

‎cabal-install/Distribution/Client/CmdSdist.hs

Lines changed: 47 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,6 @@
66
{-# LANGUAGE ViewPatterns #-}
77
module Distribution.Client.CmdSdist
88
( sdistCommand, sdistAction, packageToSdist
9-
, SdistFlags(..), defaultSdistFlags
109
, OutputFormat(..)) where
1110

1211
import Prelude ()
@@ -20,7 +19,7 @@ import Distribution.Client.TargetSelector
2019
( TargetSelector(..), ComponentKind
2120
, readTargetSelectors, reportTargetSelectorProblems )
2221
import Distribution.Client.Setup
23-
( GlobalFlags(..) )
22+
( GlobalFlags(..), InstallFlags (installProjectFileName) )
2423
import Distribution.Solver.Types.SourcePackage
2524
( SourcePackage(..) )
2625
import Distribution.Client.Types
@@ -29,7 +28,11 @@ import Distribution.Client.DistDirLayout
2928
( DistDirLayout(..), ProjectRoot (..) )
3029
import Distribution.Client.ProjectConfig
3130
( ProjectConfig, withProjectOrGlobalConfigIgn, commandLineFlagsToProjectConfig, projectConfigConfigFile, projectConfigShared )
31+
import Distribution.Client.ProjectFlags
32+
( ProjectFlags (..), defaultProjectFlags, projectFlagsOptions )
3233

34+
import Distribution.Compat.Lens
35+
( _1, _2 )
3336
import Distribution.Package
3437
( Package(packageId) )
3538
import Distribution.PackageDescription.Configuration
@@ -39,7 +42,7 @@ import Distribution.Pretty
3942
import Distribution.ReadE
4043
( succeedReadE )
4144
import Distribution.Simple.Command
42-
( CommandUI(..), option, reqArg )
45+
( CommandUI(..), OptionField, option, reqArg, liftOptionL, ShowOrParseArgs )
4346
import Distribution.Simple.PreProcess
4447
( knownSuffixHandlers )
4548
import Distribution.Simple.Setup
@@ -78,7 +81,11 @@ import System.Directory
7881
import System.FilePath
7982
( (</>), (<.>), makeRelative, normalise, takeDirectory )
8083

81-
sdistCommand :: CommandUI SdistFlags
84+
-------------------------------------------------------------------------------
85+
-- Command
86+
-------------------------------------------------------------------------------
87+
88+
sdistCommand :: CommandUI (ProjectFlags, SdistFlags)
8289
sdistCommand = CommandUI
8390
{ commandName = "v2-sdist"
8491
, commandSynopsis = "Generate a source distribution file (.tar.gz)."
@@ -87,41 +94,19 @@ sdistCommand = CommandUI
8794
, commandDescription = Just $ \_ -> wrapText
8895
"Generates tarballs of project packages suitable for upload to Hackage."
8996
, commandNotes = Nothing
90-
, commandDefaultFlags = defaultSdistFlags
97+
, commandDefaultFlags = (defaultProjectFlags, defaultSdistFlags)
9198
, commandOptions = \showOrParseArgs ->
92-
[ optionVerbosity
93-
sdistVerbosity (\v flags -> flags { sdistVerbosity = v })
94-
, optionDistPref
95-
sdistDistDir (\dd flags -> flags { sdistDistDir = dd })
96-
showOrParseArgs
97-
, option [] ["project-file"]
98-
"Set the name of the cabal.project file to search for in parent directories"
99-
sdistProjectFile (\pf flags -> flags { sdistProjectFile = pf })
100-
(reqArg "FILE" (succeedReadE Flag) flagToList)
101-
, option ['z'] ["ignore-project"]
102-
"Ignore local project configuration"
103-
sdistIgnoreProject (\v flags -> flags { sdistIgnoreProject = v })
104-
trueArg
105-
, option ['l'] ["list-only"]
106-
"Just list the sources, do not make a tarball"
107-
sdistListSources (\v flags -> flags { sdistListSources = v })
108-
trueArg
109-
, option [] ["null-sep"]
110-
"Separate the source files with NUL bytes rather than newlines."
111-
sdistNulSeparated (\v flags -> flags { sdistNulSeparated = v })
112-
trueArg
113-
, option ['o'] ["output-directory", "outputdir"]
114-
"Choose the output directory of this command. '-' sends all output to stdout"
115-
sdistOutputPath (\o flags -> flags { sdistOutputPath = o })
116-
(reqArg "PATH" (succeedReadE Flag) flagToList)
117-
]
99+
map (liftOptionL _1) projectFlagsOptions ++
100+
map (liftOptionL _2) (sdistOptions showOrParseArgs)
118101
}
119102

103+
-------------------------------------------------------------------------------
104+
-- Flags
105+
-------------------------------------------------------------------------------
106+
120107
data SdistFlags = SdistFlags
121108
{ sdistVerbosity :: Flag Verbosity
122109
, sdistDistDir :: Flag FilePath
123-
, sdistProjectFile :: Flag FilePath
124-
, sdistIgnoreProject :: Flag Bool
125110
, sdistListSources :: Flag Bool
126111
, sdistNulSeparated :: Flag Bool
127112
, sdistOutputPath :: Flag FilePath
@@ -131,17 +116,38 @@ defaultSdistFlags :: SdistFlags
131116
defaultSdistFlags = SdistFlags
132117
{ sdistVerbosity = toFlag normal
133118
, sdistDistDir = mempty
134-
, sdistProjectFile = mempty
135-
, sdistIgnoreProject = toFlag False
136119
, sdistListSources = toFlag False
137120
, sdistNulSeparated = toFlag False
138121
, sdistOutputPath = mempty
139122
}
140123

141-
--
142-
143-
sdistAction :: SdistFlags -> [String] -> GlobalFlags -> IO ()
144-
sdistAction SdistFlags{..} targetStrings globalFlags = do
124+
sdistOptions :: ShowOrParseArgs -> [OptionField SdistFlags]
125+
sdistOptions showOrParseArgs =
126+
[ optionVerbosity
127+
sdistVerbosity (\v flags -> flags { sdistVerbosity = v })
128+
, optionDistPref
129+
sdistDistDir (\dd flags -> flags { sdistDistDir = dd })
130+
showOrParseArgs
131+
, option ['l'] ["list-only"]
132+
"Just list the sources, do not make a tarball"
133+
sdistListSources (\v flags -> flags { sdistListSources = v })
134+
trueArg
135+
, option [] ["null-sep"]
136+
"Separate the source files with NUL bytes rather than newlines."
137+
sdistNulSeparated (\v flags -> flags { sdistNulSeparated = v })
138+
trueArg
139+
, option ['o'] ["output-directory", "outputdir"]
140+
"Choose the output directory of this command. '-' sends all output to stdout"
141+
sdistOutputPath (\o flags -> flags { sdistOutputPath = o })
142+
(reqArg "PATH" (succeedReadE Flag) flagToList)
143+
]
144+
145+
-------------------------------------------------------------------------------
146+
-- Action
147+
-------------------------------------------------------------------------------
148+
149+
sdistAction :: (ProjectFlags, SdistFlags) -> [String] -> GlobalFlags -> IO ()
150+
sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
145151
(baseCtx, distDirLayout) <- withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag withProject withoutProject
146152

147153
let localPkgs = localPackages baseCtx
@@ -191,14 +197,14 @@ sdistAction SdistFlags{..} targetStrings globalFlags = do
191197
listSources = fromFlagOrDefault False sdistListSources
192198
nulSeparated = fromFlagOrDefault False sdistNulSeparated
193199
mOutputPath = flagToMaybe sdistOutputPath
194-
ignoreProject = fromFlagOrDefault False sdistIgnoreProject
200+
ignoreProject = fromFlagOrDefault False flagIgnoreProject
195201

196202
prjConfig :: ProjectConfig
197203
prjConfig = commandLineFlagsToProjectConfig
198204
globalFlags
199205
mempty { configVerbosity = sdistVerbosity, configDistPref = sdistDistDir }
200206
mempty
201-
mempty
207+
mempty { installProjectFileName = flagProjectFileName }
202208
mempty
203209
mempty
204210
mempty

‎cabal-install/Distribution/Client/ProjectConfig/Types.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,7 @@ data ProjectConfigShared
163163
projectConfigDistDir :: Flag FilePath,
164164
projectConfigConfigFile :: Flag FilePath,
165165
projectConfigProjectFile :: Flag FilePath,
166+
-- projectConfigIgnoreProjectFile :: Flag Bool, -- TODO
166167
projectConfigHcFlavor :: Flag CompilerFlavor,
167168
projectConfigHcPath :: Flag FilePath,
168169
projectConfigHcPkg :: Flag FilePath,

‎cabal-install/Distribution/Client/ProjectFlags.hs

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
{-# LANGUAGE MultiWayIf #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module Distribution.Client.ProjectFlags (
4+
ProjectFlags(..),
5+
defaultProjectFlags,
6+
projectFlagsOptions,
7+
) where
8+
9+
import Distribution.Client.Compat.Prelude
10+
import Prelude ()
11+
12+
import Distribution.ReadE (succeedReadE)
13+
import Distribution.Simple.Command (OptionField, option, reqArg)
14+
import Distribution.Simple.Setup (Flag (..), toFlag, trueArg, flagToList)
15+
16+
data ProjectFlags = ProjectFlags
17+
{ flagProjectFileName :: Flag FilePath
18+
, flagIgnoreProject :: Flag Bool
19+
}
20+
21+
defaultProjectFlags :: ProjectFlags
22+
defaultProjectFlags = ProjectFlags
23+
{ flagProjectFileName = mempty
24+
, flagIgnoreProject = toFlag False
25+
}
26+
27+
projectFlagsOptions :: [OptionField ProjectFlags]
28+
projectFlagsOptions =
29+
[ option [] ["project-file"]
30+
"Set the name of the cabal.project file to search for in parent directories"
31+
flagProjectFileName (\pf flags -> flags { flagProjectFileName = pf })
32+
(reqArg "FILE" (succeedReadE Flag) flagToList)
33+
, option ['z'] ["ignore-project"]
34+
"Ignore local project configuration"
35+
flagIgnoreProject (\v flags -> flags { flagIgnoreProject = v })
36+
trueArg
37+
]

‎cabal-install/Distribution/Client/Setup.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1767,7 +1767,7 @@ data InstallFlags = InstallFlags {
17671767
-- read and written out in some cases. If the path is not found
17681768
-- in the current working directory, we will successively probe
17691769
-- relative to parent directories until this name is found.
1770-
installProjectFileName :: Flag FilePath
1770+
installProjectFileName :: Flag FilePath -- TODO: use ProjectFlags
17711771
}
17721772
deriving (Eq, Generic)
17731773

‎cabal-install/cabal-install.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -229,6 +229,7 @@ executable cabal
229229
Distribution.Client.ProjectConfig
230230
Distribution.Client.ProjectConfig.Legacy
231231
Distribution.Client.ProjectConfig.Types
232+
Distribution.Client.ProjectFlags
232233
Distribution.Client.ProjectOrchestration
233234
Distribution.Client.ProjectPlanOutput
234235
Distribution.Client.ProjectPlanning

‎cabal-install/cabal-install.cabal.pp

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,7 @@
168168
Distribution.Client.ProjectConfig
169169
Distribution.Client.ProjectConfig.Legacy
170170
Distribution.Client.ProjectConfig.Types
171+
Distribution.Client.ProjectFlags
171172
Distribution.Client.ProjectOrchestration
172173
Distribution.Client.ProjectPlanOutput
173174
Distribution.Client.ProjectPlanning

0 commit comments

Comments
 (0)