Skip to content

Commit 0fa72bd

Browse files
markus1189markus1189
committed
Add text versions of strArgument and strOption
1 parent 01a6282 commit 0fa72bd

3 files changed

Lines changed: 54 additions & 48 deletions

File tree

‎src/Options/Applicative/Builder/Extra.hs‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -7,13 +7,18 @@ module Options.Applicative.Builder.Extra
77
,enableDisableFlags
88
,enableDisableFlagsNoDefault
99
,extraHelpOption
10-
,execExtraHelp)
10+
,execExtraHelp
11+
,textOption
12+
,textArgument)
1113
where
1214

1315
import Control.Monad (when)
1416
import Options.Applicative
17+
import Options.Applicative.Types (readerAsk)
1518
import System.Environment (withArgs)
1619
import System.FilePath (takeBaseName)
20+
import Data.Text (Text)
21+
import qualified Data.Text as T
1722

1823
-- | Enable/disable flags for a @Bool@.
1924
boolFlags :: Bool -> String -> String -> Mod FlagFields Bool -> Parser Bool
@@ -71,7 +76,7 @@ extraHelpOption progName fakeName helpName =
7176
-- Since optparse-applicative doesn't allow an arbirary IO action for an 'abortOption', this
7277
-- was the best way I found that doesn't require manually formatting the help.
7378
execExtraHelp :: [String] -> String -> Parser a -> String -> IO ()
74-
execExtraHelp args helpOpt parser pd = do
79+
execExtraHelp args helpOpt parser pd =
7580
when (args == ["--" ++ helpOpt]) $
7681
withArgs ["--help"] $ do
7782
_ <- execParser (info (hiddenHelper <*>
@@ -81,3 +86,9 @@ execExtraHelp args helpOpt parser pd = do
8186
(fullDesc <> progDesc pd))
8287
return ()
8388
where hiddenHelper = abortOption ShowHelpText (long "help" <> hidden <> internal)
89+
90+
textOption :: Mod OptionFields Text -> Parser Text
91+
textOption = option (T.pack <$> readerAsk)
92+
93+
textArgument :: Mod ArgumentFields Text -> Parser Text
94+
textArgument = argument (T.pack <$> readerAsk)

‎src/Stack/Options.hs‎

Lines changed: 27 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -81,10 +81,9 @@ buildOptsParser cmd =
8181
where optimize =
8282
maybeBoolFlags "optimizations" "optimizations for TARGETs and all its dependencies" idm
8383
target =
84-
fmap (map T.pack)
85-
(many (strArgument
86-
(metavar "TARGET" <>
87-
help "If none specified, use all packages")))
84+
many (textArgument
85+
(metavar "TARGET" <>
86+
help "If none specified, use all packages"))
8887
libProfiling =
8988
boolFlags False
9089
"library-profiling"
@@ -120,18 +119,16 @@ buildOptsParser cmd =
120119
( long "pedantic"
121120
<> help "Turn on -Wall and -Werror (note: option name may change in the future"
122121
)
123-
<*> many (fmap T.pack
124-
(strOption (long "ghc-options" <>
125-
metavar "OPTION" <>
126-
help "Additional options passed to GHC")))
127-
128-
flags =
129-
fmap (Map.unionsWith Map.union) $ many
130-
(option readFlag
131-
( long "flag"
132-
<> metavar "PACKAGE:[-]FLAG"
133-
<> help "Override flags set in stack.yaml (applies to local packages and extra-deps)"
134-
))
122+
<*> many (textOption (long "ghc-options" <>
123+
metavar "OPTION" <>
124+
help "Additional options passed to GHC"))
125+
126+
flags = Map.unionsWith Map.union <$> many
127+
(option readFlag
128+
(long "flag" <>
129+
metavar "PACKAGE:[-]FLAG" <>
130+
help ("Override flags set in stack.yaml " <>
131+
"(applies to local packages and extra-deps)")))
135132

136133
preFetch = flag False True
137134
(long "prefetch" <>
@@ -239,16 +236,16 @@ configOptsParser docker =
239236
<> metavar "JOBS"
240237
<> help "Number of concurrent jobs to run"
241238
))
242-
<*> fmap (Set.fromList . map T.pack) (many $ strOption
239+
<*> fmap Set.fromList (many (textOption
243240
( long "extra-include-dirs"
244241
<> metavar "DIR"
245242
<> help "Extra directories to check for C header files"
246-
))
247-
<*> fmap (Set.fromList . map T.pack) (many $ strOption
243+
)))
244+
<*> fmap Set.fromList (many (textOption
248245
( long "extra-lib-dirs"
249246
<> metavar "DIR"
250247
<> help "Extra directories to check for libraries"
251-
))
248+
)))
252249
<*> maybeBoolFlags
253250
"skip-ghc-check"
254251
"skipping the GHC version and architecture check"
@@ -403,14 +400,13 @@ dotOptsParser = DotOpts
403400

404401
ghciOptsParser :: Parser GhciOpts
405402
ghciOptsParser = GhciOpts
406-
<$> fmap (map T.pack)
407-
(many (strArgument
408-
(metavar "TARGET" <>
409-
help ("If none specified, " <>
410-
"use all packages defined in current directory"))))
403+
<$> many (textArgument
404+
(metavar "TARGET" <>
405+
help ("If none specified, " <>
406+
"use all packages defined in current directory")))
411407
<*> fmap concat (many (argsOption (long "ghc-options" <>
412-
metavar "OPTION" <>
413-
help "Additional options passed to GHCi")))
408+
metavar "OPTION" <>
409+
help "Additional options passed to GHCi")))
414410
<*> strOption (long "with-ghc" <>
415411
metavar "GHC" <>
416412
help "Use this command for the GHC to run" <>
@@ -476,10 +472,10 @@ globalOptsParser defaultTerminal =
476472
(long "no-terminal" <>
477473
help
478474
"Override terminal detection in the case of running in a false terminal") <*>
479-
(optional (strOption
480-
(long "stack-yaml" <>
481-
metavar "STACK-YAML" <>
482-
help "Override project stack.yaml file (overrides any STACK_YAML environment variable)")))
475+
optional (strOption (long "stack-yaml" <>
476+
metavar "STACK-YAML" <>
477+
help ("Override project stack.yaml file " <>
478+
"(overrides any STACK_YAML environment variable)")))
483479

484480
initOptsParser :: Parser InitOpts
485481
initOptsParser =

‎src/main/Main.hs‎

Lines changed: 14 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -257,28 +257,27 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> do
257257
addCommand "list-dependencies"
258258
"List the dependencies"
259259
listDependenciesCmd
260-
(T.pack <$> strOption (long "separator" <>
261-
metavar "SEP" <>
262-
help ("Separator between package name " <>
263-
"and package version.") <>
264-
value " " <>
265-
showDefault))
260+
(textOption (long "separator" <>
261+
metavar "SEP" <>
262+
help ("Separator between package name " <>
263+
"and package version.") <>
264+
value " " <>
265+
showDefault))
266266
addSubCommands
267267
"ide"
268268
"IDE-specific commands"
269269
(do addCommand
270270
"start"
271271
"Start the ide-backend service"
272272
ideCmd
273-
(((,) <$>
274-
fmap (map T.pack)
275-
(many (strArgument
276-
(metavar "TARGET" <>
277-
help "If none specified, use all packages defined in current directory"))) <*>
278-
argsOption (long "ghc-options" <>
279-
metavar "OPTION" <>
280-
help "Additional options passed to GHCi" <>
281-
value [])))
273+
((,) <$> many (textArgument
274+
(metavar "TARGET" <>
275+
help ("If none specified, use all " <>
276+
"packages defined in current directory")))
277+
<*> argsOption (long "ghc-options" <>
278+
metavar "OPTION" <>
279+
help "Additional options passed to GHCi" <>
280+
value []))
282281
addCommand
283282
"packages"
284283
"List all available local loadable packages"

0 commit comments

Comments
 (0)