Skip to content

Commit 411fe3a

Browse files
roberthroberth
committed
Make consumeOption idiomatic with Mod
1 parent 8ed7325 commit 411fe3a

File tree

6 files changed

+78
-74
lines changed

6 files changed

+78
-74
lines changed

‎src/Options/Applicative.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -111,6 +111,7 @@ module Options.Applicative (
111111
OptionFields,
112112
FlagFields,
113113
ArgumentFields,
114+
OptionArgumentFields,
114115
CommandFields,
115116

116117
HasName,

‎src/Options/Applicative/Builder.hs‎

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -99,6 +99,7 @@ module Options.Applicative.Builder (
9999
OptionFields,
100100
FlagFields,
101101
ArgumentFields,
102+
OptionArgumentFields,
102103
CommandFields,
103104

104105
HasName,
@@ -207,7 +208,12 @@ noArgError e = fieldMod $ \p -> p { optNoArgError = const e }
207208
-- Metavariables have no effect on the actual parser, and only serve to specify
208209
-- the symbolic name for an argument to be displayed in the help text.
209210
metavar :: HasMetavar f => String -> Mod f a
210-
metavar var = optionMod $ \p -> p { propMetaVar = var }
211+
metavar var =
212+
-- some use cases (consumeOption) store it in the field
213+
fieldMod (setFieldMetavar var)
214+
`mappend`
215+
-- whereas others rely exclusively on storing it in the option
216+
optionMod (\p -> p { propMetaVar = var })
211217

212218
-- | Hide this option from the brief description.
213219
--
@@ -401,7 +407,7 @@ option r m = mkParser d g rdr
401407
-- >
402408
-- > configParser :: Parser Config
403409
-- > configParser = Config
404-
-- > <$> many (consumeOption (ConsumeA.consumePair "KEY" str "VALUE" str)
410+
-- > <$> many (consumeOption (ConsumeA.consumePair str (metavar "KEY") str (metavar "VALUE"))
405411
-- > ( long "set"
406412
-- > <> help "Set a configuration key-value pair" ))
407413
--
@@ -415,7 +421,7 @@ option r m = mkParser d g rdr
415421
-- Example usage for consuming one argument:
416422
--
417423
-- > outputOption :: Parser FilePath
418-
-- > outputOption = consumeOption (ConsumeA.consumeOne "FILE" str)
424+
-- > outputOption = consumeOption (ConsumeA.consumeOne str (metavar "FILE"))
419425
-- > ( long "output"
420426
-- > <> help "Output file path" )
421427
--

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

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@ module Options.Applicative.Builder.Internal (
99
FlagFields(..),
1010
CommandFields(..),
1111
ArgumentFields(..),
12+
OptionArgumentFields(..),
1213
DefaultProp(..),
1314

1415
optionMod,
@@ -48,6 +49,10 @@ data CommandFields a = CommandFields
4849
data ArgumentFields a = ArgumentFields
4950
{ argCompleter :: Completer }
5051

52+
data OptionArgumentFields a = OptionArgumentFields
53+
{ optArgCompleter :: Completer
54+
, optArgMetavar :: String }
55+
5156
class HasName f where
5257
name :: OptName -> f a -> f a
5358

@@ -66,6 +71,9 @@ instance HasCompleter OptionFields where
6671
instance HasCompleter ArgumentFields where
6772
modCompleter f p = p { argCompleter = f (argCompleter p) }
6873

74+
instance HasCompleter OptionArgumentFields where
75+
modCompleter f p = p { optArgCompleter = f (optArgCompleter p) }
76+
6977
class HasValue f where
7078
-- this is just so that it is not necessary to specify the kind of f
7179
hasValueDummy :: f a -> ()
@@ -76,13 +84,23 @@ instance HasValue ArgumentFields where
7684

7785
class HasMetavar f where
7886
hasMetavarDummy :: f a -> ()
87+
-- | Set the metavar in the field. Default is no-op (metavar stored in properties).
88+
setFieldMetavar :: String -> f a -> f a
89+
setFieldMetavar _ = id
90+
7991
instance HasMetavar OptionFields where
8092
hasMetavarDummy _ = ()
93+
8194
instance HasMetavar ArgumentFields where
8295
hasMetavarDummy _ = ()
96+
8397
instance HasMetavar CommandFields where
8498
hasMetavarDummy _ = ()
8599

100+
instance HasMetavar OptionArgumentFields where
101+
hasMetavarDummy _ = ()
102+
setFieldMetavar mv p = p { optArgMetavar = mv }
103+
86104
-- mod --
87105

88106
data DefaultProp a = DefaultProp

‎src/Options/Applicative/ConsumeA.hs‎

Lines changed: 31 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,6 @@ module Options.Applicative.ConsumeA (
77
consumeOne,
88
consumeNone,
99

10-
-- * Helpers for creating CReaders
11-
withCompleter,
12-
withoutCompleter,
13-
1410
-- * Internal
1511
unwrapConsumeA
1612
) where
@@ -20,7 +16,8 @@ import Control.Monad.Trans.Reader (runReaderT)
2016
import Prelude
2117

2218
import qualified Options.Applicative.ConsumeA.Internal as CMI
23-
import Options.Applicative.Types (ReadM(..), CReader(..), ParseError(..), Completer(..))
19+
import Options.Applicative.Types (ReadM(..), ParseError(..), Completer(..))
20+
import Options.Applicative.Builder.Internal (Mod(..), OptionArgumentFields(..))
2421

2522
-- | An option parsing implementation that may consume multiple command-line arguments.
2623
--
@@ -58,16 +55,18 @@ withMetavar metavar completer consumer = CMI.makeConsumeA ([metavar], [completer
5855

5956
-- | Consume exactly two arguments using the given readers.
6057
--
61-
-- The first 'CReader' is applied to the first argument, and the second 'CReader'
62-
-- is applied to the second argument. The metavar strings are used in help text.
63-
-- Each CReader bundles a completer with its reader for shell completion support.
58+
-- The first 'ReadM' is applied to the first argument, and the second 'ReadM'
59+
-- is applied to the second argument.
60+
-- Use 'metavar' to specify the metavar string for each argument (defaults to "ARG").
61+
-- Use 'completer' to specify shell completion behavior for each argument.
6462
--
6563
-- Example:
6664
--
6765
-- > import Options.Applicative
6866
-- >
6967
-- > setOption :: Parser (String, String)
70-
-- > setOption = consumeOption (consumePair "KEY" str "VALUE" str)
68+
-- > setOption = consumeOption
69+
-- > (consumePair str (metavar "KEY") str (metavar "VALUE"))
7170
-- > ( long "set"
7271
-- > <> help "Set a configuration value" )
7372
--
@@ -76,20 +75,24 @@ withMetavar metavar completer consumer = CMI.makeConsumeA ([metavar], [completer
7675
-- > --set name Alice
7776
--
7877
-- as @("name", "Alice")@ and display @--set KEY VALUE@ in help text.
79-
consumePair :: String -> CReader a -> String -> CReader b -> ConsumeA (a, b)
80-
consumePair metavar1 cra metavar2 crb = ConsumeA consumer
78+
consumePair :: ReadM a -> Mod OptionArgumentFields a
79+
-> ReadM b -> Mod OptionArgumentFields b
80+
-> ConsumeA (a, b)
81+
consumePair readerA (Mod fA _dA _gA) readerB (Mod fB _dB _gB) = ConsumeA consumer
8182
where
83+
OptionArgumentFields complA mvA = fA (OptionArgumentFields mempty "ARG")
84+
OptionArgumentFields complB mvB = fB (OptionArgumentFields mempty "ARG")
8285
-- TODO: Custom error message would be nice for second argument
8386
-- Is it ok to extend the error type with more constructors?
8487
-- - The option `--foo` expects two arguments.
8588
-- - The option `--foo` expects a second argument.
8689
consumer =
87-
(,) <$> consumeWithCReader metavar1 cra (ExpectsArgError)
88-
<*> consumeWithCReader metavar2 crb (ExpectsArgError)
90+
(,) <$> consumeWithCReader mvA complA readerA (ExpectsArgError)
91+
<*> consumeWithCReader mvB complB readerB (ExpectsArgError)
8992

90-
-- | Helper to consume using a CReader, tracking both completer and metavar
91-
consumeWithCReader :: String -> CReader x -> ContextualError -> CMI.ConsumeA ([String], [Completer]) ContextualError x
92-
consumeWithCReader metavar (CReader completer (ReadM r)) err =
93+
-- | Helper to consume using a ReadM with metavar and completer, tracking both
94+
consumeWithCReader :: String -> Completer -> ReadM x -> ContextualError -> CMI.ConsumeA ([String], [Completer]) ContextualError x
95+
consumeWithCReader metavar completer (ReadM r) err =
9396
withMetavar metavar completer $ do
9497
str <- CMI.consumeAsk err
9598
case runExcept (runReaderT r str) of
@@ -98,16 +101,17 @@ consumeWithCReader metavar (CReader completer (ReadM r)) err =
98101

99102
-- | Consume exactly one argument using the given reader.
100103
--
101-
-- The 'CReader' is applied to the argument to parse and validate it.
102-
-- The metavar string is used in help text.
103-
-- The CReader bundles a completer for shell completion support.
104+
-- The 'ReadM' is applied to the argument to parse and validate it.
105+
-- Use 'metavar' to specify the metavar string for help text (defaults to "ARG").
106+
-- Use 'completer' to specify shell completion behavior.
104107
--
105108
-- Example:
106109
--
107110
-- > import Options.Applicative
108111
-- >
109112
-- > outputOption :: Parser FilePath
110-
-- > outputOption = consumeOption (consumeOne "FILE" str)
113+
-- > outputOption = consumeOption
114+
-- > (consumeOne str (metavar "FILE"))
111115
-- > ( long "output"
112116
-- > <> help "Output file path" )
113117
--
@@ -116,9 +120,11 @@ consumeWithCReader metavar (CReader completer (ReadM r)) err =
116120
-- > --output results.txt
117121
--
118122
-- as @"results.txt"@ and display @--output FILE@ in help text.
119-
consumeOne :: String -> CReader a -> ConsumeA a
120-
consumeOne metavar cra =
121-
ConsumeA (consumeWithCReader metavar cra (ExpectsArgError))
123+
consumeOne :: ReadM a -> Mod OptionArgumentFields a -> ConsumeA a
124+
consumeOne reader (Mod f _d _g) =
125+
ConsumeA (consumeWithCReader mv compl reader (ExpectsArgError))
126+
where
127+
OptionArgumentFields compl mv = f (OptionArgumentFields mempty "ARG")
122128

123129
-- | Consume no arguments and return unit.
124130
--
@@ -147,39 +153,8 @@ consumeOne metavar cra =
147153
-- > options :: Parser Options
148154
-- > options = Options
149155
-- > <$> optional (consumeOption ConsumeA.consumeNone (long "verbose"))
150-
-- > <*> optional (consumeOption (ConsumeA.consumeOne "FILE" str) (long "output"))
151-
-- > <*> many (consumeOption (ConsumeA.consumePair "KEY" str "VALUE" str) (long "map"))
156+
-- > <*> optional (consumeOption (ConsumeA.consumeOne str (metavar "FILE")) (long "output"))
157+
-- > <*> many (consumeOption (ConsumeA.consumePair str (metavar "KEY") str (metavar "VALUE")) (long "map"))
152158
consumeNone :: ConsumeA ()
153159
consumeNone = ConsumeA (pure ())
154160

155-
-- | Create a CReader from a ReadM with a custom completer.
156-
--
157-
-- This allows specifying custom shell completion for an argument.
158-
--
159-
-- Example:
160-
--
161-
-- > import Options.Applicative
162-
-- > import qualified Options.Applicative.ConsumeA as ConsumeA
163-
-- >
164-
-- > outputWithCompletion :: Parser FilePath
165-
-- > outputWithCompletion = consumeOption
166-
-- > (ConsumeA.consumeOne "FILE" (ConsumeA.withCompleter (listFiles "output") str))
167-
-- > (long "output")
168-
withCompleter :: Completer -> ReadM a -> CReader a
169-
withCompleter = CReader
170-
171-
-- | Create a CReader from a ReadM with no completion (empty completer).
172-
--
173-
-- This is useful when you don't want shell completion for an argument.
174-
--
175-
-- Example:
176-
--
177-
-- > import Options.Applicative
178-
-- > import qualified Options.Applicative.ConsumeA as ConsumeA
179-
-- >
180-
-- > secretOption :: Parser String
181-
-- > secretOption = consumeOption
182-
-- > (ConsumeA.consumeOne "SECRET" (ConsumeA.withoutCompleter str))
183-
-- > (long "secret")
184-
withoutCompleter :: ReadM a -> CReader a
185-
withoutCompleter = CReader (Completer (const (return [])))

‎tests/Examples/ConsumeOptions.hs‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
1+
{-# LANGUAGE CPP #-}
12
module Examples.ConsumeOptions where
23

34
import Options.Applicative
45
import qualified Options.Applicative.ConsumeA as ConsumeA
6+
#if __GLASGOW_HASKELL__ < 804
7+
import Data.Semigroup hiding (Option, option)
8+
#endif
59

610
data Config = Config
711
{ outputFile :: Maybe FilePath
@@ -11,10 +15,10 @@ data Config = Config
1115

1216
configParser :: Parser Config
1317
configParser = Config
14-
<$> optional (consumeOption (ConsumeA.consumeOne "FILE" (ConsumeA.withoutCompleter str))
18+
<$> optional (consumeOption (ConsumeA.consumeOne str (metavar "FILE"))
1519
( long "output"
1620
<> help "Output file path" ))
17-
<*> many (consumeOption (ConsumeA.consumePair "KEY" (ConsumeA.withoutCompleter str) "VALUE" (ConsumeA.withoutCompleter str))
21+
<*> many (consumeOption (ConsumeA.consumePair str (metavar "KEY") str (metavar "VALUE"))
1822
( long "set"
1923
<> help "Set a configuration key-value pair" ))
2024
<*> optional (consumeOption ConsumeA.consumeNone

‎tests/test.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1121,23 +1121,23 @@ prop_consumeNone_help_no_arg = once $
11211121
prop_consumeOne_basic :: Property
11221122
prop_consumeOne_basic = once $
11231123
let p :: Parser String
1124-
p = consumeOption (ConsumeA.consumeOne "NAME" (ConsumeA.withoutCompleter str)) (long "name")
1124+
p = consumeOption (ConsumeA.consumeOne str (metavar "NAME")) (long "name")
11251125
i = info p idm
11261126
result = run i ["--name", "Alice"]
11271127
in assertResult result ((===) "Alice")
11281128

11291129
prop_consumeOne_with_reader :: Property
11301130
prop_consumeOne_with_reader = once $
11311131
let p :: Parser Int
1132-
p = consumeOption (ConsumeA.consumeOne "N" (ConsumeA.withoutCompleter auto)) (long "count")
1132+
p = consumeOption (ConsumeA.consumeOne auto (metavar "N")) (long "count")
11331133
i = info p idm
11341134
result = run i ["--count", "42"]
11351135
in assertResult result ((===) 42)
11361136

11371137
prop_consumeOne_missing_arg :: Property
11381138
prop_consumeOne_missing_arg = once $
11391139
let p :: Parser String
1140-
p = consumeOption (ConsumeA.consumeOne "NAME" (ConsumeA.withoutCompleter str)) (long "name")
1140+
p = consumeOption (ConsumeA.consumeOne str (metavar "NAME")) (long "name")
11411141
i = info p idm
11421142
result = run i ["--name"]
11431143
in assertError result $ \failure ->
@@ -1148,31 +1148,31 @@ prop_consumeOne_missing_arg = once $
11481148
prop_parsepair_basic :: Property
11491149
prop_parsepair_basic = once $
11501150
let p :: Parser (String, String)
1151-
p = consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1151+
p = consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
11521152
i = info p idm
11531153
result = run i ["--set", "key", "value"]
11541154
in assertResult result ((===) ("key", "value"))
11551155

11561156
prop_parsepair_multiple :: Property
11571157
prop_parsepair_multiple = once $
11581158
let p :: Parser [(String, String)]
1159-
p = many (consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set"))
1159+
p = many (consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set"))
11601160
i = info p idm
11611161
result = run i ["--set", "a", "1", "--set", "b", "2"]
11621162
in assertResult result ((===) [("a", "1"), ("b", "2")])
11631163

11641164
prop_parsepair_with_readers :: Property
11651165
prop_parsepair_with_readers = once $
11661166
let p :: Parser (String, Int)
1167-
p = consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter auto)) (long "config")
1167+
p = consumeOption (ConsumeA.consumePair str (metavar "K") auto (metavar "V")) (long "config")
11681168
i = info p idm
11691169
result = run i ["--config", "port", "8080"]
11701170
in assertResult result ((===) ("port", 8080 :: Int))
11711171

11721172
prop_parsepair_missing_second_arg :: Property
11731173
prop_parsepair_missing_second_arg = once $
11741174
let p :: Parser (String, String)
1175-
p = consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1175+
p = consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
11761176
i = info p idm
11771177
result = run i ["--set", "key"]
11781178
in assertError result $ \failure ->
@@ -1183,7 +1183,7 @@ prop_parsepair_missing_second_arg = once $
11831183
prop_parsepair_missing_both_args :: Property
11841184
prop_parsepair_missing_both_args = once $
11851185
let p :: Parser (String, String)
1186-
p = consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1186+
p = consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
11871187
i = info p idm
11881188
result = run i ["--set"]
11891189
in assertError result $ \failure ->
@@ -1194,7 +1194,7 @@ prop_parsepair_missing_both_args = once $
11941194
prop_parsepair_mixed :: Property
11951195
prop_parsepair_mixed = once $
11961196
let p :: Parser ((String, String), String)
1197-
p = (,) <$> consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1197+
p = (,) <$> consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
11981198
<*> strOption (long "name")
11991199
i = info p idm
12001200
result = run i ["--set", "a", "b", "--name", "test"]
@@ -1203,7 +1203,7 @@ prop_parsepair_mixed = once $
12031203
prop_parsepair_extra_arg_consumed :: Property
12041204
prop_parsepair_extra_arg_consumed = once $
12051205
let p :: Parser ((String, String), String)
1206-
p = (,) <$> consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1206+
p = (,) <$> consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
12071207
<*> strArgument idm
12081208
i = info p idm
12091209
result = run i ["--set", "key", "value", "extra"]
@@ -1212,7 +1212,7 @@ prop_parsepair_extra_arg_consumed = once $
12121212
prop_parsepair_extra_arg_unconsumed :: Property
12131213
prop_parsepair_extra_arg_unconsumed = once $
12141214
let p :: Parser (String, String)
1215-
p = consumeOption (ConsumeA.consumePair "K" (ConsumeA.withoutCompleter str) "V" (ConsumeA.withoutCompleter str)) (long "set")
1215+
p = consumeOption (ConsumeA.consumePair str (metavar "K") str (metavar "V")) (long "set")
12161216
i = info p idm
12171217
result = run i ["--set", "key", "value", "extra"]
12181218
in assertError result $ \failure ->
@@ -1223,7 +1223,7 @@ prop_parsepair_extra_arg_unconsumed = once $
12231223
prop_parsepair_reader_error_first :: Property
12241224
prop_parsepair_reader_error_first = once $
12251225
let p :: Parser (Int, Int)
1226-
p = consumeOption (ConsumeA.consumePair "MIN" (ConsumeA.withoutCompleter auto) "MAX" (ConsumeA.withoutCompleter auto)) (long "range")
1226+
p = consumeOption (ConsumeA.consumePair auto (metavar "MIN") auto (metavar "MAX")) (long "range")
12271227
i = info p idm
12281228
result = run i ["--range", "notanumber", "10"]
12291229
in assertError result $ \failure ->
@@ -1234,7 +1234,7 @@ prop_parsepair_reader_error_first = once $
12341234
prop_parsepair_reader_error_second :: Property
12351235
prop_parsepair_reader_error_second = once $
12361236
let p :: Parser (Int, Int)
1237-
p = consumeOption (ConsumeA.consumePair "MIN" (ConsumeA.withoutCompleter auto) "MAX" (ConsumeA.withoutCompleter auto)) (long "range")
1237+
p = consumeOption (ConsumeA.consumePair auto (metavar "MIN") auto (metavar "MAX")) (long "range")
12381238
i = info p idm
12391239
result = run i ["--range", "10", "notanumber"]
12401240
in assertError result $ \failure ->

0 commit comments

Comments
 (0)