forked from commercialhaskell/stack
-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathOptions.hs
More file actions
814 lines (762 loc) · 31.1 KB
/
Options.hs
File metadata and controls
814 lines (762 loc) · 31.1 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
{-# LANGUAGE OverloadedStrings,RecordWildCards #-}
module Stack.Options
(Command(..)
,benchOptsParser
,buildOptsParser
,cleanOptsParser
,configCmdSetParser
,configOptsParser
,dockerOptsParser
,dockerCleanupOptsParser
,dotOptsParser
,execOptsParser
,evalOptsParser
,globalOptsParser
,initOptsParser
,newOptsParser
,nixOptsParser
,logLevelOptsParser
,ghciOptsParser
,solverOptsParser
,testOptsParser
,hpcReportOptsParser
,pvpBoundsOption
,globalOptsFromMonoid
) where
import Control.Monad.Logger (LogLevel(..))
import Data.Char (isSpace, toLower)
import Data.List (intercalate)
import Data.List.Split (splitOn)
import qualified Data.Map as Map
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.Monoid
import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Distribution.Version (anyVersion)
import Options.Applicative
import Options.Applicative.Args
import Options.Applicative.Builder.Extra
import Options.Applicative.Types (fromM, oneM, readerAsk)
import Stack.Clean (CleanOpts(..))
import Stack.Config (packagesParser)
import Stack.Types.Config (describeConfig)
import Stack.ConfigCmd
import Stack.Constants (stackProgName)
import Stack.Coverage (HpcReportOpts(..))
import Stack.Docker
import qualified Stack.Docker as Docker
import Stack.Dot
import Stack.Ghci (GhciOpts(..))
import Stack.Init
import Stack.New
import Stack.Nix
import Stack.Types
import Stack.Types.TemplateName
-- | Command sum type for conditional arguments.
data Command
= Build
| Test
| Haddock
| Bench
| Install
deriving (Eq)
-- | Parser for bench arguments.
benchOptsParser :: Parser BenchmarkOpts
benchOptsParser = BenchmarkOpts
<$> optional (strOption (long "benchmark-arguments" <>
metavar "BENCH_ARGS" <>
help ("Forward BENCH_ARGS to the benchmark suite. " <>
"Supports templates from `cabal bench`")))
<*> switch (long "no-run-benchmarks" <>
help "Disable running of benchmarks. (Benchmarks will still be built.)")
-- | Parser for build arguments.
buildOptsParser :: Command
-> Parser BuildOpts
buildOptsParser cmd =
BuildOpts <$> target <*> libProfiling <*> exeProfiling <*>
haddock <*> haddockDeps <*> dryRun <*> ghcOpts <*>
flags <*> copyBins <*> preFetch <*> buildSubset <*>
fileWatch' <*> keepGoing <*> forceDirty <*> tests <*>
testOptsParser <*> benches <*> benchOptsParser <*>
many exec <*> onlyConfigure <*> reconfigure <*> cabalVerbose
where target =
many (textArgument
(metavar "TARGET" <>
help "If none specified, use all packages"))
libProfiling =
boolFlags False
"library-profiling"
"library profiling for TARGETs and all its dependencies"
idm
exeProfiling =
boolFlags False
"executable-profiling"
"executable profiling for TARGETs and all its dependencies"
idm
haddock =
boolFlags (cmd == Haddock)
"haddock"
"generating Haddocks the package(s) in this directory/configuration"
idm
haddockDeps =
maybeBoolFlags
"haddock-deps"
"building Haddocks for dependencies"
idm
copyBins = boolFlags (cmd == Install)
"copy-bins"
"copying binaries to the local-bin-path (see 'stack path')"
idm
dryRun = switch (long "dry-run" <>
help "Don't build anything, just prepare to")
ghcOpts = (\x y z -> concat [x, y, z])
<$> flag [] ["-Wall", "-Werror"]
( long "pedantic"
<> help "Turn on -Wall and -Werror"
)
<*> flag [] ["-O0"]
( long "fast"
<> help "Turn off optimizations (-O0)"
)
<*> many (textOption (long "ghc-options" <>
metavar "OPTION" <>
help "Additional options passed to GHC"))
flags = Map.unionsWith Map.union <$> many
(option readFlag
(long "flag" <>
metavar "PACKAGE:[-]FLAG" <>
help ("Override flags set in stack.yaml " <>
"(applies to local packages and extra-deps)")))
preFetch = switch
(long "prefetch" <>
help "Fetch packages necessary for the build immediately, useful with --dry-run")
buildSubset =
flag' BSOnlyDependencies
(long "dependencies-only" <>
help "A synonym for --only-dependencies")
<|> flag' BSOnlySnapshot
(long "only-snapshot" <>
help "Only build packages for the snapshot database, not the local database")
<|> flag' BSOnlyDependencies
(long "only-dependencies" <>
help "Only build packages that are dependencies of targets on the command line")
<|> pure BSAll
fileWatch' =
flag' FileWatch
(long "file-watch" <>
help "Watch for changes in local files and automatically rebuild. Ignores files in VCS boring/ignore file")
<|> flag' FileWatchPoll
(long "file-watch-poll" <>
help "Like --file-watch, but polling the filesystem instead of using events")
<|> pure NoFileWatch
keepGoing = maybeBoolFlags
"keep-going"
"continue running after a step fails (default: false for build, true for test/bench)"
idm
forceDirty = switch
(long "force-dirty" <>
help "Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change)")
tests = boolFlags (cmd == Test)
"test"
"testing the package(s) in this directory/configuration"
idm
benches = boolFlags (cmd == Bench)
"bench"
"benchmarking the package(s) in this directory/configuration"
idm
exec = cmdOption
( long "exec" <>
metavar "CMD [ARGS]" <>
help "Command and arguments to run after a successful build" )
onlyConfigure = switch
(long "only-configure" <>
help "Only perform the configure step, not any builds. Intended for tool usage, may break when used on multiple packages at once!")
reconfigure = switch
(long "reconfigure" <>
help "Perform the configure step even if unnecessary. Useful in some corner cases with custom Setup.hs files")
cabalVerbose = switch
(long "cabal-verbose" <>
help "Ask Cabal to be verbose in its output")
-- | Parser for package:[-]flag
readFlag :: ReadM (Map (Maybe PackageName) (Map FlagName Bool))
readFlag = do
s <- readerAsk
case break (== ':') s of
(pn, ':':mflag) -> do
pn' <-
case parsePackageNameFromString pn of
Nothing
| pn == "*" -> return Nothing
| otherwise -> readerError $ "Invalid package name: " ++ pn
Just x -> return $ Just x
let (b, flagS) =
case mflag of
'-':x -> (False, x)
_ -> (True, mflag)
flagN <-
case parseFlagNameFromString flagS of
Nothing -> readerError $ "Invalid flag name: " ++ flagS
Just x -> return x
return $ Map.singleton pn' $ Map.singleton flagN b
_ -> readerError "Must have a colon"
-- | Command-line parser for the clean command.
cleanOptsParser :: Parser CleanOpts
cleanOptsParser = CleanOpts <$> packages
where
packages =
many
(packageNameArgument
(metavar "PACKAGE" <>
help "If none specified, clean all local packages"))
-- | Command-line arguments parser for configuration.
configOptsParser :: Bool -> Parser ConfigMonoid
configOptsParser hide0 =
(\workDir dockerOpts nixOpts systemGHC installGHC arch os ghcVariant jobs includes libs skipGHCCheck skipMsys localBin modifyCodePage -> mempty
{ configMonoidWorkDir = workDir
, configMonoidDockerOpts = dockerOpts
, configMonoidNixOpts = nixOpts
, configMonoidSystemGHC = systemGHC
, configMonoidInstallGHC = installGHC
, configMonoidSkipGHCCheck = skipGHCCheck
, configMonoidArch = arch
, configMonoidOS = os
, configMonoidGHCVariant = ghcVariant
, configMonoidJobs = jobs
, configMonoidExtraIncludeDirs = includes
, configMonoidExtraLibDirs = libs
, configMonoidSkipMsys = skipMsys
, configMonoidLocalBinPath = localBin
, configMonoidModifyCodePage = modifyCodePage
})
<$> optional (strOption
( long "work-dir"
<> metavar "WORK-DIR"
<> help "Override work directory (default: .stack-work)"
<> hide
))
<*> dockerOptsParser True
<*> nixOptsParser True
<*> maybeBoolFlags
"system-ghc"
"using the system installed GHC (on the PATH) if available and a matching version"
hide
<*> maybeBoolFlags
"install-ghc"
"downloading and installing GHC if necessary (can be done manually with stack setup)"
hide
<*> optional (strOption
( long "arch"
<> metavar "ARCH"
<> help "System architecture, e.g. i386, x86_64"
<> hide
))
<*> optional (strOption
( long "os"
<> metavar "OS"
<> help "Operating system, e.g. linux, windows"
<> hide
))
<*> optional (ghcVariantParser hide0)
<*> optional (option auto
( long "jobs"
<> short 'j'
<> metavar "JOBS"
<> help "Number of concurrent jobs to run"
<> hide
))
<*> fmap Set.fromList (many (textOption
( long "extra-include-dirs"
<> metavar "DIR"
<> help "Extra directories to check for C header files"
<> hide
)))
<*> fmap Set.fromList (many (textOption
( long "extra-lib-dirs"
<> metavar "DIR"
<> help "Extra directories to check for libraries"
<> hide
)))
<*> maybeBoolFlags
"skip-ghc-check"
"skipping the GHC version and architecture check"
hide
<*> maybeBoolFlags
"skip-msys"
"skipping the local MSYS installation (Windows only)"
hide
<*> optional (strOption
( long "local-bin-path"
<> metavar "DIR"
<> help "Install binaries to DIR"
<> hide
))
<*> maybeBoolFlags
"modify-code-page"
"setting the codepage to support UTF-8 (Windows only)"
hide
where hide = hideMods hide0
nixOptsParser :: Bool -> Parser NixOptsMonoid
nixOptsParser hide0 =
NixOptsMonoid
<$> pure False
<*> maybeBoolFlags nixCmdName
"using a Nix-shell"
hide
<*> pure []
<*> pure Nothing
<*> ((map T.pack . fromMaybe [])
<$> optional (argsOption (long "nix-shell-options" <>
metavar "OPTION" <>
help "Additional options passed to nix-shell" <>
hide)))
where
hide = hideMods hide0
-- | Options parser configuration for Docker.
dockerOptsParser :: Bool -> Parser DockerOptsMonoid
dockerOptsParser hide0 =
DockerOptsMonoid
<$> pure False
<*> maybeBoolFlags dockerCmdName
"using a Docker container"
hide
<*> ((Just . DockerMonoidRepo) <$> option str (long (dockerOptName dockerRepoArgName) <>
hide <>
metavar "NAME" <>
help "Docker repository name") <|>
(Just . DockerMonoidImage) <$> option str (long (dockerOptName dockerImageArgName) <>
hide <>
metavar "IMAGE" <>
help "Exact Docker image ID (overrides docker-repo)") <|>
pure Nothing)
<*> maybeBoolFlags (dockerOptName dockerRegistryLoginArgName)
"registry requires login"
hide
<*> maybeStrOption (long (dockerOptName dockerRegistryUsernameArgName) <>
hide <>
metavar "USERNAME" <>
help "Docker registry username")
<*> maybeStrOption (long (dockerOptName dockerRegistryPasswordArgName) <>
hide <>
metavar "PASSWORD" <>
help "Docker registry password")
<*> maybeBoolFlags (dockerOptName dockerAutoPullArgName)
"automatic pulling latest version of image"
hide
<*> maybeBoolFlags (dockerOptName dockerDetachArgName)
"running a detached Docker container"
hide
<*> maybeBoolFlags (dockerOptName dockerPersistArgName)
"not deleting container after it exits"
hide
<*> maybeStrOption (long (dockerOptName dockerContainerNameArgName) <>
hide <>
metavar "NAME" <>
help "Docker container name")
<*> argsOption (long (dockerOptName dockerRunArgsArgName) <>
hide <>
value [] <>
metavar "'ARG1 [ARG2 ...]'" <>
help "Additional options to pass to 'docker run'")
<*> many (option auto (long (dockerOptName dockerMountArgName) <>
hide <>
metavar "(PATH | HOST-PATH:CONTAINER-PATH)" <>
help ("Mount volumes from host in container " ++
"(may specify multiple times)")))
<*> many (option str (long (dockerOptName dockerEnvArgName) <>
hide <>
metavar "NAME=VALUE" <>
help ("Set environment variable in container " ++
"(may specify multiple times)")))
<*> maybeStrOption (long (dockerOptName dockerDatabasePathArgName) <>
hide <>
metavar "PATH" <>
help "Location of image usage tracking database")
<*> optional (option str
(long(dockerOptName dockerStackExeArgName) <>
hide <>
metavar (intercalate "|"
[ dockerStackExeDownloadVal
, dockerStackExeHostVal
, dockerStackExeImageVal
, "PATH" ]) <>
help (concat [ "Location of "
, stackProgName
, " executable used in container" ])))
<*> maybeBoolFlags (dockerOptName dockerSetUserArgName)
"setting user in container to match host"
hide
<*> pure anyVersion
where
dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName
maybeStrOption = optional . option str
hide = hideMods hide0
-- | Parser for docker cleanup arguments.
dockerCleanupOptsParser :: Parser Docker.CleanupOpts
dockerCleanupOptsParser =
Docker.CleanupOpts <$>
(flag' Docker.CleanupInteractive
(short 'i' <>
long "interactive" <>
help "Show cleanup plan in editor and allow changes (default)") <|>
flag' Docker.CleanupImmediate
(short 'y' <>
long "immediate" <>
help "Immediately execute cleanup plan") <|>
flag' Docker.CleanupDryRun
(short 'n' <>
long "dry-run" <>
help "Display cleanup plan but do not execute") <|>
pure Docker.CleanupInteractive) <*>
opt (Just 14) "known-images" "LAST-USED" <*>
opt Nothing "unknown-images" "CREATED" <*>
opt (Just 0) "dangling-images" "CREATED" <*>
opt Nothing "stopped-containers" "CREATED" <*>
opt Nothing "running-containers" "CREATED"
where opt def' name mv =
fmap Just
(option auto
(long name <>
metavar (mv ++ "-DAYS-AGO") <>
help ("Remove " ++
toDescr name ++
" " ++
map toLower (toDescr mv) ++
" N days ago" ++
case def' of
Just n -> " (default " ++ show n ++ ")"
Nothing -> ""))) <|>
flag' Nothing
(long ("no-" ++ name) <>
help ("Do not remove " ++
toDescr name ++
case def' of
Just _ -> ""
Nothing -> " (default)")) <|>
pure def'
toDescr = map (\c -> if c == '-' then ' ' else c)
-- | Parser for arguments to `stack dot`
dotOptsParser :: Parser DotOpts
dotOptsParser = DotOpts
<$> includeExternal
<*> includeBase
<*> depthLimit
<*> fmap (maybe Set.empty Set.fromList . fmap splitNames) prunedPkgs
where includeExternal = boolFlags False
"external"
"inclusion of external dependencies"
idm
includeBase = boolFlags True
"include-base"
"inclusion of dependencies on base"
idm
depthLimit =
optional (option auto
(long "depth" <>
metavar "DEPTH" <>
help ("Limit the depth of dependency resolution " <>
"(Default: No limit)")))
prunedPkgs = optional (strOption
(long "prune" <>
metavar "PACKAGES" <>
help ("Prune each package name " <>
"from the comma separated list " <>
"of package names PACKAGES")))
splitNames :: String -> [String]
splitNames = map (takeWhile (not . isSpace) . dropWhile isSpace) . splitOn ","
ghciOptsParser :: Parser GhciOpts
ghciOptsParser = GhciOpts
<$> switch (long "no-build" <> help "Don't build before launching GHCi")
<*> fmap concat (many (argsOption (long "ghci-options" <>
metavar "OPTION" <>
help "Additional options passed to GHCi")))
<*> optional
(strOption (long "with-ghc" <>
metavar "GHC" <>
help "Use this GHC to run GHCi"))
<*> (not <$> boolFlags True "load" "load modules on start-up" idm)
<*> packagesParser
<*> optional
(textOption
(long "main-is" <>
metavar "TARGET" <>
help "Specify which target should contain the main \
\module to load, such as for an executable for \
\test suite or benchmark."))
<*> switch (long "skip-intermediate-deps" <> help "Skip loading intermediate target dependencies")
<*> buildOptsParser Build
-- | Parser for exec command
execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts
execOptsParser mcmd =
ExecOpts
<$> maybe eoCmdParser pure mcmd
<*> eoArgsParser
<*> execOptsExtraParser
where
eoCmdParser = ExecCmd <$> strArgument (metavar "CMD")
eoArgsParser = many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)"))
evalOptsParser :: String -- ^ metavar
-> Parser EvalOpts
evalOptsParser meta =
EvalOpts
<$> eoArgsParser
<*> execOptsExtraParser
where
eoArgsParser :: Parser String
eoArgsParser = strArgument (metavar meta)
-- | Parser for extra options to exec command
execOptsExtraParser :: Parser ExecOptsExtra
execOptsExtraParser = eoPlainParser <|>
ExecOptsEmbellished
<$> eoEnvSettingsParser
<*> eoPackagesParser
where
eoEnvSettingsParser :: Parser EnvSettings
eoEnvSettingsParser = EnvSettings
<$> pure True
<*> boolFlags True
"ghc-package-path"
"setting the GHC_PACKAGE_PATH variable for the subprocess"
idm
<*> boolFlags True
"stack-exe"
"setting the STACK_EXE environment variable to the path for the stack executable"
idm
<*> pure False
eoPackagesParser :: Parser [String]
eoPackagesParser = many (strOption (long "package" <> help "Additional packages that must be installed"))
eoPlainParser :: Parser ExecOptsExtra
eoPlainParser = flag' ExecOptsPlain
(long "plain" <>
help "Use an unmodified environment (only useful with Docker)")
-- | Parser for global command-line options.
globalOptsParser :: Bool -> Maybe LogLevel -> Parser GlobalOptsMonoid
globalOptsParser hide0 defLogLevel =
GlobalOptsMonoid <$>
(optional (abortOption
(InfoMsg
("The following YAML settings are supported: \n\n" <>
T.unpack describeConfig)) $
long "config-help" <>
help "Show all available configuration (.yaml file) options") *>
optional (strOption (long Docker.reExecArgName <> hidden <> internal))) <*>
optional (option auto (long dockerEntrypointArgName <> hidden <> internal)) <*>
logLevelOptsParser hide0 defLogLevel <*>
configOptsParser hide0 <*>
optional (abstractResolverOptsParser hide0) <*>
optional (compilerOptsParser hide0) <*>
maybeBoolFlags
"terminal"
"overriding terminal detection in the case of running in a false terminal"
hide <*>
optional (strOption (long "stack-yaml" <>
metavar "STACK-YAML" <>
help ("Override project stack.yaml file " <>
"(overrides any STACK_YAML environment variable)") <>
hide))
where hide = hideMods hide0
-- | Create GlobalOpts from GlobalOptsMonoid.
globalOptsFromMonoid :: Bool -> GlobalOptsMonoid -> GlobalOpts
globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts
{ globalReExecVersion = globalMonoidReExecVersion
, globalDockerEntrypoint = globalMonoidDockerEntrypoint
, globalLogLevel = fromMaybe defaultLogLevel globalMonoidLogLevel
, globalConfigMonoid = globalMonoidConfigMonoid
, globalResolver = globalMonoidResolver
, globalCompiler = globalMonoidCompiler
, globalTerminal = fromMaybe defaultTerminal globalMonoidTerminal
, globalStackYaml = globalMonoidStackYaml }
initOptsParser :: Parser InitOpts
initOptsParser =
InitOpts <$> method <*> overwrite <*> fmap not ignoreSubDirs
where
ignoreSubDirs = switch (long "ignore-subdirs" <>
help "Do not search for .cabal files in sub directories")
overwrite = switch (long "force" <>
help "Force overwriting of an existing stack.yaml if it exists")
method = solver
<|> (MethodResolver <$> resolver)
<|> (MethodSnapshot <$> snapPref)
solver =
flag' MethodSolver
(long "solver" <>
help "Use a dependency solver to determine dependencies")
snapPref =
flag' PrefLTS
(long "prefer-lts" <>
help "Prefer LTS snapshots over Nightly snapshots") <|>
flag' PrefNightly
(long "prefer-nightly" <>
help "Prefer Nightly snapshots over LTS snapshots") <|>
pure PrefNone
resolver = option readAbstractResolver
(long "resolver" <>
metavar "RESOLVER" <>
help "Use the given resolver, even if not all dependencies are met")
-- | Parser for a logging level.
logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel)
logLevelOptsParser hide defLogLevel =
fmap (Just . parse)
(strOption (long "verbosity" <>
metavar "VERBOSITY" <>
help "Verbosity: silent, error, warn, info, debug" <>
hideMods hide)) <|>
flag' (Just verboseLevel)
(short 'v' <> long "verbose" <>
help ("Enable verbose mode: verbosity level \"" <> showLevel verboseLevel <> "\"") <>
hideMods hide) <|>
pure defLogLevel
where verboseLevel = LevelDebug
showLevel l =
case l of
LevelDebug -> "debug"
LevelInfo -> "info"
LevelWarn -> "warn"
LevelError -> "error"
LevelOther x -> T.unpack x
parse s =
case s of
"debug" -> LevelDebug
"info" -> LevelInfo
"warn" -> LevelWarn
"error" -> LevelError
_ -> LevelOther (T.pack s)
-- | Parser for the resolver
abstractResolverOptsParser :: Bool -> Parser AbstractResolver
abstractResolverOptsParser hide =
option readAbstractResolver
(long "resolver" <>
metavar "RESOLVER" <>
help "Override resolver in project file" <>
hideMods hide)
readAbstractResolver :: ReadM AbstractResolver
readAbstractResolver = do
s <- readerAsk
case s of
"global" -> return ARGlobal
"nightly" -> return ARLatestNightly
"lts" -> return ARLatestLTS
'l':'t':'s':'-':x | Right (x', "") <- decimal $ T.pack x ->
return $ ARLatestLTSMajor x'
_ ->
case parseResolverText $ T.pack s of
Left e -> readerError $ show e
Right x -> return $ ARResolver x
compilerOptsParser :: Bool -> Parser CompilerVersion
compilerOptsParser hide =
option readCompilerVersion
(long "compiler" <>
metavar "COMPILER" <>
help "Use the specified compiler" <>
hideMods hide)
readCompilerVersion :: ReadM CompilerVersion
readCompilerVersion = do
s <- readerAsk
case parseCompilerVersion (T.pack s) of
Nothing -> readerError $ "Failed to parse compiler: " ++ s
Just x -> return x
-- | GHC variant parser
ghcVariantParser :: Bool -> Parser GHCVariant
ghcVariantParser hide =
option
readGHCVariant
(long "ghc-variant" <> metavar "VARIANT" <>
help
"Specialized GHC variant, e.g. integersimple (implies --no-system-ghc)" <>
hideMods hide
)
where
readGHCVariant = do
s <- readerAsk
case parseGHCVariant s of
Left e -> readerError (show e)
Right v -> return v
-- | Parser for @solverCmd@
solverOptsParser :: Parser Bool
solverOptsParser = boolFlags False
"modify-stack-yaml"
"Automatically modify stack.yaml with the solver's recommendations"
idm
-- | Parser for test arguments.
testOptsParser :: Parser TestOpts
testOptsParser = TestOpts
<$> boolFlags True
"rerun-tests"
"running already successful tests"
idm
<*> fmap (fromMaybe [])
(optional (argsOption(long "test-arguments" <>
metavar "TEST_ARGS" <>
help "Arguments passed in to the test suite program")))
<*> switch (long "coverage" <>
help "Generate a code coverage report")
<*> switch (long "no-run-tests" <>
help "Disable running of tests. (Tests will still be built.)")
-- | Parser for @stack new@.
newOptsParser :: Parser (NewOpts,InitOpts)
newOptsParser = (,) <$> newOpts <*> initOptsParser
where
newOpts =
NewOpts <$>
packageNameArgument
(metavar "PACKAGE_NAME" <> help "A valid package name.") <*>
switch
(long "bare" <>
help "Do not create a subdirectory for the project") <*>
templateNameArgument
(metavar "TEMPLATE_NAME" <>
help "Name of a template or a local template in a subdirectory,\
\ for example: foo or foo.hsfiles" <>
value defaultTemplateName) <*>
fmap
M.fromList
(many
(templateParamArgument
(short 'p' <> long "param" <> metavar "KEY:VALUE" <>
help
"Parameter for the template in the format key:value")))
-- | Parser for @stack hpc report@.
hpcReportOptsParser :: Parser HpcReportOpts
hpcReportOptsParser = HpcReportOpts
<$> many (textArgument $ metavar "TARGET_OR_TIX")
<*> switch (long "all" <> help "Use results from all packages and components")
<*> optional (strOption (long "destdir" <> help "Output directy for HTML report"))
pvpBoundsOption :: Parser PvpBounds
pvpBoundsOption =
option
readPvpBounds
(long "pvp-bounds" <> metavar "PVP-BOUNDS" <>
help
"How PVP version bounds should be added to .cabal file: none, lower, upper, both")
where
readPvpBounds = do
s <- readerAsk
case parsePvpBounds $ T.pack s of
Left e ->
readerError e
Right v ->
return v
configCmdSetParser :: Parser ConfigCmdSet
configCmdSetParser =
fromM
(do field <-
oneM
(strArgument
(metavar "FIELD VALUE"))
oneM (fieldToValParser field))
where
fieldToValParser :: String -> Parser ConfigCmdSet
fieldToValParser s =
case s of
"resolver" ->
ConfigCmdSetResolver <$>
argument
readAbstractResolver
idm
_ ->
error "parse stack config set field: only set resolver is implemented"
-- | If argument is True, hides the option from usage and help
hideMods :: Bool -> Mod f a
hideMods hide = if hide then internal <> hidden else idm