Compare commits

..

5 Commits

Author SHA1 Message Date
Patrick Stevens
038b424906 Add type-level help text support to ArgParser generator (#457)
The ArgumentHelpText attribute can now be applied to the record type itself
to display help text at the top of the --help output, before field descriptions.
This enables better documentation of command-line argument parsers.

Features:
- Type-level help text appears before argument list
- Multiline help text is supported
- Backward compatible with existing code
- Help text appears in both --help and error messages

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-authored-by: Claude <noreply@anthropic.com>
2025-11-21 06:32:55 +00:00
Patrick Stevens
2fc8ba958c Add IAsyncDisposable support in mock generators (#456)
* Add IAsyncDisposable support to mock generators

Extend both GenerateMock and GenerateCapturingMock to support interfaces
that inherit IAsyncDisposable, mirroring the existing IDisposable pattern.

Changes:
- Add IAsyncDisposable to KnownInheritance type
- Detect IAsyncDisposable inheritance in interface parsing
- Generate DisposeAsync field with ValueTask return type
- Initialize DisposeAsync with completed ValueTask() in Empty mock
- Implement System.IAsyncDisposable interface explicitly
- Support interfaces inheriting both IDisposable and IAsyncDisposable

Test cases added:
- TypeWithAsyncDisposable: interface with only IAsyncDisposable
- TypeWithBothDisposables: interface with both disposal interfaces

🤖 Generated with [Claude Code](https://claude.com/claude-code)
2025-11-20 08:59:30 +00:00
Patrick Stevens
67e051b6b3 Add --no- prefix for bools (#455)
Implements support for --no- prefix negation on boolean and flag DU fields
when marked with [<ArgumentNegateWithPrefix>]. This allows both --flag and
--no-flag forms to be accepted, with --no- variants negating the value.

Changes:
- Extend ArgParserGenerator to generate --no- prefix handling
- Add conflict detection for overlapping --no- prefixed arguments
- Update help text to display both forms (e.g., --verbose / --no-verbose)
- Add test examples in ArgParserNegationTests.fs demonstrating:
  - Boolean field negation
  - Flag DU negation
  - Multiple ArgumentLongForm with negation
  - Combined features (defaults, help text)

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude <noreply@anthropic.com>
2025-11-19 07:53:15 +00:00
dependabot[bot]
6dee454229 Bump ApiSurface from 5.0.2 to 5.0.3 (#452)
* Bump ApiSurface from 5.0.2 to 5.0.3

---
updated-dependencies:
- dependency-name: ApiSurface
  dependency-version: 5.0.3
  dependency-type: direct:production
  update-type: version-update:semver-patch
- dependency-name: ApiSurface
  dependency-version: 5.0.3
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Bump fsharp-analyzers from 0.33.1 to 0.34.1

---
updated-dependencies:
- dependency-name: fsharp-analyzers
  dependency-version: 0.34.1
  dependency-type: direct:production
  update-type: version-update:semver-minor
...

Signed-off-by: dependabot[bot] <support@github.com>

* Bump Microsoft.NET.Test.Sdk from 18.0.0 to 18.0.1

---
updated-dependencies:
- dependency-name: Microsoft.NET.Test.Sdk
  dependency-version: 18.0.1
  dependency-type: direct:production
  update-type: version-update:semver-patch
- dependency-name: Microsoft.NET.Test.Sdk
  dependency-version: 18.0.1
  dependency-type: direct:production
  update-type: version-update:semver-patch
...

Signed-off-by: dependabot[bot] <support@github.com>

* Deps

* Analyzers too

---------

Signed-off-by: dependabot[bot] <support@github.com>
Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com>
Co-authored-by: Smaug123 <3138005+Smaug123@users.noreply.github.com>
2025-11-17 22:29:40 +00:00
patrick-conscriptus[bot]
e1767f5ed0 Automated commit (#451)
Co-authored-by: patrick-conscriptus[bot] <175414948+patrick-conscriptus[bot]@users.noreply.github.com>
2025-11-16 01:43:42 +00:00
30 changed files with 3107 additions and 216 deletions

View File

@@ -9,10 +9,16 @@
]
},
"fsharp-analyzers": {
"version": "0.33.1",
"version": "0.34.1",
"commands": [
"fsharp-analyzers"
]
},
"woofware.nunittestrunner": {
"version": "0.3.9",
"commands": [
"woofware.nunittestrunner"
]
}
}
}

View File

@@ -1,5 +1,16 @@
Notable changes are recorded here.
# WoofWare.Myriad.Plugins 9.1.1, WoofWare.Myriad.Plugins.Attributes 3.8.1
Adds the `[<ArgumentNegateWithPrefix>]` attribute, which can be placed on a boolean or flag-valued field when using the `ArgParser` generator.
This causes the boolean to be specifiable with the `--no-` prefix to negate its value.
(For example, `Foo : bool` is normally specified as `--foo`; this new attribute lets the user additionally give `--no-foo` to get the same semantics as `--foo=false`.)
# WoofWare.Myriad.Plugins 9.0.1
Converts the `static member Empty` field on each generated mock (from `GeneratedMock`) into a function, so as to permit the `GeneratedCapturingMock` to have the same signature.
(`GeneratedCapturingMock` contains mutable state, so must be created afresh each time.)
# WoofWare.Myriad.Plugins 8.1.1
Adds `GenerateCapturingMock`, which is `GenerateMock` but additionally records the calls made to each function.

View File

@@ -0,0 +1,124 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
// This file contains test cases for conflict detection in the ArgParser generator.
// These are expected to FAIL at build time with appropriate error messages.
// Uncomment each section one at a time to test the specific conflict detection.
// ============================================================================
// Test 1: Field named NoFooBar conflicts with FooBar's --no- variant
// ============================================================================
// Expected error: Argument name conflict: '--no-foo-bar' collides with the --no- variant
// of field 'FooBar' (which has [<ArgumentNegateWithPrefix>])
(*
[<ArgParser>]
type ConflictingFieldNames =
{
[<ArgumentNegateWithPrefix>]
FooBar : bool
NoFooBar : bool
}
*)
// ============================================================================
// Test 2: ArgumentLongForm "no-foo" conflicts with Foo's --no- variant
// ============================================================================
// Expected error: Argument name conflict: '--no-foo' collides with the --no- variant
// of field 'Foo' (which has [<ArgumentNegateWithPrefix>])
(*
[<ArgParser>]
type ConflictingLongForm =
{
[<ArgumentNegateWithPrefix>]
Foo : bool
[<ArgumentLongForm "no-foo">]
Bar : bool
}
*)
// ============================================================================
// Test 3: Multiple ArgumentLongForm, one conflicts
// ============================================================================
// Expected error: Argument name conflict: '--no-verbose' collides with...
(*
[<ArgParser>]
type ConflictingMultipleLongForms =
{
[<ArgumentLongForm "verbose">]
[<ArgumentLongForm "v">]
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
[<ArgumentLongForm "no-verbose">]
Quiet : bool
}
*)
// ============================================================================
// Test 4: ArgumentNegateWithPrefix on non-boolean field
// ============================================================================
// Expected error: [<ArgumentNegateWithPrefix>] can only be applied to boolean
// or flag DU fields, but was applied to field NotABool of type string
(*
[<ArgParser>]
type InvalidAttributeOnNonBool =
{
[<ArgumentNegateWithPrefix>]
NotABool : string
}
*)
// ============================================================================
// Test 5: ArgumentNegateWithPrefix on non-flag int field
// ============================================================================
// Expected error: [<ArgumentNegateWithPrefix>] can only be applied to boolean
// or flag DU fields
(*
[<ArgParser>]
type InvalidAttributeOnInt =
{
[<ArgumentNegateWithPrefix>]
NotAFlag : int
}
*)
// ============================================================================
// Test 6: Complex conflict with custom names
// ============================================================================
// This tests a more complex scenario where a custom ArgumentLongForm creates
// a conflict with a different field's negated form
(*
[<ArgParser>]
type ComplexConflict =
{
[<ArgumentLongForm "enable">]
[<ArgumentNegateWithPrefix>]
FeatureA : bool
[<ArgumentLongForm "no-enable">]
DisableAll : bool
}
*)
// ============================================================================
// Test 7: Valid usage - no conflicts (this SHOULD compile)
// ============================================================================
[<ArgParser>]
type NoConflict =
{
[<ArgumentNegateWithPrefix>]
EnableFeature : bool
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
NormalField : string
}

View File

@@ -0,0 +1,48 @@
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
// Test types for ArgumentNegateWithPrefix functionality
type TestDryRunMode =
| [<ArgumentFlag false>] Wet
| [<ArgumentFlag true>] Dry
[<ArgParser true>]
type BoolNegation =
{
[<ArgumentNegateWithPrefix>]
EnableFeature : bool
}
[<ArgParser true>]
type FlagNegation =
{
[<ArgumentNegateWithPrefix>]
DryRun : TestDryRunMode
}
[<ArgParser true>]
type MultipleFormsNegation =
{
[<ArgumentLongForm "verbose">]
[<ArgumentLongForm "v">]
[<ArgumentNegateWithPrefix>]
VerboseMode : bool
}
[<ArgParser true>]
type CombinedFeatures =
{
[<ArgumentNegateWithPrefix>]
[<ArgumentDefaultFunction>]
Verbose : Choice<bool, bool>
[<ArgumentNegateWithPrefix>]
[<ArgumentHelpText "Enable debug mode">]
Debug : bool
NormalBool : bool
}
static member DefaultVerbose () = false

View File

@@ -235,3 +235,27 @@ type FlagsIntoPositionalArgs' =
[<PositionalArgs false>]
DontGrabEverything : string list
}
[<ArgParser>]
[<ArgumentHelpText "Parse command-line arguments for a basic configuration. This help text appears before the argument list.">]
type WithTypeHelp =
{
[<ArgumentHelpText "The configuration file path">]
ConfigFile : string
[<ArgumentHelpText "Enable verbose output">]
Verbose : bool
Port : int
}
[<ArgParser>]
[<ArgumentHelpText "This is a multiline help text example.
It spans multiple lines to test that multiline strings work correctly.
You can use this to provide detailed documentation for your argument parser.">]
type WithMultilineTypeHelp =
{
[<ArgumentHelpText "Input file to process">]
InputFile : string
[<ArgumentHelpText "Output directory">]
OutputDir : string
Force : bool
}

View File

@@ -55,3 +55,15 @@ type TypeWithProperties =
abstract Mem1 : string option -> string[] Async
abstract Prop1 : int
abstract Prop2 : unit Async
[<GenerateCapturingMock>]
type TypeWithAsyncDisposable =
inherit IAsyncDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async
[<GenerateCapturingMock>]
type TypeWithBothDisposables =
inherit IDisposable
inherit IAsyncDisposable
abstract Mem1 : string -> int

View File

@@ -89,6 +89,17 @@
<Compile Include="GeneratedArgs.fs">
<MyriadFile>Args.fs</MyriadFile>
</Compile>
<Compile Include="ArgParserNegationTests.fs" />
<Compile Include="GeneratedArgParserNegationTests.fs">
<MyriadFile>ArgParserNegationTests.fs</MyriadFile>
</Compile>
<!-- Not compiled, because by design they *don't* compile. That makes them very hard to test in an automated way! -->
<None Include="ArgParserConflictTests.fs" />
<!-- To run the conflict tests:
<Compile Include="GeneratedArgParserConflictTests.fs">
<MyriadFile>ArgParserConflictTests.fs</MyriadFile>
</Compile>
-->
<None Include="swagger-gitea.json" />
<Compile Include="GeneratedSwaggerGitea.fs">
<MyriadFile>swagger-gitea.json</MyriadFile>

File diff suppressed because it is too large Load Diff

View File

@@ -4346,3 +4346,438 @@ module FlagsIntoPositionalArgs'ArgParse =
static member parse (args : string list) : FlagsIntoPositionalArgs' =
FlagsIntoPositionalArgs'.parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type WithTypeHelp
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module WithTypeHelp =
type private ParseState_WithTypeHelp =
/// Ready to consume a key or positional arg
| AwaitingKey
/// Waiting to receive a value for the key we've already consumed
| AwaitingValue of key : string
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : WithTypeHelp =
let ArgParser_errors = ResizeArray ()
let helpText () =
[
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
""
(sprintf
"%s string%s%s"
(sprintf "--%s" "config-file")
""
(sprintf " : %s" ("The configuration file path")))
(sprintf "%s bool%s%s" (sprintf "--%s" "verbose") "" (sprintf " : %s" ("Enable verbose output")))
(sprintf "%s int32%s%s" (sprintf "--%s" "port") "" "")
]
|> String.concat "\n"
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
let mutable arg_0 : string option = None
let mutable arg_1 : bool option = None
let mutable arg_2 : int option = None
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "port", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "port")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_2 <- value |> (fun x -> System.Int32.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if System.String.Equals (key, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
match arg_1 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "verbose")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_1 <- value |> (fun x -> System.Boolean.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "config-file", System.StringComparison.OrdinalIgnoreCase)
then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "config-file")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool =
if System.String.Equals (key, sprintf "--%s" "verbose", System.StringComparison.OrdinalIgnoreCase) then
match arg_1 with
| Some x ->
sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "verbose")
|> ArgParser_errors.Add
true
| None ->
arg_1 <- true |> Some
true
else
false
let rec go (state : ParseState_WithTypeHelp) (args : string list) =
match args with
| [] ->
match state with
| ParseState_WithTypeHelp.AwaitingKey -> ()
| ParseState_WithTypeHelp.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
| arg :: args ->
match state with
| ParseState_WithTypeHelp.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_WithTypeHelp.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
| Error x ->
match x with
| None ->
failwithf "Unable to process argument %s as key %s and value %s" arg key value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_WithTypeHelp.AwaitingKey args
else
arg |> (fun x -> x) |> parser_LeftoverArgs.Add
go ParseState_WithTypeHelp.AwaitingKey args
| ParseState_WithTypeHelp.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_WithTypeHelp.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_WithTypeHelp.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_WithTypeHelp.AwaitingKey args
let parser_LeftoverArgs =
if 0 = parser_LeftoverArgs.Count then
()
else
parser_LeftoverArgs
|> String.concat " "
|> sprintf "There were leftover args: %s"
|> ArgParser_errors.Add
Unchecked.defaultof<_>
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "config-file")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_1 =
match arg_1 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "verbose")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_2 =
match arg_2 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "port")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
ConfigFile = arg_0
Port = arg_2
Verbose = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
let parse (args : string list) : WithTypeHelp =
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args
namespace ConsumePlugin
open System
open System.IO
open WoofWare.Myriad.Plugins
/// Methods to parse arguments for the type WithMultilineTypeHelp
[<RequireQualifiedAccess ; CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module WithMultilineTypeHelp =
type private ParseState_WithMultilineTypeHelp =
/// Ready to consume a key or positional arg
| AwaitingKey
/// Waiting to receive a value for the key we've already consumed
| AwaitingValue of key : string
let parse' (getEnvironmentVariable : string -> string option) (args : string list) : WithMultilineTypeHelp =
let ArgParser_errors = ResizeArray ()
let helpText () =
[
"This is a multiline help text example.
It spans multiple lines to test that multiline strings work correctly.
You can use this to provide detailed documentation for your argument parser."
""
(sprintf "%s string%s%s" (sprintf "--%s" "input-file") "" (sprintf " : %s" ("Input file to process")))
(sprintf "%s string%s%s" (sprintf "--%s" "output-dir") "" (sprintf " : %s" ("Output directory")))
(sprintf "%s bool%s%s" (sprintf "--%s" "force") "" "")
]
|> String.concat "\n"
let parser_LeftoverArgs : string ResizeArray = ResizeArray ()
let mutable arg_0 : string option = None
let mutable arg_1 : string option = None
let mutable arg_2 : bool option = None
/// Processes the key-value pair, returning Error if no key was matched.
/// If the key is an arg which can have arity 1, but throws when consuming that arg, we return Error(<the message>).
/// This can nevertheless be a successful parse, e.g. when the key may have arity 0.
let processKeyValue (key : string) (value : string) : Result<unit, string option> =
if System.String.Equals (key, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "force")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_2 <- value |> (fun x -> System.Boolean.Parse x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "output-dir", System.StringComparison.OrdinalIgnoreCase)
then
match arg_1 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "output-dir")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_1 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else if
System.String.Equals (key, sprintf "--%s" "input-file", System.StringComparison.OrdinalIgnoreCase)
then
match arg_0 with
| Some x ->
sprintf
"Argument '%s' was supplied multiple times: %s and %s"
(sprintf "--%s" "input-file")
(x.ToString ())
(value.ToString ())
|> ArgParser_errors.Add
Ok ()
| None ->
try
arg_0 <- value |> (fun x -> x) |> Some
Ok ()
with _ as exc ->
exc.Message |> Some |> Error
else
Error None
/// Returns false if we didn't set a value.
let setFlagValue (key : string) : bool =
if System.String.Equals (key, sprintf "--%s" "force", System.StringComparison.OrdinalIgnoreCase) then
match arg_2 with
| Some x ->
sprintf "Flag '%s' was supplied multiple times" (sprintf "--%s" "force")
|> ArgParser_errors.Add
true
| None ->
arg_2 <- true |> Some
true
else
false
let rec go (state : ParseState_WithMultilineTypeHelp) (args : string list) =
match args with
| [] ->
match state with
| ParseState_WithMultilineTypeHelp.AwaitingKey -> ()
| ParseState_WithMultilineTypeHelp.AwaitingValue key ->
if setFlagValue key then
()
else
sprintf
"Trailing argument %s had no value. Use a double-dash to separate positional args from key-value args."
key
|> ArgParser_errors.Add
| "--" :: rest -> parser_LeftoverArgs.AddRange (rest |> Seq.map (fun x -> x))
| arg :: args ->
match state with
| ParseState_WithMultilineTypeHelp.AwaitingKey ->
if arg.StartsWith ("--", System.StringComparison.Ordinal) then
if arg = "--help" then
helpText () |> failwithf "Help text requested.\n%s"
else
let equals = arg.IndexOf (char 61)
if equals < 0 then
args |> go (ParseState_WithMultilineTypeHelp.AwaitingValue arg)
else
let key = arg.[0 .. equals - 1]
let value = arg.[equals + 1 ..]
match processKeyValue key value with
| Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
| Error x ->
match x with
| None ->
failwithf "Unable to process argument %s as key %s and value %s" arg key value
| Some msg ->
sprintf "%s (at arg %s)" msg arg |> ArgParser_errors.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
else
arg |> (fun x -> x) |> parser_LeftoverArgs.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
| ParseState_WithMultilineTypeHelp.AwaitingValue key ->
match processKeyValue key arg with
| Ok () -> go ParseState_WithMultilineTypeHelp.AwaitingKey args
| Error exc ->
if setFlagValue key then
go ParseState_WithMultilineTypeHelp.AwaitingKey (arg :: args)
else
match exc with
| None ->
failwithf "Unable to process supplied arg %s. Help text follows.\n%s" key (helpText ())
| Some msg -> msg |> ArgParser_errors.Add
go ParseState_WithMultilineTypeHelp.AwaitingKey args
let parser_LeftoverArgs =
if 0 = parser_LeftoverArgs.Count then
()
else
parser_LeftoverArgs
|> String.concat " "
|> sprintf "There were leftover args: %s"
|> ArgParser_errors.Add
Unchecked.defaultof<_>
let arg_0 =
match arg_0 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "input-file")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_1 =
match arg_1 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "output-dir")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
let arg_2 =
match arg_2 with
| None ->
sprintf "Required argument '%s' received no value" (sprintf "--%s" "force")
|> ArgParser_errors.Add
Unchecked.defaultof<_>
| Some x -> x
if 0 = ArgParser_errors.Count then
{
Force = arg_2
InputFile = arg_0
OutputDir = arg_1
}
else
ArgParser_errors |> String.concat "\n" |> failwithf "Errors during parse!\n%s"
let parse (args : string list) : WithMultilineTypeHelp =
parse' (System.Environment.GetEnvironmentVariable >> Option.ofObj) args

View File

@@ -36,7 +36,7 @@ type internal PublicTypeMock =
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PublicTypeMock =
{
Calls = PublicTypeMockCalls.Calls.Empty ()
@@ -89,7 +89,7 @@ type public PublicTypeInternalFalseMock =
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PublicTypeInternalFalseMock =
{
Calls = PublicTypeInternalFalseMockCalls.Calls.Empty ()
@@ -139,7 +139,7 @@ type internal InternalTypeMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : InternalTypeMock =
{
Calls = InternalTypeMockCalls.Calls.Empty ()
@@ -184,7 +184,7 @@ type private PrivateTypeMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PrivateTypeMock =
{
Calls = PrivateTypeMockCalls.Calls.Empty ()
@@ -229,7 +229,7 @@ type private PrivateTypeInternalFalseMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PrivateTypeInternalFalseMock =
{
Calls = PrivateTypeInternalFalseMockCalls.Calls.Empty ()
@@ -271,7 +271,7 @@ type internal VeryPublicTypeMock<'a, 'b> =
Mem1 : 'a -> 'b
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> =
{
Calls = VeryPublicTypeMockCalls.Calls.Empty ()
@@ -365,7 +365,7 @@ type internal CurriedMock<'a> =
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : CurriedMock<'a> =
{
Calls = CurriedMockCalls.Calls.Empty ()
@@ -486,7 +486,7 @@ type internal TypeWithInterfaceMock =
Mem2 : unit -> string[] Async
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : TypeWithInterfaceMock =
{
Calls = TypeWithInterfaceMockCalls.Calls.Empty ()
@@ -540,7 +540,7 @@ type internal TypeWithPropertiesMock =
Prop2 : unit -> unit Async
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : TypeWithPropertiesMock =
{
Calls = TypeWithPropertiesMockCalls.Calls.Empty ()
@@ -560,3 +560,103 @@ type internal TypeWithPropertiesMock =
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal TypeWithAsyncDisposableMockCalls =
/// All the calls made to a TypeWithAsyncDisposableMock mock
type internal Calls =
{
Mem1 : ResizeArray<string option>
Mem2 : ResizeArray<unit>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
Mem2 = ResizeArray ()
}
/// Mock record type for an interface
type internal TypeWithAsyncDisposableMock =
{
Calls : TypeWithAsyncDisposableMockCalls.Calls
/// Implementation of IAsyncDisposable.DisposeAsync
DisposeAsync : unit -> System.Threading.Tasks.ValueTask
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every non-disposal method throws.
static member Empty () : TypeWithAsyncDisposableMock =
{
Calls = TypeWithAsyncDisposableMockCalls.Calls.Empty ()
DisposeAsync = (fun () -> (System.Threading.Tasks.ValueTask ()))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithAsyncDisposable with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
member this.Mem2 () =
lock this.Calls.Mem2 (fun _ -> this.Calls.Mem2.Add (()))
this.Mem2 (())
interface System.IAsyncDisposable with
member this.DisposeAsync () : System.Threading.Tasks.ValueTask = this.DisposeAsync ()
namespace SomeNamespace.CapturingMock
open System
open WoofWare.Myriad.Plugins
[<RequireQualifiedAccess>]
module internal TypeWithBothDisposablesMockCalls =
/// All the calls made to a TypeWithBothDisposablesMock mock
type internal Calls =
{
Mem1 : ResizeArray<string>
}
/// A fresh calls object which has not yet had any calls made.
static member Empty () : Calls =
{
Mem1 = ResizeArray ()
}
/// Mock record type for an interface
type internal TypeWithBothDisposablesMock =
{
Calls : TypeWithBothDisposablesMockCalls.Calls
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
/// Implementation of IAsyncDisposable.DisposeAsync
DisposeAsync : unit -> System.Threading.Tasks.ValueTask
Mem1 : string -> int
}
/// An implementation where every non-disposal method throws.
static member Empty () : TypeWithBothDisposablesMock =
{
Calls = TypeWithBothDisposablesMockCalls.Calls.Empty ()
Dispose = (fun () -> ())
DisposeAsync = (fun () -> (System.Threading.Tasks.ValueTask ()))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface TypeWithBothDisposables with
member this.Mem1 arg_0_0 =
lock this.Calls.Mem1 (fun _ -> this.Calls.Mem1.Add (arg_0_0))
this.Mem1 (arg_0_0)
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()
interface System.IAsyncDisposable with
member this.DisposeAsync () : System.Threading.Tasks.ValueTask = this.DisposeAsync ()

View File

@@ -35,7 +35,7 @@ type internal PublicTypeNoAttrMock =
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PublicTypeNoAttrMock =
{
Calls = PublicTypeNoAttrMockCalls.Calls.Empty ()
@@ -87,7 +87,7 @@ type public PublicTypeInternalFalseNoAttrMock =
Mem3 : int * System.Threading.CancellationToken option -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PublicTypeInternalFalseNoAttrMock =
{
Calls = PublicTypeInternalFalseNoAttrMockCalls.Calls.Empty ()
@@ -136,7 +136,7 @@ type internal InternalTypeNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : InternalTypeNoAttrMock =
{
Calls = InternalTypeNoAttrMockCalls.Calls.Empty ()
@@ -180,7 +180,7 @@ type private PrivateTypeNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PrivateTypeNoAttrMock =
{
Calls = PrivateTypeNoAttrMockCalls.Calls.Empty ()
@@ -224,7 +224,7 @@ type private PrivateTypeInternalFalseNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : PrivateTypeInternalFalseNoAttrMock =
{
Calls = PrivateTypeInternalFalseNoAttrMockCalls.Calls.Empty ()
@@ -265,7 +265,7 @@ type internal VeryPublicTypeNoAttrMock<'a, 'b> =
Mem1 : 'a -> 'b
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : VeryPublicTypeNoAttrMock<'a, 'b> =
{
Calls = VeryPublicTypeNoAttrMockCalls.Calls.Empty ()
@@ -358,7 +358,7 @@ type internal CurriedNoAttrMock<'a> =
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : CurriedNoAttrMock<'a> =
{
Calls = CurriedNoAttrMockCalls.Calls.Empty ()
@@ -478,7 +478,7 @@ type internal TypeWithInterfaceNoAttrMock =
Mem2 : unit -> string[] Async
}
/// An implementation where every non-unit method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : TypeWithInterfaceNoAttrMock =
{
Calls = TypeWithInterfaceNoAttrMockCalls.Calls.Empty ()

View File

@@ -16,7 +16,7 @@ type internal PublicTypeMock =
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PublicTypeMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -41,7 +41,7 @@ type public PublicTypeInternalFalseMock =
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PublicTypeInternalFalseMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -65,7 +65,7 @@ type internal InternalTypeMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : InternalTypeMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -87,7 +87,7 @@ type private PrivateTypeMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PrivateTypeMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -109,7 +109,7 @@ type private PrivateTypeInternalFalseMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PrivateTypeInternalFalseMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -130,7 +130,7 @@ type internal VeryPublicTypeMock<'a, 'b> =
Mem1 : 'a -> 'b
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : VeryPublicTypeMock<'a, 'b> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -154,7 +154,7 @@ type internal CurriedMock<'a> =
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : CurriedMock<'a> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -192,7 +192,7 @@ type internal TypeWithInterfaceMock =
Mem2 : unit -> string[] Async
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : TypeWithInterfaceMock =
{
Dispose = (fun () -> ())
@@ -221,7 +221,7 @@ type internal TypeWithPropertiesMock =
Mem1 : string option -> string[] Async
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : TypeWithPropertiesMock =
{
Dispose = (fun () -> ())
@@ -237,3 +237,62 @@ type internal TypeWithPropertiesMock =
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type internal TypeWithAsyncDisposableMock =
{
/// Implementation of IAsyncDisposable.DisposeAsync
DisposeAsync : unit -> System.Threading.Tasks.ValueTask
Mem1 : string option -> string[] Async
Mem2 : unit -> string[] Async
}
/// An implementation where every non-disposal method throws.
static member Empty : TypeWithAsyncDisposableMock =
{
DisposeAsync = (fun () -> (System.Threading.Tasks.ValueTask ()))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem2"))
}
interface TypeWithAsyncDisposable with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
member this.Mem2 () = this.Mem2 (())
interface System.IAsyncDisposable with
member this.DisposeAsync () : System.Threading.Tasks.ValueTask = this.DisposeAsync ()
namespace SomeNamespace
open System
open WoofWare.Myriad.Plugins
/// Mock record type for an interface
type internal TypeWithBothDisposablesMock =
{
/// Implementation of IDisposable.Dispose
Dispose : unit -> unit
/// Implementation of IAsyncDisposable.DisposeAsync
DisposeAsync : unit -> System.Threading.Tasks.ValueTask
Mem1 : string -> int
}
/// An implementation where every non-disposal method throws.
static member Empty : TypeWithBothDisposablesMock =
{
Dispose = (fun () -> ())
DisposeAsync = (fun () -> (System.Threading.Tasks.ValueTask ()))
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
}
interface TypeWithBothDisposables with
member this.Mem1 arg_0_0 = this.Mem1 (arg_0_0)
interface System.IDisposable with
member this.Dispose () : unit = this.Dispose ()
interface System.IAsyncDisposable with
member this.DisposeAsync () : System.Threading.Tasks.ValueTask = this.DisposeAsync ()

View File

@@ -15,7 +15,7 @@ type internal PublicTypeNoAttrMock =
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PublicTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -39,7 +39,7 @@ type public PublicTypeInternalFalseNoAttrMock =
Mem3 : int * option<System.Threading.CancellationToken> -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PublicTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -62,7 +62,7 @@ type internal InternalTypeNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : InternalTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -83,7 +83,7 @@ type private PrivateTypeNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PrivateTypeNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -104,7 +104,7 @@ type private PrivateTypeInternalFalseNoAttrMock =
Mem2 : string -> int
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : PrivateTypeInternalFalseNoAttrMock =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -124,7 +124,7 @@ type internal VeryPublicTypeNoAttrMock<'a, 'b> =
Mem1 : 'a -> 'b
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : VeryPublicTypeNoAttrMock<'a, 'b> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -147,7 +147,7 @@ type internal CurriedNoAttrMock<'a> =
Mem6 : int * string -> 'a * int -> string
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty () : CurriedNoAttrMock<'a> =
{
Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function: Mem1"))
@@ -184,7 +184,7 @@ type internal TypeWithInterfaceNoAttrMock =
Mem2 : unit -> string[] Async
}
/// An implementation where every method throws.
/// An implementation where every non-disposal method throws.
static member Empty : TypeWithInterfaceNoAttrMock =
{
Dispose = (fun () -> ())

View File

@@ -55,3 +55,15 @@ type TypeWithProperties =
abstract Mem1 : string option -> string[] Async
abstract Prop1 : int
abstract Prop2 : unit Async
[<GenerateMock>]
type TypeWithAsyncDisposable =
inherit IAsyncDisposable
abstract Mem1 : string option -> string[] Async
abstract Mem2 : unit -> string[] Async
[<GenerateMock>]
type TypeWithBothDisposables =
inherit IDisposable
inherit IAsyncDisposable
abstract Mem1 : string -> int

View File

@@ -62,8 +62,10 @@ type ArgumentDefaultFunctionAttribute () =
type ArgumentDefaultEnvironmentVariableAttribute (envVar : string) =
inherit Attribute ()
/// Attribute indicating that this field shall have the given help text, when `--help` is invoked
/// Attribute indicating that this field or type shall have the given help text, when `--help` is invoked
/// or when a parse error causes us to print help text.
/// When applied to a record type, the help text appears at the top of the help output, before the field descriptions.
/// When applied to a field, the help text appears next to that field's description.
type ArgumentHelpTextAttribute (helpText : string) =
inherit Attribute ()
@@ -100,3 +102,24 @@ type ArgumentFlagAttribute (flagValue : bool) =
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
type ArgumentLongForm (s : string) =
inherit Attribute ()
/// Attribute indicating that this boolean or flag field should accept `--no-` prefix for negation.
/// When this attribute is present on a boolean or flag DU field, the generated parser will accept
/// both --field-name and --no-field-name as argument forms.
///
/// For boolean fields:
/// --field-name (or --field-name=true) sets the value to true
/// --no-field-name (or --no-field-name=true) sets the value to false
/// --field-name=false sets the value to false
/// --no-field-name=false sets the value to true
///
/// For flag DU fields with [<ArgumentFlag>]:
/// --field-name (or --field-name=true) sets to the case marked with [<ArgumentFlag true>]
/// --no-field-name (or --no-field-name=true) sets to the case marked with [<ArgumentFlag false>]
/// --field-name=false sets to the [<ArgumentFlag false>] case
/// --no-field-name=false sets to the [<ArgumentFlag true>] case
///
/// This attribute can only be applied to bool fields or flag DU fields (two-case DUs with [<ArgumentFlag>]).
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = false)>]
type ArgumentNegateWithPrefixAttribute () =
inherit Attribute ()

View File

@@ -13,6 +13,8 @@ WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentHelpTextAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentLongForm inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentLongForm..ctor [constructor]: string
WoofWare.Myriad.Plugins.ArgumentNegateWithPrefixAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.ArgumentNegateWithPrefixAttribute..ctor [constructor]: unit
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute inherit System.Attribute
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
WoofWare.Myriad.Plugins.GenerateCapturingMockAttribute inherit System.Attribute

View File

@@ -17,8 +17,8 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0"/>
<PackageReference Include="ApiSurface" Version="5.0.3" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.1"/>
<PackageReference Include="NUnit" Version="4.3.2"/>
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0"/>
</ItemGroup>

View File

@@ -1,5 +1,5 @@
{
"version": "3.7",
"version": "3.8",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],

View File

@@ -444,7 +444,7 @@ Required argument '--exact' received no value"""
]
|> List.map TestCaseData
[<TestCaseSource(nameof (boolCases))>]
[<TestCaseSource(nameof boolCases)>]
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
let getEnvVar (s : string) =
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
@@ -704,3 +704,87 @@ Required argument '--exact' received no value"""
// Again, we don't try to detect that the user has missed out the desired argument to `--a`.
exc.Message
|> shouldEqual """Unable to process argument --c=hi as key --c and value hi"""
[<Test>]
let ``Type-level help text appears in help output`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
exc.Message
|> shouldContainText
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
exc.Message
|> shouldContainText "--config-file string : The configuration file path"
exc.Message |> shouldContainText "--verbose bool : Enable verbose output"
exc.Message |> shouldContainText "--port int32"
[<Test>]
let ``Type-level help text appears before field help`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> WithTypeHelp.parse' getEnvVar [ "--help" ] |> ignore<WithTypeHelp>)
// Verify that the type help appears before the field help
let typeHelpIndex =
exc.Message.IndexOf "Parse command-line arguments for a basic configuration"
let fieldHelpIndex = exc.Message.IndexOf "--config-file"
typeHelpIndex |> shouldBeSmallerThan fieldHelpIndex
[<Test>]
let ``Multiline type-level help text works`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () ->
WithMultilineTypeHelp.parse' getEnvVar [ "--help" ]
|> ignore<WithMultilineTypeHelp>
)
exc.Message |> shouldContainText "This is a multiline help text example."
exc.Message
|> shouldContainText "It spans multiple lines to test that multiline strings work correctly."
exc.Message
|> shouldContainText "You can use this to provide detailed documentation for your argument parser."
exc.Message |> shouldContainText "--input-file string : Input file to process"
exc.Message |> shouldContainText "--output-dir string : Output directory"
exc.Message |> shouldContainText "--force bool"
[<Test>]
let ``Type-level help text appears in error messages`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () ->
WithTypeHelp.parse' getEnvVar [ "--unknown-arg" ; "value" ]
|> ignore<WithTypeHelp>
)
// Verify that the type help appears in error messages too
exc.Message
|> shouldContainText
"Parse command-line arguments for a basic configuration. This help text appears before the argument list."
exc.Message |> shouldContainText "--config-file"
[<Test>]
let ``Types without type-level help still work`` () =
let getEnvVar (_ : string) = None
let exc =
Assert.Throws<exn> (fun () -> Basic.parse' getEnvVar [ "--help" ] |> ignore<Basic>)
// Should not contain any type-level help, just the field help
exc.Message |> shouldContainText "--foo int32 : This is a foo!"
exc.Message |> shouldContainText "--bar string"
// Make sure there's no extra blank line at the beginning
exc.Message.StartsWith '\n' |> shouldEqual false

View File

@@ -0,0 +1,372 @@
namespace WoofWare.Myriad.Plugins.Test
open System.Threading
open NUnit.Framework
open FsUnitTyped
open ConsumePlugin
[<TestFixture>]
module TestArgParserNegation =
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo=true sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature=true" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo true sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ; "true" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo=false sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature=false" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --foo false sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--enable-feature" ; "false" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo=true sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature=true" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo true sets to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "true" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo=false sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature=false" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Boolean field with ArgumentNegateWithPrefix: --no-foo false sets to true`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "false" ]
result.EnableFeature |> shouldEqual true
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run=true sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run=true" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run true sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ; "true" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run=false sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run=false" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --dry-run false sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--dry-run" ; "false" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run=true sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run=true" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run true sets to Wet`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ; "true" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run=false sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run=false" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``Flag DU with ArgumentNegateWithPrefix: --no-dry-run false sets to Dry`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--no-dry-run" ; "false" ]
result.DryRun |> shouldEqual TestDryRunMode.Dry
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--verbose" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --v`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--v" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-verbose" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-v`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-v" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --verbose=false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--verbose=false" ]
result.VerboseMode |> shouldEqual false
[<Test>]
let ``ArgumentNegateWithPrefix works with multiple ArgumentLongForm: --no-v=false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = MultipleFormsNegation.parse' getEnvVar [ "--no-v=false" ]
result.VerboseMode |> shouldEqual true
[<Test>]
let ``Help text shows both standard and negated forms for boolean`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> BoolNegation.parse' getEnvVar [ "--help" ] |> ignore<BoolNegation>)
exc.Message
|> shouldEqual
"""Help text requested.
--enable-feature / --no-enable-feature bool"""
[<Test>]
let ``Help text shows both standard and negated forms for flag DU`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> FlagNegation.parse' getEnvVar [ "--help" ] |> ignore<FlagNegation>)
exc.Message
|> shouldEqual
"""Help text requested.
--dry-run / --no-dry-run bool"""
[<Test>]
let ``Help text with multiple long forms shows all variants`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () ->
MultipleFormsNegation.parse' getEnvVar [ "--help" ]
|> ignore<MultipleFormsNegation>
)
exc.Message
|> shouldEqual
"""Help text requested.
--verbose / --v / --no-verbose / --no-v bool"""
[<Test>]
let ``Multiple occurrences error: --foo and --no-foo both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--enable-feature" ; "--no-enable-feature" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``Multiple occurrences error: --no-foo and --foo both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--no-enable-feature" ; "--enable-feature" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``Multiple occurrences error: --foo=true and --no-foo=false both supplied`` () =
let getEnvVar (_ : string) = failwith "should not call"
let exc =
Assert.Throws<exn> (fun () ->
BoolNegation.parse' getEnvVar [ "--enable-feature=true" ; "--no-enable-feature=false" ]
|> ignore<BoolNegation>
)
// Should report as duplicate argument
exc.Message |> shouldContainText "supplied multiple times"
[<Test>]
let ``CombinedFeatures: verbose with default value works with negation`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = CombinedFeatures.parse' getEnvVar [ "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice2Of2 false)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: can override default with --verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result =
CombinedFeatures.parse' getEnvVar [ "--verbose" ; "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice1Of2 true)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: can override default with --no-verbose`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result =
CombinedFeatures.parse' getEnvVar [ "--no-verbose" ; "--debug" ; "--normal-bool" ]
result.Verbose |> shouldEqual (Choice1Of2 false)
result.Debug |> shouldEqual true
result.NormalBool |> shouldEqual true
[<Test>]
let ``CombinedFeatures: --no-debug sets debug to false`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = CombinedFeatures.parse' getEnvVar [ "--no-debug" ; "--normal-bool" ]
result.Debug |> shouldEqual false
[<Test>]
let ``CombinedFeatures: help text shows negation for fields with attribute`` () =
let getEnvVar (_ : string) = failwith "do not call"
let exc =
Assert.Throws<exn> (fun () -> CombinedFeatures.parse' getEnvVar [ "--help" ] |> ignore<CombinedFeatures>)
// Verbose and Debug should have --no- forms, NormalBool should not
exc.Message |> shouldContainText "--verbose / --no-verbose"
exc.Message |> shouldContainText "--debug / --no-debug"
exc.Message |> shouldContainText "--normal-bool bool"
exc.Message |> shouldNotContainText "--no-normal-bool"
[<Test>]
let ``Case insensitivity: --NO-ENABLE-FEATURE works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--NO-ENABLE-FEATURE" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Case insensitivity: --No-Enable-Feature works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = BoolNegation.parse' getEnvVar [ "--No-Enable-Feature" ]
result.EnableFeature |> shouldEqual false
[<Test>]
let ``Case insensitivity: --NO-DRY-RUN works`` () =
let getEnvVar (_ : string) = failwith "should not call"
let result = FlagNegation.parse' getEnvVar [ "--NO-DRY-RUN" ]
result.DryRun |> shouldEqual TestDryRunMode.Wet

View File

@@ -70,3 +70,63 @@ module TestCapturingMockGenerator =
bar = 3
Arg1 = "hello"
}
[<Test>]
let ``Example of use IAsyncDisposable`` () =
let mock' =
{ TypeWithAsyncDisposableMock.Empty () with
Mem1 = fun i -> async { return Option.toArray i }
Mem2 = fun () -> async { return [||] }
}
let mock = mock' :> TypeWithAsyncDisposable
mock.Mem1 (Some "hi") |> Async.RunSynchronously |> shouldEqual [| "hi" |]
mock.Mem2 () |> Async.RunSynchronously |> shouldEqual [||]
// Test that DisposeAsync returns a completed ValueTask
let asyncDisposable = mock :> IAsyncDisposable
let valueTask = asyncDisposable.DisposeAsync ()
valueTask.IsCompleted |> shouldEqual true
// Verify calls were captured
lock mock'.Calls.Mem1 (fun () -> Seq.toList mock'.Calls.Mem1)
|> List.exactlyOne
|> shouldEqual (Some "hi")
lock mock'.Calls.Mem2 (fun () -> Seq.toList mock'.Calls.Mem2)
|> List.exactlyOne
|> shouldEqual ()
[<Test>]
let ``Example of use: Both IDisposable and IAsyncDisposable`` () =
let mutable disposed = false
let mutable disposedAsync = false
let mock' =
{ TypeWithBothDisposablesMock.Empty () with
Dispose = fun () -> disposed <- true
DisposeAsync =
fun () ->
disposedAsync <- true
System.Threading.Tasks.ValueTask ()
Mem1 = fun s -> s.Length
}
let mock = mock' :> TypeWithBothDisposables
mock.Mem1 "hello" |> shouldEqual 5
mock.Mem1 "world" |> shouldEqual 5
// Test IDisposable.Dispose
(mock :> IDisposable).Dispose ()
disposed |> shouldEqual true
// Test IAsyncDisposable.DisposeAsync
let valueTask = (mock :> IAsyncDisposable).DisposeAsync ()
valueTask.IsCompleted |> shouldEqual true
disposedAsync |> shouldEqual true
// Verify calls were captured
lock mock'.Calls.Mem1 (fun () -> Seq.toList mock'.Calls.Mem1)
|> shouldEqual [ "hello" ; "world" ]

View File

@@ -47,3 +47,45 @@ module TestMockGenerator =
mock.Mem1 (Some "hi") |> Async.RunSynchronously |> shouldEqual [| "hi" |]
mock.Prop1 |> shouldEqual 44
[<Test>]
let ``Example of use: IAsyncDisposable`` () =
let mock : TypeWithAsyncDisposable =
{ TypeWithAsyncDisposableMock.Empty with
Mem1 = fun i -> async { return Option.toArray i }
}
:> _
mock.Mem1 (Some "hi") |> Async.RunSynchronously |> shouldEqual [| "hi" |]
// Test that DisposeAsync returns a completed ValueTask
let asyncDisposable = mock :> IAsyncDisposable
let valueTask = asyncDisposable.DisposeAsync ()
valueTask.IsCompleted |> shouldEqual true
[<Test>]
let ``Example of use: Both IDisposable and IAsyncDisposable`` () =
let mutable disposed = false
let mutable disposedAsync = false
let mock : TypeWithBothDisposables =
{ TypeWithBothDisposablesMock.Empty with
Dispose = fun () -> disposed <- true
DisposeAsync =
fun () ->
disposedAsync <- true
System.Threading.Tasks.ValueTask ()
Mem1 = fun s -> s.Length
}
:> _
mock.Mem1 "hello" |> shouldEqual 5
// Test IDisposable.Dispose
(mock :> IDisposable).Dispose ()
disposed |> shouldEqual true
// Test IAsyncDisposable.DisposeAsync
let valueTask = (mock :> IAsyncDisposable).DisposeAsync ()
valueTask.IsCompleted |> shouldEqual true
disposedAsync |> shouldEqual true

View File

@@ -9,7 +9,6 @@
I have not yet seen a single instance where I care about this warning
-->
<NoWarn>$(NoWarn),NU1903</NoWarn>
<TestingPlatformDotnetTestSupport>true</TestingPlatformDotnetTestSupport>
</PropertyGroup>
<ItemGroup>
@@ -38,6 +37,7 @@
<Compile Include="TestCataGenerator\TestMyList.fs" />
<Compile Include="TestCataGenerator\TestMyList2.fs" />
<Compile Include="TestArgParser\TestArgParser.fs" />
<Compile Include="TestArgParser\TestArgParserNegation.fs" />
<Compile Include="TestSwagger\TestSwaggerParse.fs" />
<Compile Include="TestSwagger\TestOpenApi3Parse.fs" />
<EmbeddedResource Include="TestSwagger\api-with-examples.json" />
@@ -55,10 +55,10 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="ApiSurface" Version="5.0.2" />
<PackageReference Include="ApiSurface" Version="5.0.3" />
<PackageReference Include="FsCheck" Version="3.3.2" />
<PackageReference Include="FsUnit" Version="7.1.1" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.0" />
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="18.0.1" />
<PackageReference Include="NUnit" Version="4.3.2" />
<PackageReference Include="NUnit3TestAdapter" Version="5.2.0" />
<PackageReference Include="WoofWare.Expect" Version="0.8.4" />

View File

@@ -72,16 +72,38 @@ type private ParseFunction<'acc> =
/// and choices and so on.
TargetType : SynType
Accumulation : 'acc
/// If true, this boolean/flag field accepts --no- prefix for negation (has [<ArgumentNegateWithPrefix>])
AcceptsNegation : bool
}
/// A SynExpr of type `string` which we can display to the user at generated-program runtime to display all
/// the ways they can refer to this arg.
member arg.HumanReadableArgForm : SynExpr =
let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
if arg.AcceptsNegation then
// Include both standard and --no- variants
// E.g., "--foo / --bar / --no-foo / --no-bar"
let standardFormatString =
List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
let negatedFormatString =
List.replicate arg.ArgForm.Length "--no-%s" |> String.concat " / "
let combinedFormatString = standardFormatString + " / " + negatedFormatString
// Apply all arg forms twice (once for standard, once for negated)
let allArgForms = arg.ArgForm @ arg.ArgForm
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst combinedFormatString),
allArgForms)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
else
// Standard behavior: just --foo / --bar
let formatString = List.replicate arg.ArgForm.Length "--%s" |> String.concat " / "
(SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst formatString), arg.ArgForm)
||> List.fold SynExpr.applyFunction
|> SynExpr.paren
[<RequireQualifiedAccess>]
type private ChoicePositional =
@@ -222,8 +244,8 @@ module private ParseTree =
nonPos @ nonPos2, Some pos
|> fun (nonPos, pos) ->
let duplicateArgs =
// This is best-effort. We can't necessarily detect all SynExprs here, but usually it'll be strings.
// Extract all arg form strings for validation
let allArgForms =
Option.toList (pos |> Option.map _.ArgForm) @ (nonPos |> List.map _.ArgForm)
|> Seq.concat
|> Seq.choose (fun expr ->
@@ -232,14 +254,57 @@ module private ParseTree =
| _ -> None
)
|> List.ofSeq
// Check for direct duplicates
let duplicateArgs =
allArgForms
|> List.groupBy id
|> List.choose (fun (key, v) -> if v.Length > 1 then Some key else None)
match duplicateArgs with
| [] -> nonPos, pos
| dups ->
| dups when not dups.IsEmpty ->
let dups = dups |> String.concat " "
failwith $"Duplicate args detected! %s{dups}"
| _ ->
// Check for --no- prefix conflicts
// Build a map of arg names that have AcceptsNegation=true
let negatedForms =
nonPos
|> List.filter _.AcceptsNegation
|> List.collect (fun pf ->
pf.ArgForm
|> List.choose (fun expr ->
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.String (s, _, _), _) -> Some (pf.FieldName.idText, s)
| _ -> None
)
)
|> List.map (fun (fieldName, argForm) -> $"no-%s{argForm}", fieldName)
|> Map.ofList
// Check if any existing arg form conflicts with a --no- variant
let conflicts =
allArgForms
|> List.choose (fun argForm ->
match negatedForms.TryFind argForm with
| Some fieldWithNegation -> Some (argForm, fieldWithNegation)
| None -> None
)
match conflicts with
| [] -> ()
| conflicts ->
let conflictMessages =
conflicts
|> List.map (fun (argForm, fieldWithNegation) ->
$"Argument name conflict: '--%s{argForm}' collides with the --no- variant of field '%s{fieldWithNegation}' (which has [<ArgumentNegateWithPrefix>])"
)
|> String.concat "\n"
failwith $"Conflicting argument names detected:\n%s{conflictMessages}"
nonPos, pos
/// Build the return value.
let rec instantiate<'a> (tree : ParseTree<'a>) : SynExpr =
@@ -615,6 +680,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = false
}
|> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
| Accumulation.List Accumulation.Required ->
@@ -627,6 +693,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = false
}
|> fun t -> ParseTree.PositionalLeaf (t, Teq.refl)
| Accumulation.Choice _
@@ -651,6 +718,27 @@ module internal ArgParserGenerator =
Some (Choice2Of2 ())
| parseTy -> identifyAsFlag flagDus parseTy |> Option.map Choice1Of2
let hasNegateAttr =
attrs
|> List.exists (fun attr ->
match attr.TypeName with
| SynLongIdent.SynLongIdent (ident, _, _) ->
match (List.last ident).idText with
| "ArgumentNegateWithPrefixAttribute"
| "ArgumentNegateWithPrefix" -> true
| _ -> false
)
let acceptsNegation =
if hasNegateAttr then
match isBoolLike with
| Some _ -> true
| None ->
failwith
$"[<ArgumentNegateWithPrefix>] can only be applied to boolean or flag DU fields, but was applied to field %s{ident.idText} of type %O{fieldType}"
else
false
{
FieldName = ident
Parser = parser
@@ -660,6 +748,7 @@ module internal ArgParserGenerator =
ArgForm = longForms
Help = helpText
BoolCases = isBoolLike
AcceptsNegation = acceptsNegation
}
|> fun t -> ParseTree.NonPositionalLeaf (t, Teq.refl)
|> ParseTreeCrate.make
@@ -680,6 +769,7 @@ module internal ArgParserGenerator =
/// let helpText : string = ...
let private helpText
(typeHelp : SynExpr option)
(typeName : Ident)
(positional : ParseFunctionPositional option)
(args : ParseFunctionNonPositional list)
@@ -761,18 +851,61 @@ module internal ArgParserGenerator =
|> SynExpr.applyTo helpText
|> SynExpr.paren
args
|> List.map (toPrintable describeNonPositional)
|> fun l ->
match positional with
| None -> l
| Some pos -> l @ [ toPrintable describePositional pos ]
let fieldHelp =
args
|> List.map (toPrintable describeNonPositional)
|> fun l ->
match positional with
| None -> l
| Some pos -> l @ [ toPrintable describePositional pos ]
let allHelp =
match typeHelp with
| Some helpExpr ->
// Prepend type help, followed by blank line, then field help
[ helpExpr ; SynExpr.CreateConst "" ] @ fieldHelp
| None ->
// No type help, just field help
fieldHelp
allHelp
|> SynExpr.listLiteral
|> SynExpr.pipeThroughFunction (
SynExpr.applyFunction (SynExpr.createLongIdent [ "String" ; "concat" ]) (SynExpr.CreateConst @"\n")
)
|> SynBinding.basic [ Ident.create "helpText" ] [ SynPat.unit ]
/// Helper to create a negated parser for boolean/flag fields.
/// Returns a SynExpr that represents: string -> (negated bool or negated flag DU)
/// For booleans: `fun x -> not (Boolean.Parse x)`
/// For flag DUs: `fun x -> FlagDu.FromBoolean flagDu (not (Boolean.Parse x))`
let private createNegatedParser (arg : ParseFunction<'acc>) : SynExpr =
match arg.BoolCases with
| None -> failwith $"LOGIC ERROR: createNegatedParser called on non-boolean field %s{arg.FieldName.idText}"
| Some (Choice2Of2 ()) ->
// Boolean: parse and negate
// fun x -> not (System.Boolean.Parse x)
let parseExpr =
SynExpr.createIdent "x"
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ])
|> SynExpr.paren
parseExpr
|> SynExpr.applyFunction (SynExpr.createIdent "not")
|> SynExpr.createLambda "x"
| Some (Choice1Of2 flagDu) ->
// Flag DU: parse as bool, negate, then convert to flag DU
// fun x -> x |> System.Boolean.Parse |> not |> FlagDu.FromBoolean flagDu
let parseExpr =
SynExpr.createIdent "x"
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Boolean" ; "Parse" ])
|> SynExpr.paren
parseExpr
|> SynExpr.applyFunction (SynExpr.createIdent "not")
|> FlagDu.FromBoolean flagDu
|> SynExpr.createLambda "x"
/// `let processKeyValue (key : string) (value : string) : Result<unit, string option> = ...`
/// Returns a possible error.
/// A parse failure might not be fatal (e.g. maybe the input was optionally of arity 0, and we failed to do
@@ -786,109 +919,209 @@ module internal ArgParserGenerator =
let args =
args
|> List.map (fun arg ->
match arg.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s")
|> SynExpr.applyTo arg.HumanReadableArgForm
|> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let assignmentExpr =
match arg.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (
SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s"
)
|> SynExpr.applyTo arg.HumanReadableArgForm
|> SynExpr.applyTo (
SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let performAssignment =
let performAssignment =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI arg.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
]
|> SynExpr.sequential
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' arg.TargetVariable)
| Accumulation.List (Accumulation.List _)
| Accumulation.List Accumulation.Optional
| Accumulation.List (Accumulation.Choice _) ->
failwith
"WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists."
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI arg.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ arg.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' arg.TargetVariable)
| Accumulation.List (Accumulation.List _)
| Accumulation.List Accumulation.Optional
| Accumulation.List (Accumulation.Choice _) ->
failwith
"WoofWare.Myriad invariant violated: expected a list to contain only a Required accumulation. Non-positional lists cannot be optional or Choice, nor can they themselves contain lists."
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction arg.Parser
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ arg.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
|> fun expr -> arg.ArgForm, expr
// Return (argForms, assignmentExpr), argMetadata
(arg.ArgForm, assignmentExpr), Some arg
)
let posArg =
match pos with
| None -> []
| Some pos ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction pos.Parser
|> fun p ->
match pos.Accumulation with
| ChoicePositional.Choice _ ->
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
| ChoicePositional.Normal _ -> p
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
|> fun expr -> pos.ArgForm, expr
|> List.singleton
let posExpr =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction pos.Parser
|> fun p ->
match pos.Accumulation with
| ChoicePositional.Choice _ ->
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
| ChoicePositional.Normal _ -> p
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
// Positional args don't support negation, so metadata is None
[ (pos.ArgForm, posExpr), None ]
(SynExpr.applyFunction (SynExpr.createIdent "Error") (SynExpr.createIdent "None"), posArg @ args)
||> List.fold (fun finalBranch (argForm, arg) ->
||> List.fold (fun finalBranch ((argForm, arg), argMetadata) ->
(finalBranch, argForm)
||> List.fold (fun finalBranch argForm ->
arg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
// Standard match: --argForm
let standardMatch =
arg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalBranch
// If this arg accepts negation, also match --no-argForm
match argMetadata with
| None -> standardMatch
| Some (parseFn : ParseFunctionNonPositional) when parseFn.AcceptsNegation ->
// Create negated assignment (same structure as `arg` but with negated parser)
let negatedParser = createNegatedParser parseFn
let negatedArg =
match parseFn.Accumulation with
| Accumulation.Required
| Accumulation.Choice _
| Accumulation.Optional ->
let multipleErrorMessage =
SynExpr.createIdent "sprintf"
|> SynExpr.applyTo (
SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s"
)
|> SynExpr.applyTo parseFn.HumanReadableArgForm
|> SynExpr.applyTo (
SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
|> SynExpr.applyTo (
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
)
let performNegatedAssignment =
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction negatedParser
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.assign (SynLongIdent.createI parseFn.TargetVariable)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
]
|> SynExpr.sequential
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalBranch
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.applyFunction (SynExpr.createIdent "Ok") (SynExpr.CreateConst ())
])
SynMatchClause.create
(SynPat.named "None")
(SynExpr.pipeThroughTryWith
SynPat.anon
(SynExpr.createLongIdent [ "exc" ; "Message" ]
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Some")
|> SynExpr.pipeThroughFunction (SynExpr.createIdent "Error"))
performNegatedAssignment)
]
|> SynExpr.createMatch (SynExpr.createIdent' parseFn.TargetVariable)
| Accumulation.List Accumulation.Required ->
[
SynExpr.createIdent "value"
|> SynExpr.pipeThroughFunction negatedParser
|> SynExpr.pipeThroughFunction (
SynExpr.createLongIdent' [ parseFn.TargetVariable ; Ident.create "Add" ]
)
SynExpr.CreateConst () |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Ok")
]
|> SynExpr.sequential
| _ ->
failwith
"WoofWare.Myriad invariant violated: unexpected accumulation type for negated arg"
// Match --no-argForm
negatedArg
|> SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--no-%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
standardMatch
| Some _ -> standardMatch
)
)
|> SynBinding.basic
@@ -909,6 +1142,34 @@ module internal ArgParserGenerator =
|> PreXmlDoc.create'
)
/// Try to extract a constant bool value from a SynExpr.
/// Returns Some true/false if the expr is a constant bool, None otherwise.
let private tryGetConstBool (expr : SynExpr) : bool option =
match expr |> SynExpr.stripOptionalParen with
| SynExpr.Const (SynConst.Bool v, _) -> Some v
| _ -> None
/// Helper to get the "false" case for a boolean/flag field.
/// For booleans: `false`
/// For flag DUs: the case marked with [<ArgumentFlag false>]
let private getFalseCase (flag : ParseFunction<'a>) : SynExpr =
match flag.BoolCases with
| None -> failwith $"LOGIC ERROR: getFalseCase called on non-boolean field %s{flag.FieldName.idText}"
| Some (Choice2Of2 ()) ->
// Boolean: return false
SynExpr.CreateConst false
| Some (Choice1Of2 flagDu) ->
// Flag DU: return the case associated with false
// Check which case has false as its arg
match tryGetConstBool flagDu.Case1Arg, tryGetConstBool flagDu.Case2Arg with
| Some false, _ -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]
| _, Some false -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]
| Some true, _ -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case2Name ]
| _, Some true -> SynExpr.createLongIdent' [ flagDu.Name ; flagDu.Case1Name ]
| None, None ->
// Can't determine at compile time, use FlagDu.FromBoolean with false
FlagDu.FromBoolean flagDu (SynExpr.CreateConst false)
/// `let setFlagValue (key : string) : bool = ...`
/// The second member of the `flags` list tuple is the constant "true" with which we will interpret the
/// arity-0 `--foo`. So in the case of a boolean-typed field, this is `true`; in the case of a Flag-typed field,
@@ -949,21 +1210,72 @@ module internal ArgParserGenerator =
(finalExpr, flag.ArgForm)
||> List.fold (fun finalExpr argForm ->
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalExpr
matchFlag
// Standard match: --argForm sets to trueCase
let standardMatch =
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
finalExpr
matchFlag
// If this flag accepts negation, also match --no-argForm sets to falseCase
if flag.AcceptsNegation then
let falseCase = getFalseCase flag
let matchNegatedFlag =
[
SynMatchClause.create
(SynPat.nameWithArgs "Some" [ SynPat.named "x" ])
// This is an error, but it's one we can gracefully report at the end.
(SynExpr.sequential
[
multipleErrorMessage
|> SynExpr.pipeThroughFunction (
SynExpr.dotGet "Add" (SynExpr.createIdent' argParseErrors)
)
SynExpr.CreateConst true
])
SynMatchClause.create
(SynPat.named "None")
([
SynExpr.assign
(SynLongIdent.createI flag.TargetVariable)
(SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") falseCase)
SynExpr.CreateConst true
]
|> SynExpr.sequential)
]
|> SynExpr.createMatch (SynExpr.createIdent' flag.TargetVariable)
// Match --no-argForm
SynExpr.ifThenElse
(SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "String" ; "Equals" ])
(SynExpr.tuple
[
SynExpr.createIdent "key"
SynExpr.applyFunction
(SynExpr.applyFunction
(SynExpr.createIdent "sprintf")
(SynExpr.CreateConst "--no-%s"))
argForm
SynExpr.createLongIdent [ "System" ; "StringComparison" ; "OrdinalIgnoreCase" ]
]))
standardMatch
matchNegatedFlag
else
standardMatch
)
)
|> SynBinding.basic [ Ident.create "setFlagValue" ] [ SynPat.annotateType SynType.string (SynPat.named "key") ]
@@ -1261,6 +1573,7 @@ module internal ArgParserGenerator =
/// Takes a single argument, `args : string list`, and returns something of the type indicated by `recordType`.
let createRecordParse
(typeHelpText : SynExpr option)
(parseState : Ident)
(flagDus : FlagDu list)
(ambientRecords : RecordType list)
@@ -1327,7 +1640,7 @@ module internal ArgParserGenerator =
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ argParseErrors ] []
let helpText = helpText recordType.Name pos nonPos
let helpText = helpText typeHelpText recordType.Name pos nonPos
let bindings = errorCollection :: helpText :: bindings
@@ -1624,14 +1937,25 @@ module internal ArgParserGenerator =
| _ -> None
)
let taggedType =
let taggedType, typeHelpText =
match taggedType with
| SynTypeDefn.SynTypeDefn (sci,
| SynTypeDefn.SynTypeDefn (SynComponentInfo.SynComponentInfo (attributes = attrs) as sci,
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access, fields, _), _),
smd,
_,
_,
_) -> RecordType.OfRecord sci smd access fields
_) ->
let typeHelp =
attrs
|> SynAttributes.toAttrs
|> List.tryPick (fun a ->
match (List.last a.TypeName.LongIdent).idText with
| "ArgumentHelpTextAttribute"
| "ArgumentHelpText" -> Some a.ArgExpr
| _ -> None
)
RecordType.OfRecord sci smd access fields, typeHelp
| _ -> failwith "[<ArgParser>] currently only supports being placed on records."
let modAttrs, modName =
@@ -1689,7 +2013,7 @@ module internal ArgParserGenerator =
|> SynPat.annotateType (SynType.appPostfix "list" SynType.string)
let parsePrime =
createRecordParse parseStateIdent flagDus allRecordTypes taggedType
createRecordParse typeHelpText parseStateIdent flagDus allRecordTypes taggedType
|> SynBinding.basic
[ Ident.create "parse'" ]
[

View File

@@ -19,7 +19,9 @@ module internal CapturingInterfaceMockGenerator =
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
type private KnownInheritance =
| IDisposable
| IAsyncDisposable
/// Expects the input `args` list to have more than one element.
let private createTypeForArgs
@@ -209,6 +211,8 @@ module internal CapturingInterfaceMockGenerator =
| [] -> failwith "Unexpected empty identifier in inheritance declaration"
| [ "IDisposable" ]
| [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable
| [ "IAsyncDisposable" ]
| [ "System" ; "IAsyncDisposable" ] -> KnownInheritance.IAsyncDisposable
| _ -> failwithf $"Unrecognised inheritance identifier: %+A{name}"
| x -> failwithf $"Unrecognised type in inheritance: %+A{x}"
)
@@ -250,12 +254,26 @@ module internal CapturingInterfaceMockGenerator =
let emptyRecordFieldInstantiations =
let interfaceExtras =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ())
let disposable =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ())
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
let asyncDisposable =
if inherits.Contains KnownInheritance.IAsyncDisposable then
let valueTaskCtor =
SynExpr.createLongIdent [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynExpr.paren
|> SynExpr.createLambda "()"
[ SynLongIdent.createS "DisposeAsync", valueTaskCtor ]
else
[]
disposable @ asyncDisposable
let originalMembers =
fields
@@ -275,23 +293,42 @@ module internal CapturingInterfaceMockGenerator =
[ Ident.create "Empty" ]
[ SynPat.unit ]
(SynExpr.createRecord None emptyRecordFieldInstantiations)
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every non-unit method throws.")
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every non-disposal method throws.")
|> SynBinding.withReturnAnnotation constructorReturnType
|> SynMemberDefn.staticMember
let recordFields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
{
Attrs = []
Ident = Some (Ident.create "Dispose")
Type = SynType.funFromDomain SynType.unit SynType.unit
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else
[]
let disposable =
if inherits.Contains KnownInheritance.IDisposable then
{
Attrs = []
Ident = Some (Ident.create "Dispose")
Type = SynType.funFromDomain SynType.unit SynType.unit
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else
[]
let asyncDisposable =
if inherits.Contains KnownInheritance.IAsyncDisposable then
{
Attrs = []
Ident = Some (Ident.create "DisposeAsync")
Type =
SynType.funFromDomain
SynType.unit
(SynType.createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ])
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IAsyncDisposable.DisposeAsync")
|> List.singleton
else
[]
disposable @ asyncDisposable
let nonExtras =
fields |> Map.toSeq |> Seq.map (fun (_, (field, _)) -> field) |> Seq.toList
@@ -528,6 +565,23 @@ module internal CapturingInterfaceMockGenerator =
Some [ mem ],
range0
)
| KnownInheritance.IAsyncDisposable ->
let mem =
SynExpr.createLongIdent [ "this" ; "DisposeAsync" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; Ident.create "DisposeAsync" ] [ SynPat.unit ]
|> SynBinding.withReturnAnnotation (
SynType.createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ]
)
|> SynMemberDefn.memberImplementation
SynMemberDefn.Interface (
SynType.createLongIdent' [ "System" ; "IAsyncDisposable" ],
Some range0,
Some [ mem ],
range0
)
)
|> Seq.toList

View File

@@ -20,7 +20,9 @@ module internal InterfaceMockGenerator =
| Some id -> id
[<RequireQualifiedAccess>]
type private KnownInheritance = | IDisposable
type private KnownInheritance =
| IDisposable
| IAsyncDisposable
let createType
(spec : GenerateMockOutputSpec)
@@ -39,6 +41,8 @@ module internal InterfaceMockGenerator =
| [] -> failwith "Unexpected empty identifier in inheritance declaration"
| [ "IDisposable" ]
| [ "System" ; "IDisposable" ] -> KnownInheritance.IDisposable
| [ "IAsyncDisposable" ]
| [ "System" ; "IAsyncDisposable" ] -> KnownInheritance.IAsyncDisposable
| _ -> failwithf "Unrecognised inheritance identifier: %+A" name
| x -> failwithf "Unrecognised type in inheritance: %+A" x
)
@@ -69,12 +73,26 @@ module internal InterfaceMockGenerator =
let constructorFields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ())
let disposable =
if inherits.Contains KnownInheritance.IDisposable then
let unitFun = SynExpr.createThunk (SynExpr.CreateConst ())
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
[ SynLongIdent.createS "Dispose", unitFun ]
else
[]
let asyncDisposable =
if inherits.Contains KnownInheritance.IAsyncDisposable then
let valueTaskCtor =
SynExpr.createLongIdent [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynExpr.paren
|> SynExpr.createLambda "()"
[ SynLongIdent.createS "DisposeAsync", valueTaskCtor ]
else
[]
disposable @ asyncDisposable
let nonExtras =
fields
@@ -90,23 +108,42 @@ module internal InterfaceMockGenerator =
else
[ SynPat.unit ])
(SynExpr.createRecord None constructorFields)
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.")
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every non-disposal method throws.")
|> SynBinding.withReturnAnnotation constructorReturnType
|> SynMemberDefn.staticMember
let fields =
let extras =
if inherits.Contains KnownInheritance.IDisposable then
{
Attrs = []
Ident = Some (Ident.create "Dispose")
Type = SynType.funFromDomain SynType.unit SynType.unit
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else
[]
let disposable =
if inherits.Contains KnownInheritance.IDisposable then
{
Attrs = []
Ident = Some (Ident.create "Dispose")
Type = SynType.funFromDomain SynType.unit SynType.unit
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else
[]
let asyncDisposable =
if inherits.Contains KnownInheritance.IAsyncDisposable then
{
Attrs = []
Ident = Some (Ident.create "DisposeAsync")
Type =
SynType.funFromDomain
SynType.unit
(SynType.createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ])
}
|> SynField.make
|> SynField.withDocString (PreXmlDoc.create "Implementation of IAsyncDisposable.DisposeAsync")
|> List.singleton
else
[]
disposable @ asyncDisposable
extras @ fields
@@ -212,6 +249,23 @@ module internal InterfaceMockGenerator =
Some [ mem ],
range0
)
| KnownInheritance.IAsyncDisposable ->
let mem =
SynExpr.createLongIdent [ "this" ; "DisposeAsync" ]
|> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; Ident.create "DisposeAsync" ] [ SynPat.unit ]
|> SynBinding.withReturnAnnotation (
SynType.createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "ValueTask" ]
)
|> SynMemberDefn.memberImplementation
SynMemberDefn.Interface (
SynType.createLongIdent' [ "System" ; "IAsyncDisposable" ],
Some range0,
Some [ mem ],
range0
)
)
|> Seq.toList

View File

@@ -1,5 +1,5 @@
{
"version": "9.0",
"version": "9.1",
"publicReleaseRefSpec": [
"^refs/heads/main$"
],

View File

@@ -10,8 +10,8 @@
</PropertyGroup>
<ItemGroup>
<PackageDownload Include="WoofWare.FSharpAnalyzers" Version="[0.2.1]" />
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.19.0]" />
<PackageDownload Include="WoofWare.FSharpAnalyzers" Version="[0.2.2]" />
<PackageDownload Include="G-Research.FSharp.Analyzers" Version="[0.20.0]" />
</ItemGroup>
</Project>

6
flake.lock generated
View File

@@ -20,11 +20,11 @@
},
"nixpkgs": {
"locked": {
"lastModified": 1762361079,
"narHash": "sha256-lz718rr1BDpZBYk7+G8cE6wee3PiBUpn8aomG/vLLiY=",
"lastModified": 1763191728,
"narHash": "sha256-esRhOS0APE6k40Hs/jjReXg+rx+J5LkWw7cuWFKlwYA=",
"owner": "NixOS",
"repo": "nixpkgs",
"rev": "ffcdcf99d65c61956d882df249a9be53e5902ea5",
"rev": "1d4c88323ac36805d09657d13a5273aea1b34f0c",
"type": "github"
},
"original": {

View File

@@ -1,8 +1,8 @@
[
{
"pname": "ApiSurface",
"version": "5.0.2",
"hash": "sha256-zcq1H1ccQzsZQf4kolzoOBSbyz07skihgPAvQ9Jri+E="
"version": "5.0.3",
"hash": "sha256-uU5mqLL6zMt17oPYMzhB57ryYC6O6FzSjmdTFg7LvNo="
},
{
"pname": "fantomas",
@@ -31,8 +31,8 @@
},
{
"pname": "fsharp-analyzers",
"version": "0.33.1",
"hash": "sha256-vYXvqnf3en487svFv3CmNl24SolwMYzu6zKKGXNxSu8="
"version": "0.34.1",
"hash": "sha256-Y6PzfVGob2EgX29ZhZIde5EhiZ28Y1+U2pJ6ybIsHV0="
},
{
"pname": "FSharp.Core",
@@ -91,13 +91,13 @@
},
{
"pname": "Microsoft.CodeCoverage",
"version": "18.0.0",
"hash": "sha256-1RNxheCYASMusDC48BXtaO3MhnInw15JVfjfLM1VMGA="
"version": "18.0.1",
"hash": "sha256-G6y5iyHZ3R2shlLCW/uTusio/UqcnWT79X+UAbxvDQY="
},
{
"pname": "Microsoft.NET.Test.Sdk",
"version": "18.0.0",
"hash": "sha256-9iW+9mvMeZgDXwSoR08bnvRNsN4jT8OVWcjq3lcE+cs="
"version": "18.0.1",
"hash": "sha256-0c3/rp9di0w7E5UmfRh6Prrm3Aeyi8NOj5bm2i6jAh0="
},
{
"pname": "Microsoft.NETCore.App.Host.linux-arm64",
@@ -201,13 +201,13 @@
},
{
"pname": "Microsoft.TestPlatform.ObjectModel",
"version": "18.0.0",
"hash": "sha256-O/ivHdoIO+q1n0byJ9OZO4quOqACOD3K3Qm00wfhuZk="
"version": "18.0.1",
"hash": "sha256-oJbS7SZ46RzyOQ+gCysW7qJRy7V8RlQVa5d8uajb91M="
},
{
"pname": "Microsoft.TestPlatform.TestHost",
"version": "18.0.0",
"hash": "sha256-qAIX2Rqxrnh1xaYRjCbkkvvMm407oyKihqyVjURX5wY="
"version": "18.0.1",
"hash": "sha256-OXYf5vg4piDr10ve0bZ2ZSb+nb3yOiHayJV3cu5sMV4="
},
{
"pname": "Myriad.Core",
@@ -389,6 +389,11 @@
"version": "0.8.4",
"hash": "sha256-UI7f2nt4g4Gg1Ke/IChrA4fpVOYAChXpvR6zkKfkmzE="
},
{
"pname": "WoofWare.NUnitTestRunner",
"version": "0.3.9",
"hash": "sha256-+QVx5NYdY1JZoMcWfJRwFgvEj2dBxWlJU0mu1Hmnlhs="
},
{
"pname": "WoofWare.Whippet.Fantomas",
"version": "0.6.4",