diff --git a/docs/content/tutorial.fsx b/docs/content/tutorial.fsx index 8cd10783..8ba38eee 100644 --- a/docs/content/tutorial.fsx +++ b/docs/content/tutorial.fsx @@ -87,7 +87,7 @@ let parser = ArgumentParser.Create(programName = "gadget.exe") (** We can get the automatically generated usage string by typing *) -let usage = parser.Usage() +let usage = parser.PrintUsage() (** giving @@ -204,7 +204,7 @@ Argu is convenient when it comes to automated process spawning: open System.Diagnostics -let arguments = parser.PrintCommandLineFlat [ Port 42 ; Working_Directory "temp" ] +let arguments = parser.PrintCommandLineArgumentsFlat [ Port 42 ; Working_Directory "temp" ] Process.Start("foo.exe", arguments) @@ -212,7 +212,7 @@ Process.Start("foo.exe", arguments) It can also be used to auto-generate a suitable `AppSettings` configuration file: *) -let xml = parser.PrintAppSettings [ Port 42 ; Working_Directory "/tmp" ] +let xml = parser.PrintAppSettingsArguments [ Port 42 ; Working_Directory "/tmp" ] (** which would yield the following: diff --git a/src/Argu/Argu.fsproj b/src/Argu/Argu.fsproj index 664f93db..0909aa1e 100644 --- a/src/Argu/Argu.fsproj +++ b/src/Argu/Argu.fsproj @@ -65,12 +65,12 @@ + - + - diff --git a/src/Argu/ArgumentParser.fs b/src/Argu/ArgumentParser.fs index cdd5b596..f87e520f 100644 --- a/src/Argu/ArgumentParser.fs +++ b/src/Argu/ArgumentParser.fs @@ -11,22 +11,25 @@ open FSharp.Reflection /// that is an F# discriminated union. It can then be used to parse command line arguments /// or XML configuration. [] -type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (argInfo : UnionArgInfo, ?programName : string, ?description : string, ?errorHandler : IExiter) = +type ArgumentParser<'Template when 'Template :> IArgParserTemplate> + internal (argInfo : UnionArgInfo, ?programName : string, ?description : string, + ?usageStringCharacterWidth : int, ?errorHandler : IExiter) = + // memoize parser generation for given template type static let argInfoLazy = lazy(preComputeUnionArgInfo<'Template> ()) + let _usageStringCharacterWidth = defaultArg usageStringCharacterWidth 80 let _programName = match programName with Some pn -> pn | None -> currentProgramName.Value let errorHandler = match errorHandler with Some e -> e | None -> new ExceptionExiter() :> _ - let mkUsageString argInfo msgOpt = printUsage argInfo _programName description msgOpt |> String.build - + let mkUsageString argInfo msgOpt = printUsage argInfo _programName _usageStringCharacterWidth msgOpt |> StringExpr.build let (|ParserExn|_|) (e : exn) = match e with // do not display usage for App.Config parameter errors - | ParseError (msg, id, _) when id <> ErrorCode.CommandLine -> Some(id, msg) + | ParseError (msg, ErrorCode.AppSettings, _) -> Some(ErrorCode.AppSettings, msg) | ParseError (msg, id, aI) -> Some (id, mkUsageString aI (Some msg)) - | HelpText aI -> Some (ErrorCode.HelpText, mkUsageString aI None) + | HelpText aI -> Some (ErrorCode.HelpText, mkUsageString aI description) | _ -> None /// @@ -34,10 +37,11 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg /// /// Program identifier, e.g. 'cat'. Defaults to the current executable name. /// Program description placed at the top of the usage string. + /// Text width used when formatting the usage string. Defaults to 80 chars. /// The implementation of IExiter used for error handling. Exception is default. - new (?programName : string, ?description : string, ?errorHandler : IExiter) = + new (?programName : string, ?description : string, ?usageStringCharacterWidth : int, ?errorHandler : IExiter) = new ArgumentParser<'Template>(argInfoLazy.Value, ?programName = programName, - ?description = description, ?errorHandler = errorHandler) + ?usageStringCharacterWidth = usageStringCharacterWidth, ?description = description, ?errorHandler = errorHandler) /// Gets the help flags specified for the CLI parser member __.HelpFlags = argInfo.HelpParam.Flags @@ -64,11 +68,11 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg let inputs = match inputs with None -> getEnvironmentCommandLineArgs () | Some args -> args try - let cliResults = parseCommandLine argInfo _programName description errorHandler raiseOnUsage ignoreUnrecognized inputs + let cliResults = parseCommandLine argInfo _programName description _usageStringCharacterWidth errorHandler raiseOnUsage ignoreUnrecognized inputs let ignoreMissing = (cliResults.IsUsageRequested && not raiseOnUsage) || ignoreMissing let results = postProcessResults argInfo ignoreMissing None (Some cliResults) - new ParseResult<'Template>(argInfo, results, mkUsageString argInfo, errorHandler) + new ParseResult<'Template>(argInfo, results, _programName, description, _usageStringCharacterWidth, errorHandler) with ParserExn (errorCode, msg) -> errorHandler.Exit (msg, errorCode) @@ -82,7 +86,7 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg let appSettingsResults = parseKeyValueConfig configurationReader argInfo let results = postProcessResults argInfo ignoreMissing (Some appSettingsResults) None - new ParseResult<'Template>(argInfo, results, mkUsageString argInfo, errorHandler) + new ParseResult<'Template>(argInfo, results, _programName, description, _usageStringCharacterWidth, errorHandler) with ParserExn (errorCode, msg) -> errorHandler.Exit (msg, errorCode) @@ -102,10 +106,10 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg try let appSettingsResults = parseKeyValueConfig configurationReader argInfo - let cliResults = parseCommandLine argInfo _programName description errorHandler raiseOnUsage ignoreUnrecognized inputs + let cliResults = parseCommandLine argInfo _programName description _usageStringCharacterWidth errorHandler raiseOnUsage ignoreUnrecognized inputs let results = postProcessResults argInfo ignoreMissing (Some appSettingsResults) (Some cliResults) - new ParseResult<'Template>(argInfo, results, mkUsageString argInfo, errorHandler) + new ParseResult<'Template>(argInfo, results, _programName, description, _usageStringCharacterWidth, errorHandler) with ParserExn (errorCode, msg) -> errorHandler.Exit (msg, errorCode) @@ -134,11 +138,7 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg /// /// Argument input sequence. member __.ToParseResult (inputs : seq<'Template>) : ParseResult<'Template> = - mkParseResultFromValues argInfo errorHandler (mkUsageString argInfo) inputs - - /// Returns the usage string. - /// The message to be displayed on top of the usage string. - member __.Usage (?message : string) : string = mkUsageString argInfo message + mkParseResultFromValues argInfo errorHandler _usageStringCharacterWidth _programName description inputs /// /// Gets a subparser associated with specific subcommand instance @@ -174,26 +174,37 @@ type ArgumentParser<'Template when 'Template :> IArgParserTemplate> private (arg let uci = expr2Uci ctorExpr argInfo.Cases.[uci.Tag].ToArgumentCaseInfo() + /// Formats a usage string for the argument parser. + /// The message to be displayed on top of the usage string. + /// Override the default program name settings. + /// Text width used when formatting the usage string. + member __.PrintUsage (?message : string, ?programName : string, ?usageStringCharacterWidth : int) : string = + let programName = defaultArg programName _programName + let usageStringCharacterWidth = defaultArg usageStringCharacterWidth _usageStringCharacterWidth + printUsage argInfo programName usageStringCharacterWidth message |> StringExpr.build + /// /// Prints command line syntax. Useful for generating documentation. /// /// Program name identifier placed at start of syntax string - member __.PrintCommandLineSyntax (?programName : string) : string = + /// Text width used when formatting the usage string. + member __.PrintCommandLineSyntax (?programName : string, ?usageStringCharacterWidth : int) : string = let programName = defaultArg programName _programName - printCommandLineSyntax argInfo programName |> String.build + let usageStringCharacterWidth = defaultArg usageStringCharacterWidth _usageStringCharacterWidth + printCommandLineSyntax argInfo "" usageStringCharacterWidth programName |> StringExpr.build /// Prints parameters in command line format. Useful for argument string generation. - member __.PrintCommandLine (args : 'Template list) : string [] = + member __.PrintCommandLineArguments (args : 'Template list) : string [] = printCommandLineArgs argInfo (Seq.cast args) |> Seq.toArray /// Prints parameters in command line format. Useful for argument string generation. - member __.PrintCommandLineFlat (args : 'Template list) : string = - __.PrintCommandLine args |> flattenCliTokens + member __.PrintCommandLineArgumentsFlat (args : 'Template list) : string = + __.PrintCommandLineArguments args |> flattenCliTokens /// Prints parameters in App.Config format. /// The parameters that fill out the XML document. /// Print XML comments over every configuration entry. - member __.PrintAppSettings (args : 'Template list, ?printComments : bool) : string = + member __.PrintAppSettingsArguments (args : 'Template list, ?printComments : bool) : string = let printComments = defaultArg printComments true let xmlDoc = printAppSettings argInfo printComments args use writer = { new System.IO.StringWriter() with member __.Encoding = System.Text.Encoding.UTF8 } @@ -212,14 +223,21 @@ type ArgumentParser = /// /// Program identifier, e.g. 'cat'. Defaults to the current executable name. /// Program description placed at the top of the usage string. + /// Text width used when formatting the usage string. Defaults to 80 chars. /// The implementation of IExiter used for error handling. Exception is default. - static member Create<'Template when 'Template :> IArgParserTemplate>(?programName : string, ?description : string, ?errorHandler : IExiter) = - new ArgumentParser<'Template>(?programName = programName, ?description = description, ?errorHandler = errorHandler) + static member Create<'Template when 'Template :> IArgParserTemplate>(?programName : string, ?description : string, ?usageStringCharacterWidth : int, ?errorHandler : IExiter) = + new ArgumentParser<'Template>(?programName = programName, ?description = description, ?errorHandler = errorHandler, ?usageStringCharacterWidth = usageStringCharacterWidth) [] module ArgumentParserUtils = - + + type ParseResult<'Template when 'Template :> IArgParserTemplate> with + member r.Parser = + new ArgumentParser<'Template>(r.ArgInfo, r.ProgramName, ?description = r.Description, + usageStringCharacterWidth = r.CharacterWidth, + errorHandler = r.ErrorHandler) + /// converts a sequence of inputs to a ParseResult instance let toParseResults (inputs : seq<'Template>) : ParseResult<'Template> = ArgumentParser.Create<'Template>().ToParseResult(inputs) diff --git a/src/Argu/ParseResult.fs b/src/Argu/ParseResult.fs index 602d9298..1ce42ebc 100644 --- a/src/Argu/ParseResult.fs +++ b/src/Argu/ParseResult.fs @@ -2,18 +2,19 @@ open FSharp.Quotations -type private IParseResults = - abstract GetAllResults : unit -> seq - /// Argument parsing result holder. [] type ParseResult<'Template when 'Template :> IArgParserTemplate> - internal (argInfo : UnionArgInfo, results : UnionParseResults, mkUsageString : string option -> string, exiter : IExiter) = + internal (argInfo : UnionArgInfo, results : UnionParseResults, programName : string, description : string option, usageStringCharWidth : int, exiter : IExiter) = + + let mkUsageString message = printUsage argInfo programName usageStringCharWidth message |> StringExpr.build + + // error handler functions + let error hideUsage code msg = + if hideUsage then exiter.Exit(msg, code) + else exiter.Exit(mkUsageString (Some msg), code) - // exiter wrapper - let exit hideUsage msg id = - if hideUsage then exiter.Exit(msg, id) - else exiter.Exit(mkUsageString (Some msg), id) + let errorf hideusage code fmt = Printf.ksprintf (error hideusage code) fmt // restriction predicate based on optional parse source let restrictF flags : UnionCaseParseResult -> bool = @@ -26,32 +27,29 @@ type ParseResult<'Template when 'Template :> IArgParserTemplate> let getResult rs (e : Expr) = let id = expr2Uci e let results = results.Cases.[id.Tag] - match Seq.tryLast results with + match Array.tryLast results with | None -> let aI = argInfo.Cases.[id.Tag] - exit aI.NoCommandLine (sprintf "missing argument '%s'." aI.Name) ErrorCode.PostProcess - | Some r -> - if restrictF rs r then r - else - let aI = r.ArgInfo - exit aI.NoCommandLine (sprintf "missing argument '%s'." aI.Name) ErrorCode.PostProcess + errorf aI.NoCommandLine ErrorCode.PostProcess "ERROR: missing argument '%s'." aI.Name + | Some r when restrictF rs r -> r + | Some r -> errorf r.ArgInfo.NoCommandLine ErrorCode.PostProcess "ERROR: missing argument '%s'." r.ArgInfo.Name let parseResult (f : 'F -> 'S) (r : UnionCaseParseResult) = try f (r.FieldContents :?> 'F) - with e -> - exit r.ArgInfo.NoCommandLine (sprintf "Error parsing '%s': %s" r.ParseContext e.Message) ErrorCode.PostProcess + with e -> errorf r.ArgInfo.NoCommandLine ErrorCode.PostProcess "ERROR parsing '%s': %s" r.ParseContext e.Message - interface IParseResults with - member __.GetAllResults () = - __.GetAllResults() |> Seq.map box + interface IParseResult with + member __.GetAllResults () = __.GetAllResults() |> Seq.map box + + member __.ErrorHandler = exiter + member internal __.ProgramName = programName + member internal __.Description = description + member internal __.ArgInfo = argInfo + member internal __.CharacterWidth = usageStringCharWidth /// Returns true if '--help' parameter has been specified in the command line. member __.IsUsageRequested = results.IsUsageRequested - /// Returns the usage string. - /// The message to be displayed on top of the usage string. - member __.Usage (?message : string) : string = mkUsageString message - /// Gets all unrecognized CLI parameters which /// accumulates if parsed with 'ignoreUnrecognized = true' member __.UnrecognizedCliParams = results.UnrecognizedCliParams @@ -126,8 +124,9 @@ type ParseResult<'Template when 'Template :> IArgParserTemplate> /// The error code to be returned. /// Print usage together with error message. member __.Raise (msg : string, ?errorCode : ErrorCode, ?showUsage : bool) : 'T = + let errorCode = defaultArg errorCode ErrorCode.PostProcess let showUsage = defaultArg showUsage true - exit (not showUsage) msg (defaultArg errorCode ErrorCode.PostProcess) + error (not showUsage) errorCode msg /// Raise an error through the argument parser's exiter mechanism. Display usage optionally. /// The error to be displayed. diff --git a/src/Argu/Parsers.fs b/src/Argu/Parsers.fs index edf50ac6..f20bed36 100644 --- a/src/Argu/Parsers.fs +++ b/src/Argu/Parsers.fs @@ -6,11 +6,11 @@ open System.Collections.Generic open System.Text.RegularExpressions open System.IO -exception ParseError of string * ErrorCode * argInfo:UnionArgInfo +exception ParseError of message:string * code:ErrorCode * argInfo:UnionArgInfo exception HelpText of subcommand:UnionArgInfo -let inline private error argInfo code fmt = - Printf.ksprintf (fun msg -> raise <| ParseError(msg, code, argInfo)) fmt +let inline private error argInfo code fmt = + Printf.ksprintf (fun msg -> raise <| ParseError("ERROR: " + msg, code, argInfo)) fmt /// construct a parse result from untyped collection of parsed arguments let mkUnionCase (info : UnionCaseArgInfo) index parseSource parsecontext (fields : obj []) = @@ -109,6 +109,7 @@ type CliParseState = { ProgramName : string Description : string option + UsageStringCharWidth : int Exiter : IExiter IgnoreUnrecognizedArgs : bool RaiseOnUsage : bool @@ -219,14 +220,9 @@ let rec private parseCommandLinePartial (state : CliParseState) (argInfo : Union member __.Invoke<'T> () = match state.Reader.GetNextToken true argInfo with | UnrecognizedOrArgument tok -> - let arg = - try Some(field.Parser tok :?> 'T) - with - | _ when state.IgnoreUnrecognizedArgs -> results.AppendUnrecognized tok ; Option<'T>.None - | _ -> error argInfo ErrorCode.CommandLine "parameter '%s' should be followed by , but was '%s'." state.Reader.CurrentSegment field.Description tok - - state.Reader.MoveNext() - arg :> obj + let argument = try Some(field.Parser tok :?> 'T) with _ -> None + match argument with Some _ -> state.Reader.MoveNext() | None -> () + argument :> obj | _ -> Option<'T>.None :> obj } @@ -240,15 +236,13 @@ let rec private parseCommandLinePartial (state : CliParseState) (argInfo : Union let rec gather () = match state.Reader.GetNextToken true argInfo with | UnrecognizedOrArgument token -> - try - let item = field.Parser token :?> 'T - args.Add item // this assumes that the add operation is exception safe - with - | _ when state.IgnoreUnrecognizedArgs -> results.AppendUnrecognized token - | _ -> error argInfo ErrorCode.CommandLine "parameter '%s' should be followed by <%s ...>, but was '%s'." state.Reader.CurrentSegment field.Description token - - state.Reader.MoveNext() - gather () + let result = try Some (field.Parser token :?> 'T) with _ -> None + match result with + | None -> () + | Some item -> + args.Add item + state.Reader.MoveNext() + gather() | _ -> () do gather() @@ -263,8 +257,7 @@ let rec private parseCommandLinePartial (state : CliParseState) (argInfo : Union let result = existential.Accept { new ITemplateFunc with member __.Invoke<'Template when 'Template :> IArgParserTemplate> () = - new ParseResult<'Template>(nestedUnion, nestedResults, - printUsage nestedUnion state.ProgramName state.Description >> String.build, state.Exiter) :> obj } + new ParseResult<'Template>(nestedUnion, nestedResults, state.ProgramName, state.Description, state.UsageStringCharWidth, state.Exiter) :> obj } let result = mkUnionCase caseInfo results.ResultCount ParseSource.CommandLine name [|result|] results.AppendResult result @@ -277,13 +270,13 @@ and private parseCommandLineInner (state : CliParseState) (argInfo : UnionArgInf /// /// Parse the entire command line /// -and parseCommandLine (argInfo : UnionArgInfo) (programName : string) (description : string option) - (exiter : IExiter) (raiseOnUsage : bool) (ignoreUnrecognized : bool) - (inputs : string []) = +and parseCommandLine (argInfo : UnionArgInfo) (programName : string) (description : string option) (width : int) (exiter : IExiter) + (raiseOnUsage : bool) (ignoreUnrecognized : bool) (inputs : string []) = let state = { Reader = new CliTokenReader(inputs) ProgramName = programName Description = description + UsageStringCharWidth = width RaiseOnUsage = raiseOnUsage IgnoreUnrecognizedArgs = ignoreUnrecognized Exiter = exiter @@ -442,8 +435,9 @@ let postProcessResults (argInfo : UnionArgInfo) (ignoreMissingMandatory : bool) /// Create a ParseResult<_> instance from a set of template parameters -let mkParseResultFromValues (info : UnionArgInfo) (exiter : IExiter) - (mkUsageString : string option -> string) (values : seq<'Template>) = +let mkParseResultFromValues (info : UnionArgInfo) (exiter : IExiter) (width : int) + (programName : string) (description : string option) + (values : seq<'Template>) = let agg = info.Cases |> Array.map (fun _ -> new ResizeArray()) values |> Seq.iteri (fun i value -> @@ -461,4 +455,4 @@ let mkParseResultFromValues (info : UnionArgInfo) (exiter : IExiter) Cases = agg |> Array.map (fun rs -> rs.ToArray()) } - new ParseResult<'Template>(info, results, mkUsageString, exiter) \ No newline at end of file + new ParseResult<'Template>(info, results, programName, description, width, exiter) \ No newline at end of file diff --git a/src/Argu/PreCompute.fs b/src/Argu/PreCompute.fs index 9afa1368..78e3cdc4 100644 --- a/src/Argu/PreCompute.fs +++ b/src/Argu/PreCompute.fs @@ -84,7 +84,7 @@ let primitiveParsers = let (|UnionParseResult|Optional|List|Other|) (t : Type) = if t.IsGenericType then let gt = t.GetGenericTypeDefinition() - if gt = typedefof> then UnionParseResult(t.GetGenericArguments().[0]) + if typeof.IsAssignableFrom t then UnionParseResult(t.GetGenericArguments().[0]) elif gt = typedefof<_ option> then Optional(t.GetGenericArguments().[0]) elif gt = typedefof<_ list> then List(t.GetGenericArguments().[0]) else Other @@ -105,7 +105,6 @@ let private validCliParamRegex = new Regex(@"\S+", RegexOptions.Compiled ||| Reg let validateCliParam (name : string) = if name = null || not <| validCliParamRegex.IsMatch name then arguExn "CLI parameter '%s' contains invalid characters." name - /// extracts the subcommand argument hierarchy for given UnionArgInfo let getHierarchy (uai : UnionArgInfo) = diff --git a/src/Argu/Types.fs b/src/Argu/Types.fs index 2217e516..facf5d92 100644 --- a/src/Argu/Types.fs +++ b/src/Argu/Types.fs @@ -160,7 +160,7 @@ type ProcessExiter() = interface IExiter with member __.Name = "Process Exiter" member __.Exit(msg : string, errorCode : ErrorCode) = - Console.Error.WriteLine msg + Console.Error.WriteLine (msg) do Console.Error.Flush() exit (int errorCode) diff --git a/src/Argu/UnParsers.fs b/src/Argu/UnParsers.fs index 7089c08c..e11c7e91 100644 --- a/src/Argu/UnParsers.fs +++ b/src/Argu/UnParsers.fs @@ -11,20 +11,31 @@ open FSharp.Reflection /// /// print the command line syntax /// -let printCommandLineSyntax (argInfo : UnionArgInfo) (programName : string) = stringExpr { +let printCommandLineSyntax (argInfo : UnionArgInfo) (prefix : string) (width : int) (programName : string) = stringExpr { + do if width < 1 then raise <| new ArgumentOutOfRangeException("width", "must be positive number") + let! length0 = StringExpr.currentLength + yield prefix yield programName for command in getHierarchy argInfo do yield ' ' yield command.Name + + let! length1 = StringExpr.currentLength + let offset = length1 - length0 + let length = ref length1 + + let insertCutoffLine() = stringExpr { + let! length1 = StringExpr.currentLength + if length1 - !length > width then + yield Environment.NewLine + yield String(' ', offset) + length := length1 + offset + 1 + } - let sorted = - argInfo.Cases - |> Seq.filter (fun aI -> not aI.IsHidden) - |> Seq.sortBy (fun aI -> not aI.IsFirst, aI.IsRest || aI.Type = ArgumentType.SubCommand, aI.Tag) - |> Seq.toArray + for aI in argInfo.Cases |> Seq.filter (fun aI -> not aI.IsHidden) do + yield! insertCutoffLine() - for aI in sorted do match aI.CommandLineNames with | [] -> () | name :: _ -> @@ -59,7 +70,7 @@ let printCommandLineSyntax (argInfo : UnionArgInfo) (programName : string) = str if not aI.IsMandatory then yield ']' match argInfo.HelpParam.Flags with - | h :: _ -> yield sprintf " [%s]" h + | h :: _ -> yield! insertCutoffLine() ; yield sprintf " [%s]" h | _ -> () } @@ -142,32 +153,20 @@ let printHelpParam (hp : HelpParam) = stringExpr { /// /// print usage string for a collection of arg infos /// -let printUsage (argInfo : UnionArgInfo) programName (description : string option) (msg : string option) = stringExpr { - match msg with - | Some u -> yield u - | None -> - match description with - | Some d -> yield d ; yield Environment.NewLine; yield Environment.NewLine - | None -> () +let printUsage (argInfo : UnionArgInfo) (programName : string) width (message : string option) = stringExpr { + match message with + | Some msg -> yield msg; yield Environment.NewLine + | None -> () - yield "USAGE: " ; yield! printCommandLineSyntax argInfo programName + yield! printCommandLineSyntax argInfo "USAGE: " width programName let options, subcommands = argInfo.Cases |> Seq.filter (fun aI -> not aI.IsHidden) |> Seq.partition (fun aI -> aI.Type <> ArgumentType.SubCommand) - if options.Length > 0 || argInfo.UsesHelpParam then - yield Environment.NewLine; yield Environment.NewLine - yield "OPTIONS:" - yield Environment.NewLine; yield Environment.NewLine - - for aI in options do yield! printArgUsage aI - - yield! printHelpParam argInfo.HelpParam - if subcommands.Length > 0 then - yield Environment.NewLine + yield Environment.NewLine; yield Environment.NewLine yield "SUBCOMMANDS:" yield Environment.NewLine; yield Environment.NewLine @@ -179,6 +178,16 @@ let printUsage (argInfo : UnionArgInfo) programName (description : string option yield Environment.NewLine yield sprintf "\tUse '%s %s' for additional information." programName helpflag yield Environment.NewLine + + if options.Length > 0 || argInfo.UsesHelpParam then + if subcommands.Length = 0 then yield Environment.NewLine + yield Environment.NewLine + yield "OPTIONS:" + yield Environment.NewLine; yield Environment.NewLine + + for aI in options do yield! printArgUsage aI + + yield! printHelpParam argInfo.HelpParam } /// @@ -227,7 +236,7 @@ let rec printCommandLineArgs (argInfo : UnionArgInfo) (args : seq) = | NestedUnion (_, nested) -> yield clname - let nestedResult = fields.[0] :?> IParseResults + let nestedResult = fields.[0] :?> IParseResult yield! printCommandLineArgs nested (nestedResult.GetAllResults()) } @@ -286,7 +295,7 @@ let printAppSettings (argInfo : UnionArgInfo) printComments (args : 'Template li yield ' ' - } |> String.build + } |> StringExpr.build mkElem mkComment key values diff --git a/src/Argu/UnionArgInfo.fs b/src/Argu/UnionArgInfo.fs index 6b2942da..f8bed5c7 100644 --- a/src/Argu/UnionArgInfo.fs +++ b/src/Argu/UnionArgInfo.fs @@ -13,6 +13,9 @@ open FSharp.Reflection open FSharp.Quotations open FSharp.Quotations.Patterns +type IParseResult = + abstract GetAllResults : unit -> seq + /// Union Case Field info [] type FieldParserInfo = @@ -23,9 +26,9 @@ type FieldParserInfo = Label : string option /// field type Type : Type - /// parser + /// string to field value parser Parser : string -> obj - /// unparser + /// field value to string unparser UnParser : obj -> string } with @@ -173,7 +176,6 @@ type UnionParseResults = IsUsageRequested : bool } - type UnionCaseArgInfo with member ucai.ToArgumentCaseInfo() : ArgumentCaseInfo = { diff --git a/src/Argu/Utils.fs b/src/Argu/Utils.fs index d2cb81d3..4873ac40 100644 --- a/src/Argu/Utils.fs +++ b/src/Argu/Utils.fs @@ -34,6 +34,11 @@ module internal Utils = | 0 -> invalidArg "xs" "input array is empty." | n -> ts.[n - 1] + let tryLast (ts : 'T[]) = + match ts.Length with + | 0 -> None + | n -> Some ts.[n-1] + [] module List = @@ -207,30 +212,36 @@ module internal Utils = // string builder compexpr - type StringExpr = StringBuilder -> unit + type StringExpr<'T> = StringBuilder -> 'T type StringExprBuilder () = - member __.Zero () : StringExpr = ignore - member __.Yield (txt : string) : StringExpr = fun b -> b.Append txt |> ignore - member __.Yield (c : char) : StringExpr = fun b -> b.Append c |> ignore - member __.YieldFrom f = f : StringExpr + member __.Zero () : StringExpr = ignore + member __.Bind(f : StringExpr<'T>, g : 'T -> StringExpr<'S>) : StringExpr<'S> = + fun sb -> g (f sb) sb - member __.Combine(f : StringExpr, g : StringExpr) : StringExpr = fun b -> f b; g b - member __.Delay (f : unit -> StringExpr) : StringExpr = fun b -> f () b + member __.Yield (txt : string) : StringExpr = fun b -> b.Append txt |> ignore + member __.Yield (c : char) : StringExpr = fun b -> b.Append c |> ignore + member __.YieldFrom (f : StringExpr) = f + + member __.Combine(f : StringExpr, g : StringExpr<'T>) : StringExpr<'T> = fun b -> f b; g b + member __.Delay (f : unit -> StringExpr<'T>) : StringExpr<'T> = fun b -> f () b - member __.For (xs : 'a seq, f : 'a -> StringExpr) : StringExpr = + member __.For (xs : 'a seq, f : 'a -> StringExpr) : StringExpr = fun b -> use e = xs.GetEnumerator () while e.MoveNext() do f e.Current b - member __.While (p : unit -> bool, f : StringExpr) : StringExpr = + member __.While (p : unit -> bool, f : StringExpr) : StringExpr = fun b -> while p () do f b let stringExpr = new StringExprBuilder () [] - module String = - let build (f : StringExpr) = + [] + module StringExpr = + let build (f : StringExpr) = let b = new StringBuilder () do f b - b.ToString () \ No newline at end of file + b.ToString () + + let currentLength : StringExpr = fun sb -> sb.Length \ No newline at end of file diff --git a/tests/Argu.Tests/Argu.Tests.fsproj b/tests/Argu.Tests/Argu.Tests.fsproj index 90ef91ef..6ba8a8de 100644 --- a/tests/Argu.Tests/Argu.Tests.fsproj +++ b/tests/Argu.Tests/Argu.Tests.fsproj @@ -186,7 +186,7 @@ ..\..\packages\FSharp.Core\lib\net40\FSharp.Core.dll - True + False True diff --git a/tests/Argu.Tests/Tests.fs b/tests/Argu.Tests/Tests.fs index 2a5c7dbe..c067f093 100644 --- a/tests/Argu.Tests/Tests.fs +++ b/tests/Argu.Tests/Tests.fs @@ -94,7 +94,7 @@ module ``Argu Tests`` = [] let ``Simple AppSettings parsing`` () = let args = [ Mandatory_Arg true ; Detach ; Listener ("localhost", 8080) ; Log_Level 2 ] |> List.sortBy tagOf - let xmlSource = parser.PrintAppSettings args + let xmlSource = parser.PrintAppSettingsArguments args let xmlFile = Path.GetTempFileName() do File.WriteAllText(xmlFile, xmlSource) let reader = ConfigurationReader.FromAppSettingsFile(xmlFile) @@ -184,28 +184,28 @@ module ``Argu Tests`` = [] let ``Usage documents explicitly named argument union case values`` () = - let usage = parser.Usage() + let usage = parser.PrintUsage() usage.Contains "" |> should equal true usage.Contains "" |> should equal true [] let ``Parse byte[] parameters`` () = let bytes = [|1uy .. 255uy|] - let args = parser.PrintCommandLine [ Mandatory_Arg false ; Data(42, bytes) ] + let args = parser.PrintCommandLineArguments [ Mandatory_Arg false ; Data(42, bytes) ] let results = parser.ParseCommandLine args results.GetResult <@ Data @> |> snd |> should equal bytes [] let ``Parse equals assignment`` () = let arg = [ Assignment "foo bar" ] - let clp = parser.PrintCommandLine arg + let clp = parser.PrintCommandLineArguments arg let result = parser.Parse(clp, ignoreMissing = true) result.GetResult <@ Assignment @> |> should equal "foo bar" [] let ``Parse key-value equals assignment`` () = let arg = [ Env("foo", "bar") ] - let clp = parser.PrintCommandLine arg + let clp = parser.PrintCommandLineArguments arg let result = parser.Parse(clp, ignoreMissing = true) result.GetResult <@ Env @> |> should equal ("foo", "bar") @@ -447,7 +447,7 @@ module ``Argu Tests`` = [] let ``Custom Help Description attribute`` () = let parser = ArgumentParser.Create() - parser.Usage().Contains "waka jawaka" |> should equal true + parser.PrintUsage().Contains "waka jawaka" |> should equal true [] let ``Custom Help attribute should not use default helper`` () = diff --git a/tests/Argu.Tests/tests.fsx b/tests/Argu.Tests/tests.fsx index 2d55dc66..9865090a 100644 --- a/tests/Argu.Tests/tests.fsx +++ b/tests/Argu.Tests/tests.fsx @@ -2,6 +2,7 @@ #r "Argu.dll" #r "Argu.Tests.dll" +open System open Argu open Argu.Tests @@ -56,15 +57,18 @@ with let parser = ArgumentParser.Create(programName = "gadget", description = "Gadget -- my awesome CLI tool") -parser.PrintCommandLineFlat [Push(toParseResults [Remote "origin" ; Branch "master"])] +parser.PrintCommandLineArgumentsFlat [Push(toParseResults [Remote "origin" ; Branch "master"])] let result = parser.Parse [| "--ports" ; "1" ; "2" ; "3" ; "clean" ; "-fdx" |] -let nested = result.GetResult <@ Clean @> +let cresult = result.GetResult <@ Clean @> -result.GetAllResults() -result.Usage() |> System.Console.WriteLine -nested.Usage() |> System.Console.WriteLine +let pparser = parser.GetSubParser <@ Push @> +let cparser = parser.GetSubParser <@ Clean @> -parser.PrintCommandLineSyntax() +parser.PrintUsage("Ooops\n") |> Console.WriteLine +pparser.PrintUsage() |> Console.WriteLine +cparser.PrintUsage() |> Console.WriteLine -parser.GetSubParser(<@ Clean @>).PrintCommandLineSyntax() \ No newline at end of file +parser.PrintCommandLineSyntax(usageStringCharacterWidth = 1000) |> Console.WriteLine +pparser.PrintCommandLineSyntax() |> Console.WriteLine +cparser.PrintCommandLineSyntax() |> Console.WriteLine \ No newline at end of file