Merge pull request #76 from Tarmil/tarmil-75

Fix #75: Add SubCommand attribute for nullary subcommands

Author: haf

src/Argu/Attributes.fs

@@ -89,6 +89,13 @@ type FirstAttribute () = inherit CliPositionAttribute (CliPosition.First)
 [<AttributeUsage(AttributeTargets.Property, AllowMultiple = false)>]
 type LastAttribute () = inherit CliPositionAttribute (CliPosition.Last)
 
+/// Declares that argument is a subcommand.
+/// A parse exception will be raised if the argument has parameters
+/// and their type is not ParseResults<_>.
+/// Implicit if the argument does have a parameter of type ParseResults<_>.
+[<AttributeUsage(AttributeTargets.Property, AllowMultiple = false)>]
+type SubCommandAttribute () = inherit Attribute()
+
 /// Declares that argument is the main command of the CLI syntax.
 /// Arguments are specified without requiring a switch.
 [<AttributeUsage(AttributeTargets.Property, AllowMultiple = false)>]

src/Argu/Parsers/Cli.fs

@@ -103,6 +103,8 @@ type CliParseResultAggregator internal (argInfo : UnionArgInfo, stack : CliParse
             error argInfo ErrorCode.CommandLine "argument '%s' has been specified more than once." result.CaseInfo.Name.Value
 
         if result.CaseInfo.ArgumentType = ArgumentType.SubCommand then
+            if isSubCommandDefined then
+                error argInfo ErrorCode.CommandLine "cannot run multiple subcommands."
             isSubCommandDefined <- true
 
         agg.Add result
@@ -403,6 +405,9 @@ let rec private parseCommandLinePartial (state : CliParseState) (argInfo : Union
 
             aggregator.AppendResult caseInfo name [|result|]
 
+        | NullarySubCommand ->
+            aggregator.AppendResult caseInfo name [||]
+
 and private parseCommandLineInner (state : CliParseState) (argInfo : UnionArgInfo) =
     let results = state.ResultStack.CreateNextAggregator argInfo
     while not state.Reader.IsCompleted do parseCommandLinePartial state argInfo results
@@ -426,4 +431,4 @@ and parseCommandLine (argInfo : UnionArgInfo) (programName : string) (descriptio
         Exiter = exiter
     }
 
-    parseCommandLineInner state argInfo
+    parseCommandLineInner state argInfo

src/Argu/Parsers/KeyValue.fs

@@ -92,6 +92,7 @@ let private parseKeyValuePartial (state : KeyValueParseState) (caseInfo : UnionC
                     let case = mkUnionCase caseInfo caseInfo.Tag ParseSource.AppSettings name [|results|]
                     success [|case|]
 
+                | NullarySubCommand
                 | SubCommand _ -> () // AppSettings will not handle subcommands
 
         | _ -> ()

src/Argu/PreCompute.fs

@@ -308,6 +308,7 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
     let isGatherAll = lazy(hasAttribute<GatherAllSourcesAttribute> attributes.Value)
     let isRest = lazy(hasAttribute<RestAttribute> attributes.Value)
     let isHidden = lazy(hasAttribute<HiddenAttribute> attributes.Value)
+    let isExplicitSubCommand = lazy(hasAttribute<SubCommandAttribute> attributes.Value)
 
     let mainCommandName = lazy(
         match tryGetAttribute<MainCommandAttribute> attributes.Value with
@@ -374,21 +375,25 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
         | [|NestedParseResults _|] -> ArgumentType.SubCommand
         | [|Optional _|] -> ArgumentType.Optional
         | [|List _|] -> ArgumentType.List
+        | _ when isExplicitSubCommand.Value -> ArgumentType.SubCommand
         | _ -> ArgumentType.Primitive
 
+    let checkSubCommand() =
+        if Option.isSome customAssignmentSeparator.Value then
+            arguExn "CustomAssignment in '%O' not supported in subcommands." uci
+        if isRest.Value then
+            arguExn "Rest attribute in '%O' not supported in subcommands." uci
+        if isMandatory.Value then
+            arguExn "Mandatory attribute in '%O' not supported in subcommands." uci
+        if isMainCommand.Value then
+            arguExn "MainCommand attribute in '%O' not supported in subcommands." uci
+        if isInherited.Value then
+            arguExn "Inherit attribute in '%O' not supported in subcommands." uci
+
     let parsers = lazy(
         match types with
         | [|NestedParseResults prt|] ->
-            if Option.isSome customAssignmentSeparator.Value then
-                arguExn "CustomAssignment in '%O' not supported in subcommands." uci
-            if isRest.Value then
-                arguExn "Rest attribute in '%O' not supported in subcommands." uci
-            if isMandatory.Value then
-                arguExn "Mandatory attribute in '%O' not supported in subcommands." uci
-            if isMainCommand.Value then
-                arguExn "MainCommand attribute in '%O' not supported in subcommands." uci
-            if isInherited.Value then
-                arguExn "Inherit attribute in '%O' not supported in subcommands." uci
+            checkSubCommand()
 
             let argInfo = preComputeUnionArgInfoInner stack helpParam tryGetCurrent prt
             let shape = ShapeArgumentTemplate.FromType prt
@@ -417,6 +422,12 @@ let rec private preComputeUnionCaseArgInfo (stack : Type list) (helpParam : Help
             ListParam(Existential.FromType t, getPrimitiveParserByType label t)
 
         | _ ->
+            if isExplicitSubCommand.Value then
+                if not (Array.isEmpty fields) then
+                    arguExn "SubCommand in '%O' not supported for parameters other than ParseResults<_>." uci
+                checkSubCommand()
+                NullarySubCommand
+            else
             let getParser (p : PropertyInfo) =
                 let label = tryExtractUnionParameterLabel p
                 getPrimitiveParserByType label p.PropertyType

src/Argu/UnParsers.fs

@@ -85,6 +85,7 @@ let mkCommandLineSyntax (argInfo : UnionArgInfo) (prefix : string) (maxWidth : i
             | SubCommand (label = None) -> yield " <options>"
             | SubCommand (label = Some label) -> yield sprintf " <%s>" label
             | ListParam (_,parser) -> yield sprintf " [<%s>...]" parser.Description
+            | NullarySubCommand -> ()
 
             if not aI.IsMandatory.Value then yield ']'
         }
@@ -171,6 +172,7 @@ let mkArgUsage width (aI : UnionCaseArgInfo) = stringExpr {
 
     | SubCommand(_,_,Some label) -> yield sprintf " <%s>" label
     | SubCommand(_,_,None) -> yield " <options>"
+    | NullarySubCommand -> ()
 
     let! finish = StringExpr.currentLength
     if finish - start >= descriptionOffset then
@@ -332,6 +334,7 @@ let rec mkCommandLineArgs (argInfo : UnionArgInfo) (args : seq<obj>) =
             if not aI.IsMainCommand then yield clName()
             let nestedResult = fields.[0] :?> IParseResult
             yield! mkCommandLineArgs nested (nestedResult.GetAllResults())
+        | NullarySubCommand -> yield clName()
         }
 
     args
@@ -363,6 +366,7 @@ let mkAppSettingsDocument (argInfo : UnionArgInfo) printComments (args : 'Templa
         | None -> [||]
         | Some key ->
             match aI.ParameterInfo.Value with
+            | NullarySubCommand
             | SubCommand _ -> [||]
             | Primitives parsers ->
                 let values =
@@ -419,4 +423,4 @@ let mkAppSettingsDocument (argInfo : UnionArgInfo) printComments (args : 'Templa
 
     XDocument(
         XElement(XName.Get "configuration",
-            XElement(XName.Get "appSettings", Seq.collect mkArgumentEntry args)))
+            XElement(XName.Get "appSettings", Seq.collect mkArgumentEntry args)))

src/Argu/UnionArgInfo.fs

@@ -127,12 +127,14 @@ and ParameterInfo =
     | OptionalParam of Existential * FieldParserInfo
     | ListParam of Existential * FieldParserInfo
     | SubCommand of ShapeArgumentTemplate * argInfo:UnionArgInfo * label:string option
+    | NullarySubCommand
 with
     member pI.Type =
         match pI with
         | Primitives _ -> ArgumentType.Primitive
         | OptionalParam _ -> ArgumentType.Optional
         | ListParam _ -> ArgumentType.List
+        | NullarySubCommand
         | SubCommand _ -> ArgumentType.SubCommand
 
 and [<NoEquality; NoComparison>]

tests/Argu.Tests/Tests.fs

@@ -49,6 +49,7 @@ module ``Argu Tests`` =
     type RequiredSubcommand =
         | Foo
         | [<CliPrefix(CliPrefix.None)>] Sub of ParseResults<CleanArgs>
+        | [<SubCommand; CliPrefix(CliPrefix.None)>] Null_Sub
     with
         interface IArgParserTemplate with
             member this.Usage = "required"
@@ -89,6 +90,7 @@ module ``Argu Tests`` =
         | [<CliPrefix(CliPrefix.None)>] Clean of ParseResults<CleanArgs>
         | [<CliPrefix(CliPrefix.None)>] Required of ParseResults<RequiredSubcommand>
         | [<CliPrefix(CliPrefix.None)>] Unrecognized of ParseResults<GatherUnrecognizedSubcommand>
+        | [<SubCommand; CliPrefix(CliPrefix.None)>] Nullary_Sub
     with
         interface IArgParserTemplate with
             member a.Usage =
@@ -115,6 +117,7 @@ module ``Argu Tests`` =
                 | Clean _ -> "clean state"
                 | Required _ -> "required subcommand"
                 | Unrecognized _ -> "unrecognized subcommand"
+                | Nullary_Sub -> "nullary subcommand"
                 | List _ -> "variadic params"
                 | Optional _ -> "optional params"
                 | A | B | C -> "misc arguments"
@@ -413,6 +416,25 @@ module ``Argu Tests`` =
         raisesWith<ArguParseException> <@ parser.ParseCommandLine(args, ignoreMissing = true) @>
                                         (fun e -> <@ e.FirstLine.Contains "subcommand" @>)
 
+    [<Fact>]
+    let ``Nullary subcommand`` () =
+        let args = [|"nullary-sub"|]
+        let results = parser.ParseCommandLine(args, ignoreMissing = true)
+        test <@ results.TryGetSubCommand() = Some Nullary_Sub @>
+
+    [<Fact>]
+    let ``Required subcommand should succeed on nullary subcommand`` () =
+        let args = [|"required"; "null-sub"|]
+        let results = parser.ParseCommandLine(args, ignoreMissing = true)
+        let nested = results.GetResult <@ Required @>
+        test <@ nested.TryGetSubCommand() = Some Null_Sub @>
+
+    [<Fact>]
+    let ``Calling both a nullary subcommand a normal one should fail`` () =
+        let args = [|"required"; "null-sub"; "sub"; "-fdx"|]
+        raisesWith<ArguParseException> <@ parser.ParseCommandLine(args, ignoreMissing = true) @>
+                                        (fun e -> <@ e.FirstLine.Contains "subcommand" @>)
+
     [<Fact>]
     let ``GatherUnrecognized attribute`` () =
         let args = [|"--mandatory-arg" ; "true" ; "unrecognized" ; "uarg1" ; "--switch1" ; "uarg2"|]