ilyakooo0/optparse-applicative
1
0
Fork 0
mirror of https://github.com/ilyakooo0/optparse-applicative.git synced 2024-09-11 10:45:25 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #306 from pcapriotti/topic/reachable-fix

Browse Source 
Don't set parsers to unreachable after a Command
This commit is contained in:
Huw Campbell 2018-06-09 11:10:01 +10:00 committed by GitHub
commit 49a1681475
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 13 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Options/Applicative/Common.hs
View File

@ -274,7 +274,7 @@ treeMapParser g = simplify . go False False False g
| otherwise
= MultNode []
go m d r f (MultP p1 p2) = MultNode [go m d r f p1, go m d r' f p2]
where r' = r || has_positional p1
where r' = r || hasArg p1
go m d r f (AltP p1 p2) = AltNode [go m d' r f p1, go m d' r f p2]
where d' = d || has_default p1 || has_default p2
go _ d r f (BindP p k) =
@ -283,18 +283,12 @@ treeMapParser g = simplify . go False False False g
Nothing -> go'
Just aa -> MultNode [ go', go True d r f (k aa) ]
has_positional :: Parser a -> Bool
has_positional (NilP _) = False
has_positional (OptP p) = (is_positional . optMain) p
has_positional (MultP p1 p2) = has_positional p1 || has_positional p2
has_positional (AltP p1 p2) = has_positional p1 || has_positional p2
has_positional (BindP p _) = has_positional p
is_positional :: OptReader a -> Bool
is_positional (OptReader {}) = False
is_positional (FlagReader {}) = False
is_positional (ArgReader {}) = True
is_positional (CmdReader {}) = True
hasArg :: Parser a -> Bool
hasArg (NilP _) = False
hasArg (OptP p) = (isArg . optMain) p
hasArg (MultP p1 p2) = hasArg p1 || hasArg p2
hasArg (AltP p1 p2) = hasArg p1 || hasArg p2
hasArg (BindP p _) = hasArg p
simplify :: OptTree a -> OptTree a

12
tests/test.hs
View File

@ -649,16 +649,16 @@ prop_many_pairs_lazy_progress = once $
prop_suggest :: Property
prop_suggest = once $
let p2 = subparser (command "reachable" (info (pure ()) idm))
p1 = subparser (command "unreachable" (info (pure ()) idm))
p = (,) <$> p2 <*> p1
let p2 = subparser (command "first" (info (pure ()) idm))
p1 = subparser (command "fst" (info (pure ()) idm))
p3 = subparser (command "far-off" (info (pure ()) idm))
p = p2 *> p1 *> p3
i = info p idm
result = run i ["ureachable"]
result = run i ["fist"]
in assertError result $ \failure ->
let (msg, _) = renderFailure failure "prog"
in counterexample msg
$ isInfixOf "Did you mean this?\n reachable" msg
.&. not (isInfixOf "unreachable" msg)
$ isInfixOf "Did you mean one of these?\n first\n fst" msg
prop_bytestring_reader :: Property
prop_bytestring_reader = once $