- Just (rest,action) ->
- case processOneArg action rest args of
- Left err -> process spec args' spare (err:errs)
- Right (action,rest) -> do
- action >> process spec rest spare errs
- Nothing ->
- process spec args' (('-':arg):spare) errs
-
- process spec (arg:args) spare errs =
- process spec args (arg:spare) errs
-
-
-processOneArg :: OptKind m -> String -> [String]
- -> Either String (m (), [String])
-processOneArg action rest (dash_arg@('-':arg):args) =
- case action of
- NoArg a -> ASSERT(null rest) Right (a, args)
-
- HasArg f ->
- if rest /= ""
- then Right (f rest, args)
- else case args of
- [] -> missingArgErr dash_arg
- (arg1:args1) -> Right (f arg1, args1)
-
- SepArg f ->
- case args of
- [] -> unknownFlagErr dash_arg
- (arg1:args1) -> Right (f arg1, args1)
-
- Prefix f ->
- if rest /= ""
- then Right (f rest, args)
- else unknownFlagErr dash_arg
-
- PrefixPred p f ->
- if rest /= ""
- then Right (f rest, args)
- else unknownFlagErr dash_arg
-
- OptPrefix f -> Right (f rest, args)
-
- AnySuffix f -> Right (f dash_arg, args)
-
- AnySuffixPred p f -> Right (f dash_arg, args)
-
- PassFlag f ->
- if rest /= ""
- then unknownFlagErr dash_arg
- else Right (f dash_arg, args)
-
-
-findArg :: [(String,OptKind a)] -> String -> Maybe (String,OptKind a)
+ Just (rest, action, deprecated) ->
+ let warns' = case deprecated of
+ Deprecated warning ->
+ L loc ("Warning: " ++ dash_arg ++ " is deprecated: " ++ warning) : warns
+ DeprecatedFullText warning ->
+ L loc ("Warning: " ++ warning) : warns
+ Supported -> warns
+ in case processOneArg action rest arg args of
+ Left err -> process spec args spare (L loc err : errs) warns'
+ Right (action,rest) -> do action
+ process spec rest spare errs warns'
+ Nothing -> process spec args (locArg : spare) errs warns
+
+ process spec (arg : args) spare errs warns =
+ process spec args (arg : spare) errs warns
+
+
+processOneArg :: OptKind m -> String -> String -> [Located String]
+ -> Either String (m (), [Located String])
+processOneArg action rest arg args
+ = let dash_arg = '-' : arg
+ rest_no_eq = dropEq rest
+ in case action of
+ NoArg a -> ASSERT(null rest) Right (a, args)
+
+ HasArg f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+ | otherwise -> case args of
+ [] -> missingArgErr dash_arg
+ (L _ arg1:args1) -> Right (f arg1, args1)
+
+ SepArg f -> case args of
+ [] -> unknownFlagErr dash_arg
+ (L _ arg1:args1) -> Right (f arg1, args1)
+
+ Prefix f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+ | otherwise -> unknownFlagErr dash_arg
+
+ PrefixPred _ f | notNull rest_no_eq -> Right (f rest_no_eq, args)
+ | otherwise -> unknownFlagErr dash_arg
+
+ PassFlag f | notNull rest -> unknownFlagErr dash_arg
+ | otherwise -> Right (f dash_arg, args)
+
+ OptIntSuffix f | null rest -> Right (f Nothing, args)
+ | Just n <- parseInt rest_no_eq -> Right (f (Just n), args)
+ | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
+
+ IntSuffix f | Just n <- parseInt rest_no_eq -> Right (f n, args)
+ | otherwise -> Left ("malformed integer argument in " ++ dash_arg)
+
+ OptPrefix f -> Right (f rest_no_eq, args)
+ AnySuffix f -> Right (f dash_arg, args)
+ AnySuffixPred _ f -> Right (f dash_arg, args)
+
+
+findArg :: [Flag m] -> String -> Maybe (String, OptKind m, Deprecated)