mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-06 04:28:42 +00:00
Compare commits
13 Commits
WoofWare.M
...
WoofWare.M
Author | SHA1 | Date | |
---|---|---|---|
|
49ecfbf5e5 | ||
|
5748ac3d5b | ||
|
913959a740 | ||
|
93ffc065cd | ||
|
d14efba7e7 | ||
|
f5cf0b79dd | ||
|
029e3746bb | ||
|
8ae749c529 | ||
|
e4cbab3209 | ||
|
bdce82fb7a | ||
|
8f9f933971 | ||
|
3a55ba1242 | ||
|
047b2eda99 |
@@ -3,7 +3,7 @@
|
||||
"isRoot": true,
|
||||
"tools": {
|
||||
"fantomas": {
|
||||
"version": "6.3.11",
|
||||
"version": "6.3.12",
|
||||
"commands": [
|
||||
"fantomas"
|
||||
]
|
||||
|
4
.github/workflows/dotnet.yaml
vendored
4
.github/workflows/dotnet.yaml
vendored
@@ -241,7 +241,7 @@ jobs:
|
||||
name: nuget-package-attribute
|
||||
path: packed
|
||||
- name: Attest Build Provenance
|
||||
uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
|
||||
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
|
||||
with:
|
||||
subject-path: "packed/*.nupkg"
|
||||
|
||||
@@ -260,7 +260,7 @@ jobs:
|
||||
name: nuget-package-plugin
|
||||
path: packed
|
||||
- name: Attest Build Provenance
|
||||
uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
|
||||
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
|
||||
with:
|
||||
subject-path: "packed/*.nupkg"
|
||||
|
||||
|
1
.gitignore
vendored
1
.gitignore
vendored
@@ -11,3 +11,4 @@ result
|
||||
analysis.sarif
|
||||
.direnv/
|
||||
.venv/
|
||||
.vs/
|
||||
|
@@ -111,7 +111,7 @@ type ChildRecordWithPositional =
|
||||
{
|
||||
Thing1 : int
|
||||
[<PositionalArgs>]
|
||||
Thing2 : string list
|
||||
Thing2 : Uri list
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
@@ -128,3 +128,86 @@ type ParentRecordSelfPos =
|
||||
[<PositionalArgs>]
|
||||
AndAnother : bool list
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
type ChoicePositionals =
|
||||
{
|
||||
[<PositionalArgs>]
|
||||
Args : Choice<string, string> list
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
type ContainsBoolEnvVar =
|
||||
{
|
||||
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
|
||||
BoolVar : Choice<bool, bool>
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module Consts =
|
||||
[<Literal>]
|
||||
let FALSE = false
|
||||
|
||||
[<Literal>]
|
||||
let TRUE = true
|
||||
|
||||
type DryRunMode =
|
||||
| [<ArgumentFlag(Consts.FALSE)>] Wet
|
||||
| [<ArgumentFlag true>] Dry
|
||||
|
||||
[<ArgParser true>]
|
||||
type WithFlagDu =
|
||||
{
|
||||
DryRun : DryRunMode
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
type ContainsFlagEnvVar =
|
||||
{
|
||||
// This phrasing is odd, but it's for a test. Nobody's really going to have `--dry-run`
|
||||
// controlled by an env var!
|
||||
[<ArgumentDefaultEnvironmentVariable "CONSUMEPLUGIN_THINGS">]
|
||||
DryRun : Choice<DryRunMode, DryRunMode>
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
type ContainsFlagDefaultValue =
|
||||
{
|
||||
[<ArgumentDefaultFunction>]
|
||||
DryRun : Choice<DryRunMode, DryRunMode>
|
||||
}
|
||||
|
||||
static member DefaultDryRun () = DryRunMode.Wet
|
||||
|
||||
[<ArgParser true>]
|
||||
type ManyLongForms =
|
||||
{
|
||||
[<ArgumentLongForm "do-something-else">]
|
||||
[<ArgumentLongForm "anotherarg">]
|
||||
DoTheThing : string
|
||||
|
||||
[<ArgumentLongForm "turn-it-on">]
|
||||
[<ArgumentLongForm "dont-turn-it-off">]
|
||||
SomeFlag : bool
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
type private IrrelevantDu =
|
||||
| Foo
|
||||
| Bar
|
||||
|
||||
[<ArgParser true>]
|
||||
type FlagsIntoPositionalArgs =
|
||||
{
|
||||
A : string
|
||||
[<PositionalArgs true>]
|
||||
GrabEverything : string list
|
||||
}
|
||||
|
||||
[<ArgParser true>]
|
||||
type FlagsIntoPositionalArgs' =
|
||||
{
|
||||
A : string
|
||||
[<PositionalArgs false>]
|
||||
DontGrabEverything : string list
|
||||
}
|
||||
|
File diff suppressed because it is too large
Load Diff
@@ -19,9 +19,22 @@ type ArgParserAttribute (isExtensionMethod : bool) =
|
||||
|
||||
/// Attribute indicating that this field shall accumulate all unmatched args,
|
||||
/// as well as any that appear after a bare `--`.
|
||||
type PositionalArgsAttribute () =
|
||||
///
|
||||
/// Set `includeFlagLike = true` to include args that begin `--` in the
|
||||
/// positional args.
|
||||
/// (By default, `includeFlagLike = false` and we throw when encountering
|
||||
/// an argument which looks like a flag but which we don't recognise.)
|
||||
/// We will still interpret `--help` as requesting help, unless it comes after
|
||||
/// a standalone `--` separator.
|
||||
type PositionalArgsAttribute (includeFlagLike : bool) =
|
||||
inherit Attribute ()
|
||||
|
||||
/// The default value of `isExtensionMethod`, the optional argument to the ArgParserAttribute constructor.
|
||||
static member DefaultIncludeFlagLike = false
|
||||
|
||||
/// Shorthand for the "includeFlagLike = false" constructor; see documentation there for details.
|
||||
new () = PositionalArgsAttribute PositionalArgsAttribute.DefaultIncludeFlagLike
|
||||
|
||||
/// Attribute indicating that this field shall have a default value derived
|
||||
/// from calling an appropriately named static method on the type.
|
||||
///
|
||||
@@ -61,3 +74,24 @@ type ParseExactAttribute (format : string) =
|
||||
/// `TimeSpan.ParseExact (s, @"hh\:mm\:ss", CultureInfo.InvariantCulture).
|
||||
type InvariantCultureAttribute () =
|
||||
inherit Attribute ()
|
||||
|
||||
/// Attribute placed on a field of a two-case no-data discriminated union, indicating that this is "basically a bool".
|
||||
/// For example: `type DryRun = | [<ArgumentFlag true>] Dry | [<ArgumentFlag false>] Wet`
|
||||
/// A record with `{ DryRun : DryRun }` will then be parsed like `{ DryRun : bool }` (so the user supplies `--dry-run`),
|
||||
/// but that you get this strongly-typed value directly in the code (so you `match args.DryRun with | DryRun.Dry ...`).
|
||||
///
|
||||
/// You must put this attribute on both cases of the discriminated union, with opposite values in each case.
|
||||
type ArgumentFlagAttribute (flagValue : bool) =
|
||||
inherit Attribute ()
|
||||
|
||||
/// Attribute placed on a field of a record to specify a different long form from the default. If you place this
|
||||
/// attribute, you won't get the default: ArgFoo would normally be expressed as `--arg-foo`, but if you instead
|
||||
/// say `[<ArgumentLongForm "thingy-blah">]` or `[<ArgumentLongForm "thingy">]`, you instead use `--thingy-blah`
|
||||
/// or `--thingy` respectively.
|
||||
///
|
||||
/// You can place this argument multiple times.
|
||||
///
|
||||
/// Omit the initial `--` that you expect the user to type.
|
||||
[<AttributeUsage(AttributeTargets.Field, AllowMultiple = true)>]
|
||||
type ArgumentLongForm (s : string) =
|
||||
inherit Attribute ()
|
||||
|
@@ -7,8 +7,12 @@ WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute inherit Syst
|
||||
WoofWare.Myriad.Plugins.ArgumentDefaultEnvironmentVariableAttribute..ctor [constructor]: string
|
||||
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.ArgumentDefaultFunctionAttribute..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.ArgumentFlagAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.ArgumentFlagAttribute..ctor [constructor]: bool
|
||||
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.CreateCatamorphismAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.CreateCatamorphismAttribute..ctor [constructor]: string
|
||||
WoofWare.Myriad.Plugins.GenerateMockAttribute inherit System.Attribute
|
||||
@@ -36,7 +40,10 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [sta
|
||||
WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
|
||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: bool
|
||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute.DefaultIncludeFlagLike [static property]: [read-only] bool
|
||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute.get_DefaultIncludeFlagLike [static method]: unit -> bool
|
||||
WoofWare.Myriad.Plugins.RemoveOptionsAttribute inherit System.Attribute
|
||||
WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.RestEase inherit obj
|
||||
|
@@ -1,10 +1,15 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
<!--
|
||||
Known high severity vulnerability
|
||||
I have not yet seen a single instance where I care about this warning
|
||||
-->
|
||||
<NoWarn>$(NoWarn),NU1903</NoWarn>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -13,7 +18,7 @@
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="ApiSurface" Version="4.1.5" />
|
||||
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
|
||||
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
|
||||
<PackageReference Include="NUnit" Version="4.2.2"/>
|
||||
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
||||
</ItemGroup>
|
||||
|
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"version": "3.2",
|
||||
"version": "3.5",
|
||||
"publicReleaseRefSpec": [
|
||||
"^refs/heads/main$"
|
||||
],
|
||||
@@ -12,4 +12,4 @@
|
||||
"./",
|
||||
":^Test"
|
||||
]
|
||||
}
|
||||
}
|
@@ -367,18 +367,19 @@ Required argument '--exact' received no value"""
|
||||
let parsed =
|
||||
ParentRecordChildPos.parse'
|
||||
getEnvVar
|
||||
[ "--and-another=true" ; "--thing1=9" ; "--thing2=some" ; "--thing2=thing" ]
|
||||
[
|
||||
"--and-another=true"
|
||||
"--thing1=9"
|
||||
"--thing2=https://example.com"
|
||||
"--thing2=http://example.com"
|
||||
]
|
||||
|
||||
parsed
|
||||
|> shouldEqual
|
||||
{
|
||||
Child =
|
||||
{
|
||||
Thing1 = 9
|
||||
Thing2 = [ "some" ; "thing" ]
|
||||
}
|
||||
AndAnother = true
|
||||
}
|
||||
parsed.AndAnother |> shouldEqual true
|
||||
parsed.Child.Thing1 |> shouldEqual 9
|
||||
|
||||
parsed.Child.Thing2
|
||||
|> List.map (fun (x : Uri) -> x.ToString ())
|
||||
|> shouldEqual [ "https://example.com/" ; "http://example.com/" ]
|
||||
|
||||
[<Test>]
|
||||
let ``Can consume stacked record, child has no positionals, parent has positionals`` () =
|
||||
@@ -421,3 +422,246 @@ Required argument '--exact' received no value"""
|
||||
--thing1 int32
|
||||
--thing2 string
|
||||
--and-another bool (positional args) (can be repeated)"""
|
||||
|
||||
[<Test>]
|
||||
let ``Positionals are tagged with Choice`` () =
|
||||
let getEnvVar (_ : string) = failwith "should not call"
|
||||
|
||||
ChoicePositionals.parse' getEnvVar [ "a" ; "b" ; "--" ; "--c" ; "--help" ]
|
||||
|> shouldEqual
|
||||
{
|
||||
Args = [ Choice1Of2 "a" ; Choice1Of2 "b" ; Choice2Of2 "--c" ; Choice2Of2 "--help" ]
|
||||
}
|
||||
|
||||
let boolCases =
|
||||
[
|
||||
"1", true
|
||||
"0", false
|
||||
"true", true
|
||||
"false", false
|
||||
"TRUE", true
|
||||
"FALSE", false
|
||||
]
|
||||
|> List.map TestCaseData
|
||||
|
||||
[<TestCaseSource(nameof (boolCases))>]
|
||||
let ``Bool env vars can be populated`` (envValue : string, boolValue : bool) =
|
||||
let getEnvVar (s : string) =
|
||||
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
|
||||
envValue
|
||||
|
||||
ContainsBoolEnvVar.parse' getEnvVar []
|
||||
|> shouldEqual
|
||||
{
|
||||
BoolVar = Choice2Of2 boolValue
|
||||
}
|
||||
|
||||
[<Test>]
|
||||
let ``Bools can be treated with arity 0`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
ContainsBoolEnvVar.parse' getEnvVar [ "--bool-var" ]
|
||||
|> shouldEqual
|
||||
{
|
||||
BoolVar = Choice1Of2 true
|
||||
}
|
||||
|
||||
[<TestCaseSource(nameof boolCases)>]
|
||||
let ``Flag DUs can be parsed from env var`` (envValue : string, boolValue : bool) =
|
||||
let getEnvVar (s : string) =
|
||||
s |> shouldEqual "CONSUMEPLUGIN_THINGS"
|
||||
envValue
|
||||
|
||||
let boolValue = if boolValue then DryRunMode.Dry else DryRunMode.Wet
|
||||
|
||||
ContainsFlagEnvVar.parse' getEnvVar []
|
||||
|> shouldEqual
|
||||
{
|
||||
DryRun = Choice2Of2 boolValue
|
||||
}
|
||||
|
||||
let dryRunData =
|
||||
[
|
||||
[ "--dry-run" ], DryRunMode.Dry
|
||||
[ "--dry-run" ; "true" ], DryRunMode.Dry
|
||||
[ "--dry-run=true" ], DryRunMode.Dry
|
||||
[ "--dry-run" ; "True" ], DryRunMode.Dry
|
||||
[ "--dry-run=True" ], DryRunMode.Dry
|
||||
[ "--dry-run" ; "false" ], DryRunMode.Wet
|
||||
[ "--dry-run=false" ], DryRunMode.Wet
|
||||
[ "--dry-run" ; "False" ], DryRunMode.Wet
|
||||
[ "--dry-run=False" ], DryRunMode.Wet
|
||||
]
|
||||
|> List.map TestCaseData
|
||||
|
||||
[<TestCaseSource(nameof dryRunData)>]
|
||||
let ``Flag DUs can be parsed`` (args : string list, expected : DryRunMode) =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
ContainsFlagEnvVar.parse' getEnvVar args
|
||||
|> shouldEqual
|
||||
{
|
||||
DryRun = Choice1Of2 expected
|
||||
}
|
||||
|
||||
[<TestCaseSource(nameof dryRunData)>]
|
||||
let ``Flag DUs can be parsed, ArgumentDefaultFunction`` (args : string list, expected : DryRunMode) =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
ContainsFlagDefaultValue.parse' getEnvVar args
|
||||
|> shouldEqual
|
||||
{
|
||||
DryRun = Choice1Of2 expected
|
||||
}
|
||||
|
||||
[<Test>]
|
||||
let ``Flag DUs can be given a default value`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
ContainsFlagDefaultValue.parse' getEnvVar []
|
||||
|> shouldEqual
|
||||
{
|
||||
DryRun = Choice2Of2 DryRunMode.Wet
|
||||
}
|
||||
|
||||
[<Test>]
|
||||
let ``Help text for flag DU`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () ->
|
||||
ContainsFlagDefaultValue.parse' getEnvVar [ "--help" ]
|
||||
|> ignore<ContainsFlagDefaultValue>
|
||||
)
|
||||
|
||||
exc.Message
|
||||
|> shouldEqual
|
||||
"""Help text requested.
|
||||
--dry-run bool (default value: false)"""
|
||||
|
||||
[<Test>]
|
||||
let ``Help text for flag DU, non default`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () -> WithFlagDu.parse' getEnvVar [ "--help" ] |> ignore<WithFlagDu>)
|
||||
|
||||
exc.Message
|
||||
|> shouldEqual
|
||||
"""Help text requested.
|
||||
--dry-run bool"""
|
||||
|
||||
let longFormCases =
|
||||
let doTheThing =
|
||||
[
|
||||
[ "--do-something-else=foo" ]
|
||||
[ "--anotherarg=foo" ]
|
||||
[ "--do-something-else" ; "foo" ]
|
||||
[ "--anotherarg" ; "foo" ]
|
||||
]
|
||||
|
||||
let someFlag =
|
||||
[
|
||||
[ "--turn-it-on" ], true
|
||||
[ "--dont-turn-it-off" ], true
|
||||
[ "--turn-it-on=true" ], true
|
||||
[ "--dont-turn-it-off=true" ], true
|
||||
[ "--turn-it-on=false" ], false
|
||||
[ "--dont-turn-it-off=false" ], false
|
||||
[ "--turn-it-on" ; "true" ], true
|
||||
[ "--dont-turn-it-off" ; "true" ], true
|
||||
[ "--turn-it-on" ; "false" ], false
|
||||
[ "--dont-turn-it-off" ; "false" ], false
|
||||
]
|
||||
|
||||
List.allPairs doTheThing someFlag
|
||||
|> List.map (fun (doTheThing, (someFlag, someFlagResult)) ->
|
||||
let args = doTheThing @ someFlag
|
||||
|
||||
let expected =
|
||||
{
|
||||
DoTheThing = "foo"
|
||||
SomeFlag = someFlagResult
|
||||
}
|
||||
|
||||
args, expected
|
||||
)
|
||||
|> List.map TestCaseData
|
||||
|
||||
[<TestCaseSource(nameof longFormCases)>]
|
||||
let ``Long-form args`` (args : string list, expected : ManyLongForms) =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
ManyLongForms.parse' getEnvVar args |> shouldEqual expected
|
||||
|
||||
[<Test>]
|
||||
let ``Long-form args can't be referred to by their original name`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () ->
|
||||
ManyLongForms.parse' getEnvVar [ "--do-the-thing=foo" ] |> ignore<ManyLongForms>
|
||||
)
|
||||
|
||||
exc.Message
|
||||
|> shouldEqual """Unable to process argument --do-the-thing=foo as key --do-the-thing and value foo"""
|
||||
|
||||
[<Test>]
|
||||
let ``Long-form args help text`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () -> ManyLongForms.parse' getEnvVar [ "--help" ] |> ignore<ManyLongForms>)
|
||||
|
||||
exc.Message
|
||||
|> shouldEqual
|
||||
"""Help text requested.
|
||||
--do-something-else / --anotherarg string
|
||||
--turn-it-on / --dont-turn-it-off bool"""
|
||||
|
||||
[<Test>]
|
||||
let ``Can collect *all* non-help args into positional args with includeFlagLike`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|
||||
|> shouldEqual
|
||||
{
|
||||
A = "foo"
|
||||
GrabEverything = [ "--b=false" ; "--c" ; "hi" ; "--help" ]
|
||||
}
|
||||
|
||||
// Users might consider this eccentric!
|
||||
// But we're only a simple arg parser; we don't look around to see whether this is "almost"
|
||||
// a valid parse.
|
||||
FlagsIntoPositionalArgs.parse' getEnvVar [ "--a" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|
||||
|> shouldEqual
|
||||
{
|
||||
A = "--b=false"
|
||||
GrabEverything = [ "--c" ; "hi" ; "--help" ]
|
||||
}
|
||||
|
||||
[<Test>]
|
||||
let ``Can refuse to collect non-help args with PositionalArgs false`` () =
|
||||
let getEnvVar (_ : string) = failwith "do not call"
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () ->
|
||||
FlagsIntoPositionalArgs'.parse'
|
||||
getEnvVar
|
||||
[ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|
||||
|> ignore<FlagsIntoPositionalArgs'>
|
||||
)
|
||||
|
||||
exc.Message
|
||||
|> shouldEqual """Unable to process argument --b=false as key --b and value false"""
|
||||
|
||||
let exc =
|
||||
Assert.Throws<exn> (fun () ->
|
||||
FlagsIntoPositionalArgs'.parse' getEnvVar [ "--a" ; "--b=false" ; "--c=hi" ; "--" ; "--help" ]
|
||||
|> ignore<FlagsIntoPositionalArgs'>
|
||||
)
|
||||
|
||||
// Again perhaps eccentric!
|
||||
// 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"""
|
||||
|
@@ -4,6 +4,11 @@
|
||||
<TargetFramework>net8.0</TargetFramework>
|
||||
<IsPackable>false</IsPackable>
|
||||
<IsTestProject>true</IsTestProject>
|
||||
<!--
|
||||
Known high severity vulnerability
|
||||
I have not yet seen a single instance where I care about this warning
|
||||
-->
|
||||
<NoWarn>$(NoWarn),NU1903</NoWarn>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
@@ -37,7 +42,7 @@
|
||||
<PackageReference Include="ApiSurface" Version="4.1.5"/>
|
||||
<PackageReference Include="FsCheck" Version="2.16.6"/>
|
||||
<PackageReference Include="FsUnit" Version="6.0.0"/>
|
||||
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.0"/>
|
||||
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.11.1"/>
|
||||
<PackageReference Include="NUnit" Version="4.2.2"/>
|
||||
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
||||
</ItemGroup>
|
||||
|
File diff suppressed because it is too large
Load Diff
@@ -67,41 +67,109 @@ type internal RecordType =
|
||||
Members : SynMemberDefns option
|
||||
XmlDoc : PreXmlDoc option
|
||||
Generics : SynTyparDecls option
|
||||
Accessibility : SynAccess option
|
||||
TypeAccessibility : SynAccess option
|
||||
ImplAccessibility : SynAccess option
|
||||
Attributes : SynAttribute list
|
||||
}
|
||||
|
||||
/// Parse from the AST.
|
||||
static member OfRecord (record : SynTypeDefn) : RecordType =
|
||||
let sci, sdr, smd, smdo =
|
||||
match record with
|
||||
| SynTypeDefn.SynTypeDefn (sci, sdr, smd, smdo, _, _) -> sci, sdr, smd, smdo
|
||||
|
||||
let synAccessOption, recordFields =
|
||||
match sdr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (sa, fields, _), _) -> sa, fields
|
||||
| _ -> failwith $"expected a record; got: %+A{record}"
|
||||
|
||||
static member OfRecord
|
||||
(sci : SynComponentInfo)
|
||||
(smd : SynMemberDefns)
|
||||
(access : SynAccess option)
|
||||
(recordFields : SynField list)
|
||||
: RecordType
|
||||
=
|
||||
match sci with
|
||||
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access, _) ->
|
||||
if access <> synAccessOption then
|
||||
failwith
|
||||
$"TODO what's happened, two different accessibility modifiers: %O{access} and %O{synAccessOption}"
|
||||
|
||||
match smdo with
|
||||
| Some v -> failwith $"TODO what's happened, got a synMemberDefn of %O{v}"
|
||||
| None -> ()
|
||||
|
||||
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
|
||||
{
|
||||
Name = List.last longId
|
||||
Fields = recordFields
|
||||
Members = if smd.IsEmpty then None else Some smd
|
||||
XmlDoc = if doc.IsEmpty then None else Some doc
|
||||
Generics = typars
|
||||
Accessibility = synAccessOption
|
||||
ImplAccessibility = implAccess
|
||||
TypeAccessibility = access
|
||||
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
||||
}
|
||||
|
||||
/// Methods for manipulating UnionCase.
|
||||
[<RequireQualifiedAccess>]
|
||||
module UnionCase =
|
||||
/// Construct our structured `UnionCase` from an FCS `SynUnionCase`: extract everything
|
||||
/// we care about from the AST representation.
|
||||
let ofSynUnionCase (case : SynUnionCase) : UnionCase<Ident option> =
|
||||
match case with
|
||||
| SynUnionCase.SynUnionCase (attributes, ident, caseType, xmlDoc, access, _, _) ->
|
||||
|
||||
let ident =
|
||||
match ident with
|
||||
| SynIdent.SynIdent (ident, _) -> ident
|
||||
|
||||
let fields =
|
||||
match caseType with
|
||||
| SynUnionCaseKind.Fields cases -> cases
|
||||
| SynUnionCaseKind.FullType _ -> failwith "unexpected FullType union"
|
||||
|
||||
{
|
||||
Name = ident
|
||||
XmlDoc = if xmlDoc.IsEmpty then None else Some xmlDoc
|
||||
Access = access
|
||||
Attributes = attributes |> List.collect (fun t -> t.Attributes)
|
||||
Fields = fields |> List.map SynField.extract
|
||||
}
|
||||
|
||||
/// Functorial `map`.
|
||||
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
|
||||
{
|
||||
Attributes = unionCase.Attributes
|
||||
Name = unionCase.Name
|
||||
Access = unionCase.Access
|
||||
XmlDoc = unionCase.XmlDoc
|
||||
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
|
||||
}
|
||||
|
||||
/// Everything you need to know about a discriminated union definition.
|
||||
type internal UnionType =
|
||||
{
|
||||
/// The name of the DU: for example, `type Foo = | Blah` has this being `Foo`.
|
||||
Name : Ident
|
||||
/// Any additional members which are not union cases.
|
||||
Members : SynMemberDefns option
|
||||
/// Any docstring associated with the DU itself (not its cases).
|
||||
XmlDoc : PreXmlDoc option
|
||||
/// Generic type parameters this DU takes: `type Foo<'a> = | ...`.
|
||||
Generics : SynTyparDecls option
|
||||
/// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
|
||||
Attributes : SynAttribute list
|
||||
/// Accessibility modifier of the DU: `type private Foo = ...`
|
||||
TypeAccessibility : SynAccess option
|
||||
/// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
|
||||
ImplAccessibility : SynAccess option
|
||||
/// The actual DU cases themselves.
|
||||
Cases : UnionCase<Ident option> list
|
||||
}
|
||||
|
||||
static member OfUnion
|
||||
(sci : SynComponentInfo)
|
||||
(smd : SynMemberDefns)
|
||||
(access : SynAccess option)
|
||||
(cases : SynUnionCase list)
|
||||
: UnionType
|
||||
=
|
||||
match sci with
|
||||
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
|
||||
{
|
||||
Name = List.last longId
|
||||
Members = if smd.IsEmpty then None else Some smd
|
||||
XmlDoc = if doc.IsEmpty then None else Some doc
|
||||
Generics = typars
|
||||
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
||||
TypeAccessibility = access
|
||||
ImplAccessibility = implAccess
|
||||
Cases = cases |> List.map UnionCase.ofSynUnionCase
|
||||
}
|
||||
|
||||
/// Anything that is part of an ADT.
|
||||
/// A record is a product of stuff; this type represents one of those stuffs.
|
||||
type internal AdtNode =
|
||||
@@ -144,13 +212,13 @@ module internal AstHelper =
|
||||
let defineRecordType (record : RecordType) : SynTypeDefn =
|
||||
let name =
|
||||
SynComponentInfo.create record.Name
|
||||
|> SynComponentInfo.setAccessibility record.Accessibility
|
||||
|> SynComponentInfo.setAccessibility record.TypeAccessibility
|
||||
|> match record.XmlDoc with
|
||||
| None -> id
|
||||
| Some doc -> SynComponentInfo.withDocString doc
|
||||
|> SynComponentInfo.setGenerics record.Generics
|
||||
|
||||
SynTypeDefnRepr.record (Seq.toList record.Fields)
|
||||
SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields)
|
||||
|> SynTypeDefn.create name
|
||||
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
|
||||
|
||||
|
@@ -212,7 +212,8 @@ module internal InterfaceMockGenerator =
|
||||
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
|
||||
XmlDoc = Some xmlDoc
|
||||
Generics = interfaceType.Generics
|
||||
Accessibility = Some access
|
||||
TypeAccessibility = Some access
|
||||
ImplAccessibility = None
|
||||
Attributes = []
|
||||
}
|
||||
|
||||
|
@@ -416,11 +416,11 @@ module internal JsonParseGenerator =
|
||||
let createUnionMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : UnionCase<Ident> list) =
|
||||
fields
|
||||
|> List.map (fun case ->
|
||||
let propertyName = JsonSerializeGenerator.getPropertyName case.Ident case.Attrs
|
||||
let propertyName = JsonSerializeGenerator.getPropertyName case.Name case.Attributes
|
||||
|
||||
let body =
|
||||
if case.Fields.IsEmpty then
|
||||
SynExpr.createLongIdent' (typeName @ [ case.Ident ])
|
||||
SynExpr.createLongIdent' (typeName @ [ case.Name ])
|
||||
else
|
||||
case.Fields
|
||||
|> List.map (fun field ->
|
||||
@@ -429,7 +429,7 @@ module internal JsonParseGenerator =
|
||||
createParseRhs options propertyName field.Type
|
||||
)
|
||||
|> SynExpr.tuple
|
||||
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ]))
|
||||
|> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Name ]))
|
||||
|> SynExpr.createLet
|
||||
[
|
||||
SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node")
|
||||
@@ -600,7 +600,7 @@ module internal JsonParseGenerator =
|
||||
| Some i -> i
|
||||
|
||||
cases
|
||||
|> List.map SynUnionCase.extract
|
||||
|> List.map UnionCase.ofSynUnionCase
|
||||
|> List.map (UnionCase.mapIdentFields optionGet)
|
||||
|> createUnionMaker spec ident
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Enum (cases, _range), _) ->
|
||||
|
@@ -263,11 +263,11 @@ module internal JsonSerializeGenerator =
|
||||
|
||||
let unionModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (cases : SynUnionCase list) =
|
||||
let inputArg = Ident.create "input"
|
||||
let fields = cases |> List.map SynUnionCase.extract
|
||||
let fields = cases |> List.map UnionCase.ofSynUnionCase
|
||||
|
||||
fields
|
||||
|> List.map (fun unionCase ->
|
||||
let propertyName = getPropertyName unionCase.Ident unionCase.Attrs
|
||||
let propertyName = getPropertyName unionCase.Name unionCase.Attributes
|
||||
|
||||
let caseNames = unionCase.Fields |> List.mapi (fun i _ -> $"arg%i{i}")
|
||||
|
||||
@@ -275,7 +275,7 @@ module internal JsonSerializeGenerator =
|
||||
|
||||
let pattern =
|
||||
SynPat.LongIdent (
|
||||
SynLongIdent.create (typeName @ [ unionCase.Ident ]),
|
||||
SynLongIdent.create (typeName @ [ unionCase.Name ]),
|
||||
None,
|
||||
None,
|
||||
argPats,
|
||||
|
@@ -36,7 +36,6 @@ module internal RemoveOptionsGenerator =
|
||||
trivia
|
||||
)
|
||||
|
||||
// TODO: this option seems a bit odd
|
||||
let createType
|
||||
(xmlDoc : PreXmlDoc option)
|
||||
(accessibility : SynAccess option)
|
||||
@@ -54,7 +53,8 @@ module internal RemoveOptionsGenerator =
|
||||
Members = None
|
||||
XmlDoc = xmlDoc
|
||||
Generics = generics
|
||||
Accessibility = accessibility
|
||||
TypeAccessibility = accessibility
|
||||
ImplAccessibility = None
|
||||
Attributes = []
|
||||
}
|
||||
|
||||
@@ -62,7 +62,7 @@ module internal RemoveOptionsGenerator =
|
||||
|
||||
SynModuleDecl.Types ([ typeDecl ], range0)
|
||||
|
||||
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : LongIdent) (fields : SynFieldData<Ident> list) =
|
||||
let createMaker (withOptionsType : LongIdent) (withoutOptionsType : Ident) (fields : SynFieldData<Ident> list) =
|
||||
let xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
|
||||
|
||||
let inputArg = Ident.create "input"
|
||||
@@ -87,7 +87,7 @@ module internal RemoveOptionsGenerator =
|
||||
SynExpr.applyFunction
|
||||
(SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
|
||||
(SynExpr.createLongIdent' (
|
||||
withoutOptionsType
|
||||
[ withoutOptionsType ]
|
||||
@ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
|
||||
))
|
||||
)
|
||||
@@ -101,47 +101,35 @@ module internal RemoveOptionsGenerator =
|
||||
[ functionName ]
|
||||
[
|
||||
SynPat.named inputArg.idText
|
||||
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
|
||||
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType))
|
||||
]
|
||||
body
|
||||
|> SynBinding.withXmlDoc xmlDoc
|
||||
|> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
|
||||
|> SynModuleDecl.createLet
|
||||
|
||||
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
|
||||
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
|
||||
typeDefn
|
||||
let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) =
|
||||
let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent
|
||||
|
||||
let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
|
||||
synComponentInfo
|
||||
let decls =
|
||||
[
|
||||
createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields
|
||||
createMaker [ Ident.create "Short" ] typeDefn.Name fieldData
|
||||
]
|
||||
|
||||
match synTypeDefnRepr with
|
||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
|
||||
let fieldData = fields |> List.map SynField.extractWithIdent
|
||||
let xmlDoc =
|
||||
sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText
|
||||
|> PreXmlDoc.create
|
||||
|
||||
let decls =
|
||||
[
|
||||
createType (Some doc) accessibility typeParams fields
|
||||
createMaker [ Ident.create "Short" ] recordId fieldData
|
||||
]
|
||||
let info =
|
||||
SynComponentInfo.create typeDefn.Name
|
||||
|> SynComponentInfo.withDocString xmlDoc
|
||||
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|
||||
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
|
||||
|
||||
let xmlDoc =
|
||||
recordId
|
||||
|> Seq.map (fun i -> i.idText)
|
||||
|> String.concat "."
|
||||
|> sprintf "Module containing an option-truncated version of the %s type"
|
||||
|> PreXmlDoc.create
|
||||
|
||||
let info =
|
||||
SynComponentInfo.createLong recordId
|
||||
|> SynComponentInfo.withDocString xmlDoc
|
||||
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|
||||
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
|
||||
|
||||
SynModuleDecl.nestedModule info decls
|
||||
|> List.singleton
|
||||
|> SynModuleOrNamespace.createNamespace namespaceId
|
||||
| _ -> failwithf "Not a record type"
|
||||
SynModuleDecl.nestedModule info decls
|
||||
|> List.singleton
|
||||
|> SynModuleOrNamespace.createNamespace namespaceId
|
||||
|
||||
open Myriad.Core
|
||||
|
||||
@@ -164,7 +152,24 @@ type RemoveOptionsGenerator () =
|
||||
|> List.choose (fun (ns, types) ->
|
||||
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
|
||||
| [] -> None
|
||||
| types -> Some (ns, types)
|
||||
| types ->
|
||||
let types =
|
||||
types
|
||||
|> List.map (fun ty ->
|
||||
match ty with
|
||||
| SynTypeDefn.SynTypeDefn (sci,
|
||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (access,
|
||||
fields,
|
||||
_),
|
||||
_),
|
||||
smd,
|
||||
smdo,
|
||||
_,
|
||||
_) -> RecordType.OfRecord sci smd access fields
|
||||
| _ -> failwith "unexpectedly not a record"
|
||||
)
|
||||
|
||||
Some (ns, types)
|
||||
)
|
||||
|
||||
let modules =
|
||||
|
@@ -11,4 +11,27 @@ WoofWare.Myriad.Plugins.JsonParseGenerator..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.JsonSerializeGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
|
||||
WoofWare.Myriad.Plugins.JsonSerializeGenerator..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.RemoveOptionsGenerator inherit obj, implements Myriad.Core.IMyriadGenerator
|
||||
WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.RemoveOptionsGenerator..ctor [constructor]: unit
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1 inherit obj
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1..ctor [constructor]: (Fantomas.FCS.Syntax.SynAttribute list, 'Ident, Fantomas.FCS.Syntax.SynType)
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.Attrs [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.get_Attrs [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.get_Ident [method]: unit -> 'Ident
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.get_Type [method]: unit -> Fantomas.FCS.Syntax.SynType
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.Ident [property]: [read-only] 'Ident
|
||||
WoofWare.Myriad.Plugins.SynFieldData`1.Type [property]: [read-only] Fantomas.FCS.Syntax.SynType
|
||||
WoofWare.Myriad.Plugins.UnionCase inherit obj
|
||||
WoofWare.Myriad.Plugins.UnionCase.mapIdentFields [static method]: ('a -> 'b) -> 'a WoofWare.Myriad.Plugins.UnionCase -> 'b WoofWare.Myriad.Plugins.UnionCase
|
||||
WoofWare.Myriad.Plugins.UnionCase.ofSynUnionCase [static method]: Fantomas.FCS.Syntax.SynUnionCase -> Fantomas.FCS.Syntax.Ident option WoofWare.Myriad.Plugins.UnionCase
|
||||
WoofWare.Myriad.Plugins.UnionCase`1 inherit obj
|
||||
WoofWare.Myriad.Plugins.UnionCase`1..ctor [constructor]: (Fantomas.FCS.Syntax.Ident, Fantomas.FCS.Xml.PreXmlDoc option, Fantomas.FCS.Syntax.SynAccess option, Fantomas.FCS.Syntax.SynAttribute list, 'ident WoofWare.Myriad.Plugins.SynFieldData list)
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.Access [property]: [read-only] Fantomas.FCS.Syntax.SynAccess option
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.Attributes [property]: [read-only] Fantomas.FCS.Syntax.SynAttribute list
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.Fields [property]: [read-only] 'ident WoofWare.Myriad.Plugins.SynFieldData list
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.get_Access [method]: unit -> Fantomas.FCS.Syntax.SynAccess option
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.get_Attributes [method]: unit -> Fantomas.FCS.Syntax.SynAttribute list
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.get_Fields [method]: unit -> 'ident WoofWare.Myriad.Plugins.SynFieldData list
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.get_Name [method]: unit -> Fantomas.FCS.Syntax.Ident
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.get_XmlDoc [method]: unit -> Fantomas.FCS.Xml.PreXmlDoc option
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.Name [property]: [read-only] Fantomas.FCS.Syntax.Ident
|
||||
WoofWare.Myriad.Plugins.UnionCase`1.XmlDoc [property]: [read-only] Fantomas.FCS.Xml.PreXmlDoc option
|
@@ -80,6 +80,11 @@ module internal SynExpr =
|
||||
let equals (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b
|
||||
|
||||
/// {a} && {b}
|
||||
let booleanAnd (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.booleanAnd, a)
|
||||
|> applyTo b
|
||||
|
||||
/// {a} + {b}
|
||||
let plus (a : SynExpr) (b : SynExpr) =
|
||||
SynExpr.CreateAppInfix (
|
||||
|
@@ -5,10 +5,17 @@ open Fantomas.FCS.Syntax
|
||||
open Fantomas.FCS.SyntaxTrivia
|
||||
open Fantomas.FCS.Xml
|
||||
|
||||
type internal SynFieldData<'Ident> =
|
||||
/// The data needed to reconstitute a single piece of data within a union field, or a single record field.
|
||||
/// This is generic on whether the field is identified. For example, in `type Foo = Blah of int`, the `int`
|
||||
/// field is not identified; whereas in `type Foo = Blah of baz : int`, it is identified.
|
||||
type SynFieldData<'Ident> =
|
||||
{
|
||||
/// Attributes on this field. I think you can only get these if this is a *record* field.
|
||||
Attrs : SynAttribute list
|
||||
/// The identifier of this field (see docstring for SynFieldData).
|
||||
Ident : 'Ident
|
||||
/// The type of the data contained in this field. For example, `type Foo = { Blah : int }`
|
||||
/// has this being `int`.
|
||||
Type : SynType
|
||||
}
|
||||
|
||||
|
@@ -33,6 +33,9 @@ module internal SynLongIdent =
|
||||
let eq =
|
||||
SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
|
||||
|
||||
let booleanAnd =
|
||||
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
|
||||
|
||||
let pipe =
|
||||
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
|
||||
|
||||
|
@@ -363,6 +363,7 @@ module internal SynType =
|
||||
| DateTimeOffset -> "DateTimeOffset"
|
||||
| DateOnly -> "DateOnly"
|
||||
| TimeSpan -> "TimeSpan"
|
||||
| SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> ident |> List.map _.idText |> String.concat "."
|
||||
| ty -> failwithf "could not compute human-readable string for type: %O" ty
|
||||
|
||||
/// Guess whether the types are equal. We err on the side of saying "no, they're different".
|
||||
@@ -454,4 +455,11 @@ module internal SynType =
|
||||
match ty2 with
|
||||
| DateOnly -> true
|
||||
| _ -> false
|
||||
| _ -> false
|
||||
| _ ->
|
||||
|
||||
match ty1, ty2 with
|
||||
| SynType.LongIdent (SynLongIdent (ident1, _, _)), SynType.LongIdent (SynLongIdent (ident2, _, _)) ->
|
||||
let ident1 = ident1 |> List.map _.idText
|
||||
let ident2 = ident2 |> List.map _.idText
|
||||
ident1 = ident2
|
||||
| _, _ -> false
|
||||
|
@@ -13,8 +13,12 @@ module internal SynTypeDefnRepr =
|
||||
let inline augmentation () : SynTypeDefnRepr =
|
||||
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
|
||||
|
||||
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
|
||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
|
||||
let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
|
||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
|
||||
|
||||
let inline record (fields : SynField list) : SynTypeDefnRepr =
|
||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
|
||||
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
|
||||
|
||||
let inline recordWithAccess (implAccess : SynAccess option) (fields : SynField list) : SynTypeDefnRepr =
|
||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (implAccess, fields, range0), range0)
|
||||
|
||||
let inline record (fields : SynField list) : SynTypeDefnRepr = recordWithAccess None fields
|
||||
|
@@ -5,44 +5,24 @@ open Fantomas.FCS.Text.Range
|
||||
open Fantomas.FCS.Xml
|
||||
open Fantomas.FCS.SyntaxTrivia
|
||||
|
||||
type internal UnionCase<'Ident> =
|
||||
/// Represents everything you need to know about a union case.
|
||||
/// This is generic on whether each field of this case must be named.
|
||||
type UnionCase<'ident> =
|
||||
{
|
||||
Fields : SynFieldData<'Ident> list
|
||||
Attrs : SynAttribute list
|
||||
Ident : Ident
|
||||
/// The name of the case: e.g. `| Foo of blah` has this being `Foo`.
|
||||
Name : Ident
|
||||
/// Any docstring associated with this case.
|
||||
XmlDoc : PreXmlDoc option
|
||||
/// Any accessibility modifier: e.g. `type Foo = private | Blah`.
|
||||
Access : SynAccess option
|
||||
/// Attributes on the case: for example, `| [<Attr>] Foo of blah`.
|
||||
Attributes : SynAttribute list
|
||||
/// The data contained within the case: for example, `[blah]` in `| Foo of blah`.
|
||||
Fields : SynFieldData<'ident> list
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal UnionCase =
|
||||
let mapIdentFields<'a, 'b> (f : 'a -> 'b) (unionCase : UnionCase<'a>) : UnionCase<'b> =
|
||||
{
|
||||
Fields = unionCase.Fields |> List.map (SynField.mapIdent f)
|
||||
Attrs = unionCase.Attrs
|
||||
Ident = unionCase.Ident
|
||||
}
|
||||
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal SynUnionCase =
|
||||
let extract (SynUnionCase (attrs, id, caseType, _, _, _, _)) : UnionCase<Ident option> =
|
||||
match caseType with
|
||||
| SynUnionCaseKind.FullType _ -> failwith "WoofWare.Myriad does not support FullType union cases."
|
||||
| SynUnionCaseKind.Fields fields ->
|
||||
|
||||
let fields = fields |> List.map SynField.extract
|
||||
|
||||
let id =
|
||||
match id with
|
||||
| SynIdent.SynIdent (ident, _) -> ident
|
||||
|
||||
// As far as I can tell, there's no way to get any attributes here? :shrug:
|
||||
let attrs = attrs |> List.collect (fun l -> l.Attributes)
|
||||
|
||||
{
|
||||
Fields = fields
|
||||
Attrs = attrs
|
||||
Ident = id
|
||||
}
|
||||
|
||||
let create (case : UnionCase<Ident>) : SynUnionCase =
|
||||
let fields =
|
||||
case.Fields
|
||||
@@ -63,11 +43,11 @@ module internal SynUnionCase =
|
||||
)
|
||||
|
||||
SynUnionCase.SynUnionCase (
|
||||
SynAttributes.ofAttrs case.Attrs,
|
||||
SynIdent.SynIdent (case.Ident, None),
|
||||
SynAttributes.ofAttrs case.Attributes,
|
||||
SynIdent.SynIdent (case.Name, None),
|
||||
SynUnionCaseKind.Fields fields,
|
||||
PreXmlDoc.Empty,
|
||||
None,
|
||||
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
|
||||
case.Access,
|
||||
range0,
|
||||
{
|
||||
BarRange = Some range0
|
||||
|
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"version": "2.2",
|
||||
"version": "2.3",
|
||||
"publicReleaseRefSpec": [
|
||||
"^refs/heads/main$"
|
||||
],
|
||||
|
6
flake.lock
generated
6
flake.lock
generated
@@ -20,11 +20,11 @@
|
||||
},
|
||||
"nixpkgs": {
|
||||
"locked": {
|
||||
"lastModified": 1725099143,
|
||||
"narHash": "sha256-CHgumPZaC7z+WYx72WgaLt2XF0yUVzJS60rO4GZ7ytY=",
|
||||
"lastModified": 1725534445,
|
||||
"narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=",
|
||||
"owner": "NixOS",
|
||||
"repo": "nixpkgs",
|
||||
"rev": "5629520edecb69630a3f4d17d3d33fc96c13f6fe",
|
||||
"rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39",
|
||||
"type": "github"
|
||||
},
|
||||
"original": {
|
||||
|
@@ -1,6 +1,6 @@
|
||||
{
|
||||
"sdk": {
|
||||
"version": "8.0.100",
|
||||
"rollForward": "latestFeature"
|
||||
"rollForward": "latestMajor"
|
||||
}
|
||||
}
|
||||
|
20
nix/deps.nix
20
nix/deps.nix
@@ -8,8 +8,8 @@
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "fantomas";
|
||||
version = "6.3.11";
|
||||
hash = "sha256-11bHGEAZTNtdp2pTg5zqLrQiyI/j/AT7GGL/2CR4+dw=";
|
||||
version = "6.3.12";
|
||||
hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Fantomas.Core";
|
||||
@@ -78,13 +78,13 @@
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Microsoft.CodeCoverage";
|
||||
version = "17.11.0";
|
||||
hash = "sha256-XglInnx5GePUYHG7n2NLX+WfK7kJnornsWOW/5FnOXE=";
|
||||
version = "17.11.1";
|
||||
hash = "sha256-1dLlK3NGh88PuFYZiYpT+izA96etxhU3BSgixDgdtGA=";
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Microsoft.NET.Test.Sdk";
|
||||
version = "17.11.0";
|
||||
hash = "sha256-WjyA78+PG9ZloWTt9Hf1ek3VVj2FfJ9fAjqklnN+fWw=";
|
||||
version = "17.11.1";
|
||||
hash = "sha256-0JUEucQ2lzaPgkrjm/NFLBTbqU1dfhvhN3Tl3moE6mI=";
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Microsoft.NETCore.App.Host.linux-arm64";
|
||||
@@ -153,13 +153,13 @@
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Microsoft.TestPlatform.ObjectModel";
|
||||
version = "17.11.0";
|
||||
hash = "sha256-mCI3MCV6nyrGLrBat5VvK5LrXTEKlsdp9NkpZyJYwVg=";
|
||||
version = "17.11.1";
|
||||
hash = "sha256-5vX+vCzFY3S7xfMVIv8OlMMFtdedW9UIJzc0WEc+vm4=";
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Microsoft.TestPlatform.TestHost";
|
||||
version = "17.11.0";
|
||||
hash = "sha256-gViDLobza22kuLvB4JdlGtbANqwBHRwf1wLmIHMw9Eo=";
|
||||
version = "17.11.1";
|
||||
hash = "sha256-wSkY0H1fQAq0H3LcKT4u7Y5RzhAAPa6yueVN84g8HxU=";
|
||||
})
|
||||
(fetchNuGet {
|
||||
pname = "Myriad.Core";
|
||||
|
Reference in New Issue
Block a user