mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-07 21:18:44 +00:00
Compare commits
9 Commits
WoofWare.M
...
WoofWare.M
Author | SHA1 | Date | |
---|---|---|---|
|
09b7109c84 | ||
|
693b95106a | ||
|
49ecfbf5e5 | ||
|
5748ac3d5b | ||
|
913959a740 | ||
|
93ffc065cd | ||
|
d14efba7e7 | ||
|
f5cf0b79dd | ||
|
029e3746bb |
@@ -3,7 +3,7 @@
|
|||||||
"isRoot": true,
|
"isRoot": true,
|
||||||
"tools": {
|
"tools": {
|
||||||
"fantomas": {
|
"fantomas": {
|
||||||
"version": "6.3.11",
|
"version": "6.3.12",
|
||||||
"commands": [
|
"commands": [
|
||||||
"fantomas"
|
"fantomas"
|
||||||
]
|
]
|
||||||
|
4
.github/workflows/dotnet.yaml
vendored
4
.github/workflows/dotnet.yaml
vendored
@@ -241,7 +241,7 @@ jobs:
|
|||||||
name: nuget-package-attribute
|
name: nuget-package-attribute
|
||||||
path: packed
|
path: packed
|
||||||
- name: Attest Build Provenance
|
- name: Attest Build Provenance
|
||||||
uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
|
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
|
||||||
with:
|
with:
|
||||||
subject-path: "packed/*.nupkg"
|
subject-path: "packed/*.nupkg"
|
||||||
|
|
||||||
@@ -260,7 +260,7 @@ jobs:
|
|||||||
name: nuget-package-plugin
|
name: nuget-package-plugin
|
||||||
path: packed
|
path: packed
|
||||||
- name: Attest Build Provenance
|
- name: Attest Build Provenance
|
||||||
uses: actions/attest-build-provenance@6149ea5740be74af77f260b9db67e633f6b0a9a1 # v1.4.2
|
uses: actions/attest-build-provenance@1c608d11d69870c2092266b3f9a6f3abbf17002c # v1.4.3
|
||||||
with:
|
with:
|
||||||
subject-path: "packed/*.nupkg"
|
subject-path: "packed/*.nupkg"
|
||||||
|
|
||||||
|
@@ -190,3 +190,48 @@ type ManyLongForms =
|
|||||||
[<ArgumentLongForm "dont-turn-it-off">]
|
[<ArgumentLongForm "dont-turn-it-off">]
|
||||||
SomeFlag : bool
|
SomeFlag : bool
|
||||||
}
|
}
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
type private IrrelevantDu =
|
||||||
|
| Foo
|
||||||
|
| Bar
|
||||||
|
|
||||||
|
[<ArgParser true>]
|
||||||
|
type FlagsIntoPositionalArgs =
|
||||||
|
{
|
||||||
|
A : string
|
||||||
|
[<PositionalArgs true>]
|
||||||
|
GrabEverything : string list
|
||||||
|
}
|
||||||
|
|
||||||
|
[<ArgParser true>]
|
||||||
|
type FlagsIntoPositionalArgsChoice =
|
||||||
|
{
|
||||||
|
A : string
|
||||||
|
[<PositionalArgs true>]
|
||||||
|
GrabEverything : Choice<string, string> list
|
||||||
|
}
|
||||||
|
|
||||||
|
[<ArgParser true>]
|
||||||
|
type FlagsIntoPositionalArgsInt =
|
||||||
|
{
|
||||||
|
A : string
|
||||||
|
[<PositionalArgs true>]
|
||||||
|
GrabEverything : int list
|
||||||
|
}
|
||||||
|
|
||||||
|
[<ArgParser true>]
|
||||||
|
type FlagsIntoPositionalArgsIntChoice =
|
||||||
|
{
|
||||||
|
A : string
|
||||||
|
[<PositionalArgs true>]
|
||||||
|
GrabEverything : Choice<int, int> 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,
|
/// Attribute indicating that this field shall accumulate all unmatched args,
|
||||||
/// as well as any that appear after a bare `--`.
|
/// 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 ()
|
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
|
/// Attribute indicating that this field shall have a default value derived
|
||||||
/// from calling an appropriately named static method on the type.
|
/// from calling an appropriately named static method on the type.
|
||||||
///
|
///
|
||||||
|
@@ -40,7 +40,10 @@ WoofWare.Myriad.Plugins.JsonSerializeAttribute.get_DefaultIsExtensionMethod [sta
|
|||||||
WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute
|
WoofWare.Myriad.Plugins.ParseExactAttribute inherit System.Attribute
|
||||||
WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
|
WoofWare.Myriad.Plugins.ParseExactAttribute..ctor [constructor]: string
|
||||||
WoofWare.Myriad.Plugins.PositionalArgsAttribute inherit System.Attribute
|
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..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 inherit System.Attribute
|
||||||
WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
|
WoofWare.Myriad.Plugins.RemoveOptionsAttribute..ctor [constructor]: unit
|
||||||
WoofWare.Myriad.Plugins.RestEase inherit obj
|
WoofWare.Myriad.Plugins.RestEase inherit obj
|
||||||
|
@@ -18,7 +18,7 @@
|
|||||||
|
|
||||||
<ItemGroup>
|
<ItemGroup>
|
||||||
<PackageReference Include="ApiSurface" Version="4.1.5" />
|
<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="NUnit" Version="4.2.2"/>
|
||||||
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
@@ -1,5 +1,5 @@
|
|||||||
{
|
{
|
||||||
"version": "3.4",
|
"version": "3.5",
|
||||||
"publicReleaseRefSpec": [
|
"publicReleaseRefSpec": [
|
||||||
"^refs/heads/main$"
|
"^refs/heads/main$"
|
||||||
],
|
],
|
||||||
|
@@ -618,3 +618,89 @@ Required argument '--exact' received no value"""
|
|||||||
"""Help text requested.
|
"""Help text requested.
|
||||||
--do-something-else / --anotherarg string
|
--do-something-else / --anotherarg string
|
||||||
--turn-it-on / --dont-turn-it-off bool"""
|
--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 collect non-help args into positional args with Choice`` () =
|
||||||
|
let getEnvVar (_ : string) = failwith "do not call"
|
||||||
|
|
||||||
|
FlagsIntoPositionalArgsChoice.parse' getEnvVar [ "--a" ; "foo" ; "--b=false" ; "--c" ; "hi" ; "--" ; "--help" ]
|
||||||
|
|> shouldEqual
|
||||||
|
{
|
||||||
|
A = "foo"
|
||||||
|
GrabEverything =
|
||||||
|
[
|
||||||
|
Choice1Of2 "--b=false"
|
||||||
|
Choice1Of2 "--c"
|
||||||
|
Choice1Of2 "hi"
|
||||||
|
Choice2Of2 "--help"
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
[<Test>]
|
||||||
|
let ``Can collect non-help args into positional args, and we parse on the way`` () =
|
||||||
|
let getEnvVar (_ : string) = failwith "do not call"
|
||||||
|
|
||||||
|
FlagsIntoPositionalArgsInt.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|
||||||
|
|> shouldEqual
|
||||||
|
{
|
||||||
|
A = "foo"
|
||||||
|
GrabEverything = [ 3 ; 5 ; 98 ]
|
||||||
|
}
|
||||||
|
|
||||||
|
[<Test>]
|
||||||
|
let ``Can collect non-help args into positional args with Choice, and we parse on the way`` () =
|
||||||
|
let getEnvVar (_ : string) = failwith "do not call"
|
||||||
|
|
||||||
|
FlagsIntoPositionalArgsIntChoice.parse' getEnvVar [ "3" ; "--a" ; "foo" ; "5" ; "--" ; "98" ]
|
||||||
|
|> shouldEqual
|
||||||
|
{
|
||||||
|
A = "foo"
|
||||||
|
GrabEverything = [ Choice1Of2 3 ; Choice1Of2 5 ; Choice2Of2 98 ]
|
||||||
|
}
|
||||||
|
|
||||||
|
[<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"""
|
||||||
|
@@ -42,7 +42,7 @@
|
|||||||
<PackageReference Include="ApiSurface" Version="4.1.5"/>
|
<PackageReference Include="ApiSurface" Version="4.1.5"/>
|
||||||
<PackageReference Include="FsCheck" Version="2.16.6"/>
|
<PackageReference Include="FsCheck" Version="2.16.6"/>
|
||||||
<PackageReference Include="FsUnit" Version="6.0.0"/>
|
<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="NUnit" Version="4.2.2"/>
|
||||||
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
<PackageReference Include="NUnit3TestAdapter" Version="4.6.0"/>
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
|
@@ -85,8 +85,8 @@ type private ParseFunction<'acc> =
|
|||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
type private ChoicePositional =
|
type private ChoicePositional =
|
||||||
| Normal
|
| Normal of includeFlagLike : SynExpr option
|
||||||
| Choice
|
| Choice of includeFlagLike : SynExpr option
|
||||||
|
|
||||||
type private ParseFunctionPositional = ParseFunction<ChoicePositional>
|
type private ParseFunctionPositional = ParseFunction<ChoicePositional>
|
||||||
type private ParseFunctionNonPositional = ParseFunction<Accumulation<ArgumentDefaultSpec>>
|
type private ParseFunctionNonPositional = ParseFunction<Accumulation<ArgumentDefaultSpec>>
|
||||||
@@ -506,11 +506,14 @@ module internal ArgParserGenerator =
|
|||||||
|
|
||||||
let positionalArgAttr =
|
let positionalArgAttr =
|
||||||
attrs
|
attrs
|
||||||
|> List.tryFind (fun a ->
|
|> List.tryPick (fun a ->
|
||||||
match (List.last a.TypeName.LongIdent).idText with
|
match (List.last a.TypeName.LongIdent).idText with
|
||||||
| "PositionalArgsAttribute"
|
| "PositionalArgsAttribute"
|
||||||
| "PositionalArgs" -> true
|
| "PositionalArgs" ->
|
||||||
| _ -> false
|
match a.ArgExpr with
|
||||||
|
| SynExpr.Const (SynConst.Unit, _) -> Some None
|
||||||
|
| a -> Some (Some a)
|
||||||
|
| _ -> None
|
||||||
)
|
)
|
||||||
|
|
||||||
let parseExactModifier =
|
let parseExactModifier =
|
||||||
@@ -580,7 +583,7 @@ module internal ArgParserGenerator =
|
|||||||
| None ->
|
| None ->
|
||||||
|
|
||||||
match positionalArgAttr with
|
match positionalArgAttr with
|
||||||
| Some _ ->
|
| Some includeFlagLike ->
|
||||||
let getChoice (spec : ArgumentDefaultSpec option) : unit =
|
let getChoice (spec : ArgumentDefaultSpec option) : unit =
|
||||||
match spec with
|
match spec with
|
||||||
| Some _ ->
|
| Some _ ->
|
||||||
@@ -607,7 +610,7 @@ module internal ArgParserGenerator =
|
|||||||
FieldName = ident
|
FieldName = ident
|
||||||
Parser = parser
|
Parser = parser
|
||||||
TargetVariable = Ident.create $"arg_%i{counter}"
|
TargetVariable = Ident.create $"arg_%i{counter}"
|
||||||
Accumulation = ChoicePositional.Choice
|
Accumulation = ChoicePositional.Choice includeFlagLike
|
||||||
TargetType = parseTy
|
TargetType = parseTy
|
||||||
ArgForm = longForms
|
ArgForm = longForms
|
||||||
Help = helpText
|
Help = helpText
|
||||||
@@ -619,7 +622,7 @@ module internal ArgParserGenerator =
|
|||||||
FieldName = ident
|
FieldName = ident
|
||||||
Parser = parser
|
Parser = parser
|
||||||
TargetVariable = Ident.create $"arg_%i{counter}"
|
TargetVariable = Ident.create $"arg_%i{counter}"
|
||||||
Accumulation = ChoicePositional.Normal
|
Accumulation = ChoicePositional.Normal includeFlagLike
|
||||||
TargetType = parseTy
|
TargetType = parseTy
|
||||||
ArgForm = longForms
|
ArgForm = longForms
|
||||||
Help = helpText
|
Help = helpText
|
||||||
@@ -723,7 +726,10 @@ module internal ArgParserGenerator =
|
|||||||
]
|
]
|
||||||
|> SynExpr.createMatch (SynExpr.callMethod var.idText (SynExpr.createIdent' typeName))
|
|> SynExpr.createMatch (SynExpr.callMethod var.idText (SynExpr.createIdent' typeName))
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst " (default value: %O)")
|
SynExpr.createLambda "x" (SynExpr.callMethod "ToString" (SynExpr.createIdent "x"))
|
||||||
|
)
|
||||||
|
|> SynExpr.pipeThroughFunction (
|
||||||
|
SynExpr.applyFunction (SynExpr.createIdent "sprintf") (SynExpr.CreateConst " (default value: %s)")
|
||||||
)
|
)
|
||||||
|> SynExpr.paren
|
|> SynExpr.paren
|
||||||
| Accumulation.List _ -> SynExpr.CreateConst " (can be repeated)"
|
| Accumulation.List _ -> SynExpr.CreateConst " (can be repeated)"
|
||||||
@@ -786,10 +792,12 @@ module internal ArgParserGenerator =
|
|||||||
| Accumulation.Optional ->
|
| Accumulation.Optional ->
|
||||||
let multipleErrorMessage =
|
let multipleErrorMessage =
|
||||||
SynExpr.createIdent "sprintf"
|
SynExpr.createIdent "sprintf"
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %O and %O")
|
|> SynExpr.applyTo (SynExpr.CreateConst "Argument '%s' was supplied multiple times: %s and %s")
|
||||||
|> SynExpr.applyTo arg.HumanReadableArgForm
|
|> SynExpr.applyTo arg.HumanReadableArgForm
|
||||||
|> SynExpr.applyTo (SynExpr.createIdent "x")
|
|> SynExpr.applyTo (SynExpr.createIdent "x" |> SynExpr.callMethod "ToString" |> SynExpr.paren)
|
||||||
|> SynExpr.applyTo (SynExpr.createIdent "value")
|
|> SynExpr.applyTo (
|
||||||
|
SynExpr.createIdent "value" |> SynExpr.callMethod "ToString" |> SynExpr.paren
|
||||||
|
)
|
||||||
|
|
||||||
let performAssignment =
|
let performAssignment =
|
||||||
[
|
[
|
||||||
@@ -850,8 +858,9 @@ module internal ArgParserGenerator =
|
|||||||
|> SynExpr.pipeThroughFunction pos.Parser
|
|> SynExpr.pipeThroughFunction pos.Parser
|
||||||
|> fun p ->
|
|> fun p ->
|
||||||
match pos.Accumulation with
|
match pos.Accumulation with
|
||||||
| ChoicePositional.Choice -> p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
|
| ChoicePositional.Choice _ ->
|
||||||
| ChoicePositional.Normal -> p
|
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
|
||||||
|
| ChoicePositional.Normal _ -> p
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
|
SynExpr.createLongIdent' [ pos.TargetVariable ; Ident.create "Add" ]
|
||||||
)
|
)
|
||||||
@@ -995,6 +1004,50 @@ module internal ArgParserGenerator =
|
|||||||
|> SynExpr.applyTo (SynExpr.createIdent "key")
|
|> SynExpr.applyTo (SynExpr.createIdent "key")
|
||||||
|> SynExpr.applyTo (SynExpr.createIdent "value")
|
|> SynExpr.applyTo (SynExpr.createIdent "value")
|
||||||
|
|
||||||
|
let processAsPositional =
|
||||||
|
SynExpr.sequential
|
||||||
|
[
|
||||||
|
SynExpr.createIdent "arg"
|
||||||
|
|> SynExpr.pipeThroughFunction leftoverArgParser
|
||||||
|
|> fun p ->
|
||||||
|
match leftoverArgAcc with
|
||||||
|
| ChoicePositional.Normal _ -> p
|
||||||
|
| ChoicePositional.Choice _ ->
|
||||||
|
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
|
||||||
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
|
||||||
|
|
||||||
|
recurseKey
|
||||||
|
]
|
||||||
|
|
||||||
|
let posAttr =
|
||||||
|
match leftoverArgAcc with
|
||||||
|
| ChoicePositional.Choice a
|
||||||
|
| ChoicePositional.Normal a -> a
|
||||||
|
|
||||||
|
let notMatched =
|
||||||
|
let handleFailure =
|
||||||
|
[
|
||||||
|
SynMatchClause.create (SynPat.named "None") fail
|
||||||
|
|
||||||
|
SynMatchClause.create
|
||||||
|
(SynPat.nameWithArgs "Some" [ SynPat.named "msg" ])
|
||||||
|
(SynExpr.sequential
|
||||||
|
[
|
||||||
|
SynExpr.createIdent "sprintf"
|
||||||
|
|> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)")
|
||||||
|
|> SynExpr.applyTo (SynExpr.createIdent "msg")
|
||||||
|
|> SynExpr.applyTo (SynExpr.createIdent "arg")
|
||||||
|
|> SynExpr.pipeThroughFunction (SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc))
|
||||||
|
|
||||||
|
recurseKey
|
||||||
|
])
|
||||||
|
]
|
||||||
|
|> SynExpr.createMatch (SynExpr.createIdent "x")
|
||||||
|
|
||||||
|
match posAttr with
|
||||||
|
| None -> handleFailure
|
||||||
|
| Some posAttr -> SynExpr.ifThenElse posAttr handleFailure processAsPositional
|
||||||
|
|
||||||
let argStartsWithDashes =
|
let argStartsWithDashes =
|
||||||
SynExpr.createIdent "arg"
|
SynExpr.createIdent "arg"
|
||||||
|> SynExpr.callMethodArg
|
|> SynExpr.callMethodArg
|
||||||
@@ -1008,19 +1061,7 @@ module internal ArgParserGenerator =
|
|||||||
let processKey =
|
let processKey =
|
||||||
SynExpr.ifThenElse
|
SynExpr.ifThenElse
|
||||||
argStartsWithDashes
|
argStartsWithDashes
|
||||||
(SynExpr.sequential
|
processAsPositional
|
||||||
[
|
|
||||||
SynExpr.createIdent "arg"
|
|
||||||
|> SynExpr.pipeThroughFunction leftoverArgParser
|
|
||||||
|> fun p ->
|
|
||||||
match leftoverArgAcc with
|
|
||||||
| ChoicePositional.Normal -> p
|
|
||||||
| ChoicePositional.Choice ->
|
|
||||||
p |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
|
|
||||||
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
|
|
||||||
|
|
||||||
recurseKey
|
|
||||||
])
|
|
||||||
(SynExpr.ifThenElse
|
(SynExpr.ifThenElse
|
||||||
(SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help"))
|
(SynExpr.equals (SynExpr.createIdent "arg") (SynExpr.CreateConst "--help"))
|
||||||
(SynExpr.createLet
|
(SynExpr.createLet
|
||||||
@@ -1056,23 +1097,9 @@ module internal ArgParserGenerator =
|
|||||||
[
|
[
|
||||||
SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey
|
SynMatchClause.create (SynPat.nameWithArgs "Ok" [ SynPat.unit ]) recurseKey
|
||||||
|
|
||||||
SynMatchClause.create (SynPat.nameWithArgs "Error" [ SynPat.named "None" ]) fail
|
|
||||||
SynMatchClause.create
|
SynMatchClause.create
|
||||||
(SynPat.nameWithArgs
|
(SynPat.nameWithArgs "Error" [ SynPat.named "x" ])
|
||||||
"Error"
|
notMatched
|
||||||
[ SynPat.nameWithArgs "Some" [ SynPat.named "msg" ] |> SynPat.paren ])
|
|
||||||
(SynExpr.sequential
|
|
||||||
[
|
|
||||||
SynExpr.createIdent "sprintf"
|
|
||||||
|> SynExpr.applyTo (SynExpr.CreateConst "%s (at arg %s)")
|
|
||||||
|> SynExpr.applyTo (SynExpr.createIdent "msg")
|
|
||||||
|> SynExpr.applyTo (SynExpr.createIdent "arg")
|
|
||||||
|> SynExpr.pipeThroughFunction (
|
|
||||||
SynExpr.dotGet "Add" (SynExpr.createIdent' errorAcc)
|
|
||||||
)
|
|
||||||
|
|
||||||
recurseKey
|
|
||||||
])
|
|
||||||
]))
|
]))
|
||||||
(SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue)))
|
(SynExpr.createIdent "args" |> SynExpr.pipeThroughFunction recurseValue)))
|
||||||
(SynExpr.createIdent "helpText"
|
(SynExpr.createIdent "helpText"
|
||||||
@@ -1086,6 +1113,8 @@ module internal ArgParserGenerator =
|
|||||||
let processValue =
|
let processValue =
|
||||||
// During failure, we've received an optional exception message that happened when we tried to parse
|
// During failure, we've received an optional exception message that happened when we tried to parse
|
||||||
// the value; it's in the variable `exc`.
|
// the value; it's in the variable `exc`.
|
||||||
|
// `fail` is for the case where we're genuinely emitting an error.
|
||||||
|
// If we're in `PositionalArgs true` mode, though, we won't call `fail`.
|
||||||
let fail =
|
let fail =
|
||||||
[
|
[
|
||||||
SynExpr.createIdent "failwithf"
|
SynExpr.createIdent "failwithf"
|
||||||
@@ -1105,6 +1134,27 @@ module internal ArgParserGenerator =
|
|||||||
]
|
]
|
||||||
|> SynExpr.createMatch (SynExpr.createIdent "exc")
|
|> SynExpr.createMatch (SynExpr.createIdent "exc")
|
||||||
|
|
||||||
|
let onFailure =
|
||||||
|
match posAttr with
|
||||||
|
| None -> fail
|
||||||
|
| Some includeFlagLike ->
|
||||||
|
[
|
||||||
|
SynExpr.createIdent "key"
|
||||||
|
|> SynExpr.pipeThroughFunction leftoverArgParser
|
||||||
|
|> fun i ->
|
||||||
|
match leftoverArgAcc with
|
||||||
|
| ChoicePositional.Choice _ ->
|
||||||
|
i |> SynExpr.pipeThroughFunction (SynExpr.createIdent "Choice1Of2")
|
||||||
|
| ChoicePositional.Normal _ -> i
|
||||||
|
|> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' [ leftoverArgs ; Ident.create "Add" ])
|
||||||
|
|
||||||
|
SynExpr.createIdent "go"
|
||||||
|
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|
||||||
|
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))
|
||||||
|
]
|
||||||
|
|> SynExpr.sequential
|
||||||
|
|> SynExpr.ifThenElse includeFlagLike fail
|
||||||
|
|
||||||
[
|
[
|
||||||
SynMatchClause.create
|
SynMatchClause.create
|
||||||
(SynPat.nameWithArgs "Ok" [ SynPat.unit ])
|
(SynPat.nameWithArgs "Ok" [ SynPat.unit ])
|
||||||
@@ -1117,7 +1167,7 @@ module internal ArgParserGenerator =
|
|||||||
(SynPat.nameWithArgs "Error" [ SynPat.named "exc" ])
|
(SynPat.nameWithArgs "Error" [ SynPat.named "exc" ])
|
||||||
(SynExpr.ifThenElse
|
(SynExpr.ifThenElse
|
||||||
(SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key"))
|
(SynExpr.applyFunction (SynExpr.createIdent "setFlagValue") (SynExpr.createIdent "key"))
|
||||||
fail
|
onFailure
|
||||||
(SynExpr.createIdent "go"
|
(SynExpr.createIdent "go"
|
||||||
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|
|> SynExpr.applyTo (SynExpr.createLongIdent' [ parseState ; Ident.create "AwaitingKey" ])
|
||||||
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))))
|
|> SynExpr.applyTo (SynExpr.listCons (SynExpr.createIdent "arg") (SynExpr.createIdent "args"))))
|
||||||
@@ -1184,8 +1234,8 @@ module internal ArgParserGenerator =
|
|||||||
)
|
)
|
||||||
|> fun p ->
|
|> fun p ->
|
||||||
match leftoverArgAcc with
|
match leftoverArgAcc with
|
||||||
| ChoicePositional.Normal -> p
|
| ChoicePositional.Normal _ -> p
|
||||||
| ChoicePositional.Choice ->
|
| ChoicePositional.Choice _ ->
|
||||||
p
|
p
|
||||||
|> SynExpr.pipeThroughFunction (
|
|> SynExpr.pipeThroughFunction (
|
||||||
SynExpr.applyFunction
|
SynExpr.applyFunction
|
||||||
@@ -1257,9 +1307,9 @@ module internal ArgParserGenerator =
|
|||||||
SynType.string
|
SynType.string
|
||||||
| Some pf ->
|
| Some pf ->
|
||||||
match pf.Accumulation with
|
match pf.Accumulation with
|
||||||
| ChoicePositional.Choice ->
|
| ChoicePositional.Choice _ ->
|
||||||
pf.TargetVariable, pf.Parser, SynType.app "Choice" [ pf.TargetType ; pf.TargetType ]
|
pf.TargetVariable, pf.Parser, SynType.app "Choice" [ pf.TargetType ; pf.TargetType ]
|
||||||
| ChoicePositional.Normal -> pf.TargetVariable, pf.Parser, pf.TargetType
|
| ChoicePositional.Normal _ -> pf.TargetVariable, pf.Parser, pf.TargetType
|
||||||
|
|
||||||
let bindings =
|
let bindings =
|
||||||
SynExpr.createIdent "ResizeArray"
|
SynExpr.createIdent "ResizeArray"
|
||||||
@@ -1487,7 +1537,7 @@ module internal ArgParserGenerator =
|
|||||||
|
|
||||||
let leftoverArgAcc =
|
let leftoverArgAcc =
|
||||||
match pos with
|
match pos with
|
||||||
| None -> ChoicePositional.Normal
|
| None -> ChoicePositional.Normal None
|
||||||
| Some pos -> pos.Accumulation
|
| Some pos -> pos.Accumulation
|
||||||
|
|
||||||
[
|
[
|
||||||
@@ -1521,53 +1571,54 @@ module internal ArgParserGenerator =
|
|||||||
|> List.choose (fun ty ->
|
|> List.choose (fun ty ->
|
||||||
match ty.Cases with
|
match ty.Cases with
|
||||||
| [ c1 ; c2 ] ->
|
| [ c1 ; c2 ] ->
|
||||||
|
let c1Attr =
|
||||||
|
c1.Attributes
|
||||||
|
|> List.tryPick (fun attr ->
|
||||||
|
match attr.TypeName with
|
||||||
|
| SynLongIdent.SynLongIdent (id, _, _) ->
|
||||||
|
match id |> List.last |> _.idText with
|
||||||
|
| "ArgumentFlagAttribute"
|
||||||
|
| "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
|
||||||
|
| _ -> None
|
||||||
|
)
|
||||||
|
|
||||||
|
let c2Attr =
|
||||||
|
c2.Attributes
|
||||||
|
|> List.tryPick (fun attr ->
|
||||||
|
match attr.TypeName with
|
||||||
|
| SynLongIdent.SynLongIdent (id, _, _) ->
|
||||||
|
match id |> List.last |> _.idText with
|
||||||
|
| "ArgumentFlagAttribute"
|
||||||
|
| "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
|
||||||
|
| _ -> None
|
||||||
|
)
|
||||||
|
|
||||||
|
match c1Attr, c2Attr with
|
||||||
|
| Some _, None
|
||||||
|
| None, Some _ ->
|
||||||
|
failwith
|
||||||
|
"[<ArgumentFlag>] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case."
|
||||||
|
| None, None -> None
|
||||||
|
| Some c1Attr, Some c2Attr ->
|
||||||
|
|
||||||
|
// Sanity check where possible
|
||||||
|
match c1Attr, c2Attr with
|
||||||
|
| SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) ->
|
||||||
|
if b1 = b2 then
|
||||||
|
failwith
|
||||||
|
"[<ArgumentFlag>] must have opposite argument values on each case in a two-case discriminated union."
|
||||||
|
| _, _ -> ()
|
||||||
|
|
||||||
match c1.Fields, c2.Fields with
|
match c1.Fields, c2.Fields with
|
||||||
| [], [] ->
|
| [], [] ->
|
||||||
let c1Attr =
|
{
|
||||||
c1.Attributes
|
Name = ty.Name
|
||||||
|> List.tryPick (fun attr ->
|
Case1Name = c1.Name
|
||||||
match attr.TypeName with
|
Case1Arg = c1Attr
|
||||||
| SynLongIdent.SynLongIdent (id, _, _) ->
|
Case2Name = c2.Name
|
||||||
match id |> List.last |> _.idText with
|
Case2Arg = c2Attr
|
||||||
| "ArgumentFlagAttribute"
|
}
|
||||||
| "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
|
|> Some
|
||||||
| _ -> None
|
|
||||||
)
|
|
||||||
|
|
||||||
let c2Attr =
|
|
||||||
c2.Attributes
|
|
||||||
|> List.tryPick (fun attr ->
|
|
||||||
match attr.TypeName with
|
|
||||||
| SynLongIdent.SynLongIdent (id, _, _) ->
|
|
||||||
match id |> List.last |> _.idText with
|
|
||||||
| "ArgumentFlagAttribute"
|
|
||||||
| "ArgumentFlag" -> Some (SynExpr.stripOptionalParen attr.ArgExpr)
|
|
||||||
| _ -> None
|
|
||||||
)
|
|
||||||
|
|
||||||
match c1Attr, c2Attr with
|
|
||||||
| Some c1Attr, Some c2Attr ->
|
|
||||||
// Sanity check where possible
|
|
||||||
match c1Attr, c2Attr with
|
|
||||||
| SynExpr.Const (SynConst.Bool b1, _), SynExpr.Const (SynConst.Bool b2, _) ->
|
|
||||||
if b1 = b2 then
|
|
||||||
failwith
|
|
||||||
"[<ArgumentFlag>] must have opposite argument values on each case in a two-case discriminated union."
|
|
||||||
| _, _ -> ()
|
|
||||||
|
|
||||||
{
|
|
||||||
Name = ty.Name
|
|
||||||
Case1Name = c1.Name
|
|
||||||
Case1Arg = c1Attr
|
|
||||||
Case2Name = c2.Name
|
|
||||||
Case2Arg = c2Attr
|
|
||||||
}
|
|
||||||
|> Some
|
|
||||||
| Some _, None
|
|
||||||
| None, Some _ ->
|
|
||||||
failwith
|
|
||||||
"[<ArgumentFlag>] must be placed on both cases of a two-case discriminated union, with opposite argument values on each case."
|
|
||||||
| _, _ -> None
|
|
||||||
| _, _ ->
|
| _, _ ->
|
||||||
failwith "[<ArgumentFlag>] may only be placed on discriminated union members with no data."
|
failwith "[<ArgumentFlag>] may only be placed on discriminated union members with no data."
|
||||||
| _ -> None
|
| _ -> None
|
||||||
|
@@ -67,7 +67,8 @@ type internal RecordType =
|
|||||||
Members : SynMemberDefns option
|
Members : SynMemberDefns option
|
||||||
XmlDoc : PreXmlDoc option
|
XmlDoc : PreXmlDoc option
|
||||||
Generics : SynTyparDecls option
|
Generics : SynTyparDecls option
|
||||||
Accessibility : SynAccess option
|
TypeAccessibility : SynAccess option
|
||||||
|
ImplAccessibility : SynAccess option
|
||||||
Attributes : SynAttribute list
|
Attributes : SynAttribute list
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -80,17 +81,15 @@ type internal RecordType =
|
|||||||
: RecordType
|
: RecordType
|
||||||
=
|
=
|
||||||
match sci with
|
match sci with
|
||||||
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access2, _) ->
|
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
|
||||||
if access <> access2 then
|
|
||||||
failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
|
|
||||||
|
|
||||||
{
|
{
|
||||||
Name = List.last longId
|
Name = List.last longId
|
||||||
Fields = recordFields
|
Fields = recordFields
|
||||||
Members = if smd.IsEmpty then None else Some smd
|
Members = if smd.IsEmpty then None else Some smd
|
||||||
XmlDoc = if doc.IsEmpty then None else Some doc
|
XmlDoc = if doc.IsEmpty then None else Some doc
|
||||||
Generics = typars
|
Generics = typars
|
||||||
Accessibility = access
|
ImplAccessibility = implAccess
|
||||||
|
TypeAccessibility = access
|
||||||
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -144,7 +143,9 @@ type internal UnionType =
|
|||||||
/// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
|
/// Attributes of the DU (not its cases): `[<Attr>] type Foo = | ...`
|
||||||
Attributes : SynAttribute list
|
Attributes : SynAttribute list
|
||||||
/// Accessibility modifier of the DU: `type private Foo = ...`
|
/// Accessibility modifier of the DU: `type private Foo = ...`
|
||||||
Accessibility : SynAccess option
|
TypeAccessibility : SynAccess option
|
||||||
|
/// Accessibility modifier of the DU's implementation: `type Foo = private | ...`
|
||||||
|
ImplAccessibility : SynAccess option
|
||||||
/// The actual DU cases themselves.
|
/// The actual DU cases themselves.
|
||||||
Cases : UnionCase<Ident option> list
|
Cases : UnionCase<Ident option> list
|
||||||
}
|
}
|
||||||
@@ -157,17 +158,15 @@ type internal UnionType =
|
|||||||
: UnionType
|
: UnionType
|
||||||
=
|
=
|
||||||
match sci with
|
match sci with
|
||||||
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, access2, _) ->
|
| SynComponentInfo.SynComponentInfo (attrs, typars, _, longId, doc, _, implAccess, _) ->
|
||||||
if access <> access2 then
|
|
||||||
failwith $"TODO what's happened, two different accessibility modifiers: %O{access} and %O{access2}"
|
|
||||||
|
|
||||||
{
|
{
|
||||||
Name = List.last longId
|
Name = List.last longId
|
||||||
Members = if smd.IsEmpty then None else Some smd
|
Members = if smd.IsEmpty then None else Some smd
|
||||||
XmlDoc = if doc.IsEmpty then None else Some doc
|
XmlDoc = if doc.IsEmpty then None else Some doc
|
||||||
Generics = typars
|
Generics = typars
|
||||||
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
Attributes = attrs |> List.collect (fun l -> l.Attributes)
|
||||||
Accessibility = access
|
TypeAccessibility = access
|
||||||
|
ImplAccessibility = implAccess
|
||||||
Cases = cases |> List.map UnionCase.ofSynUnionCase
|
Cases = cases |> List.map UnionCase.ofSynUnionCase
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -213,13 +212,13 @@ module internal AstHelper =
|
|||||||
let defineRecordType (record : RecordType) : SynTypeDefn =
|
let defineRecordType (record : RecordType) : SynTypeDefn =
|
||||||
let name =
|
let name =
|
||||||
SynComponentInfo.create record.Name
|
SynComponentInfo.create record.Name
|
||||||
|> SynComponentInfo.setAccessibility record.Accessibility
|
|> SynComponentInfo.setAccessibility record.TypeAccessibility
|
||||||
|> match record.XmlDoc with
|
|> match record.XmlDoc with
|
||||||
| None -> id
|
| None -> id
|
||||||
| Some doc -> SynComponentInfo.withDocString doc
|
| Some doc -> SynComponentInfo.withDocString doc
|
||||||
|> SynComponentInfo.setGenerics record.Generics
|
|> SynComponentInfo.setGenerics record.Generics
|
||||||
|
|
||||||
SynTypeDefnRepr.record (Seq.toList record.Fields)
|
SynTypeDefnRepr.recordWithAccess record.ImplAccessibility (Seq.toList record.Fields)
|
||||||
|> SynTypeDefn.create name
|
|> SynTypeDefn.create name
|
||||||
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
|
|> SynTypeDefn.withMemberDefns (defaultArg record.Members SynMemberDefns.Empty)
|
||||||
|
|
||||||
|
@@ -564,11 +564,12 @@ module internal CataGenerator =
|
|||||||
let domain =
|
let domain =
|
||||||
field.FieldName
|
field.FieldName
|
||||||
|> Option.map Ident.lowerFirstLetter
|
|> Option.map Ident.lowerFirstLetter
|
||||||
|> SynType.signatureParamOfType place
|
|> SynType.signatureParamOfType [] place false
|
||||||
|
|
||||||
acc |> SynType.funFromDomain domain
|
acc |> SynType.funFromDomain domain
|
||||||
)
|
)
|
||||||
|> SynMemberDefn.abstractMember
|
|> SynMemberDefn.abstractMember
|
||||||
|
[]
|
||||||
case.CataMethodIdent
|
case.CataMethodIdent
|
||||||
None
|
None
|
||||||
arity
|
arity
|
||||||
|
@@ -212,7 +212,8 @@ module internal InterfaceMockGenerator =
|
|||||||
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
|
Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces)
|
||||||
XmlDoc = Some xmlDoc
|
XmlDoc = Some xmlDoc
|
||||||
Generics = interfaceType.Generics
|
Generics = interfaceType.Generics
|
||||||
Accessibility = Some access
|
TypeAccessibility = Some access
|
||||||
|
ImplAccessibility = None
|
||||||
Attributes = []
|
Attributes = []
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -227,14 +228,11 @@ module internal InterfaceMockGenerator =
|
|||||||
x.Type
|
x.Type
|
||||||
|
|
||||||
let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
|
let private constructMemberSinglePlace (tuple : TupledArg) : SynType =
|
||||||
match tuple.Args |> List.rev |> List.map buildType with
|
tuple.Args
|
||||||
| [] -> failwith "no-arg functions not supported yet"
|
|> List.map buildType
|
||||||
| [ x ] -> x
|
|> SynType.tupleNoParen
|
||||||
| last :: rest ->
|
|> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet")
|
||||||
([ SynTupleTypeSegment.Type last ], rest)
|
|> if tuple.HasParen then SynType.paren else id
|
||||||
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|
|
||||||
|> fun segs -> SynType.Tuple (false, segs, range0)
|
|
||||||
|> fun ty -> if tuple.HasParen then SynType.Paren (ty, range0) else ty
|
|
||||||
|
|
||||||
let constructMember (mem : MemberInfo) : SynField =
|
let constructMember (mem : MemberInfo) : SynField =
|
||||||
let inputType = mem.Args |> List.map constructMemberSinglePlace
|
let inputType = mem.Args |> List.map constructMemberSinglePlace
|
||||||
|
@@ -36,7 +36,6 @@ module internal RemoveOptionsGenerator =
|
|||||||
trivia
|
trivia
|
||||||
)
|
)
|
||||||
|
|
||||||
// TODO: this option seems a bit odd
|
|
||||||
let createType
|
let createType
|
||||||
(xmlDoc : PreXmlDoc option)
|
(xmlDoc : PreXmlDoc option)
|
||||||
(accessibility : SynAccess option)
|
(accessibility : SynAccess option)
|
||||||
@@ -54,7 +53,8 @@ module internal RemoveOptionsGenerator =
|
|||||||
Members = None
|
Members = None
|
||||||
XmlDoc = xmlDoc
|
XmlDoc = xmlDoc
|
||||||
Generics = generics
|
Generics = generics
|
||||||
Accessibility = accessibility
|
TypeAccessibility = accessibility
|
||||||
|
ImplAccessibility = None
|
||||||
Attributes = []
|
Attributes = []
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -62,7 +62,7 @@ module internal RemoveOptionsGenerator =
|
|||||||
|
|
||||||
SynModuleDecl.Types ([ typeDecl ], range0)
|
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 xmlDoc = PreXmlDoc.create "Remove the optional members of the input."
|
||||||
|
|
||||||
let inputArg = Ident.create "input"
|
let inputArg = Ident.create "input"
|
||||||
@@ -87,7 +87,7 @@ module internal RemoveOptionsGenerator =
|
|||||||
SynExpr.applyFunction
|
SynExpr.applyFunction
|
||||||
(SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
|
(SynExpr.createLongIdent [ "Option" ; "defaultWith" ])
|
||||||
(SynExpr.createLongIdent' (
|
(SynExpr.createLongIdent' (
|
||||||
withoutOptionsType
|
[ withoutOptionsType ]
|
||||||
@ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
|
@ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ]
|
||||||
))
|
))
|
||||||
)
|
)
|
||||||
@@ -101,47 +101,35 @@ module internal RemoveOptionsGenerator =
|
|||||||
[ functionName ]
|
[ functionName ]
|
||||||
[
|
[
|
||||||
SynPat.named inputArg.idText
|
SynPat.named inputArg.idText
|
||||||
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType))
|
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.createI withoutOptionsType))
|
||||||
]
|
]
|
||||||
body
|
body
|
||||||
|> SynBinding.withXmlDoc xmlDoc
|
|> SynBinding.withXmlDoc xmlDoc
|
||||||
|> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
|
|> SynBinding.withReturnAnnotation (SynType.LongIdent (SynLongIdent.create withOptionsType))
|
||||||
|> SynModuleDecl.createLet
|
|> SynModuleDecl.createLet
|
||||||
|
|
||||||
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
|
let createRecordModule (namespaceId : LongIdent) (typeDefn : RecordType) =
|
||||||
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
|
let fieldData = typeDefn.Fields |> List.map SynField.extractWithIdent
|
||||||
typeDefn
|
|
||||||
|
|
||||||
let (SynComponentInfo (_attributes, typeParams, _constraints, recordId, doc, _preferPostfix, _access, _)) =
|
let decls =
|
||||||
synComponentInfo
|
[
|
||||||
|
createType typeDefn.XmlDoc typeDefn.TypeAccessibility typeDefn.Generics typeDefn.Fields
|
||||||
|
createMaker [ Ident.create "Short" ] typeDefn.Name fieldData
|
||||||
|
]
|
||||||
|
|
||||||
match synTypeDefnRepr with
|
let xmlDoc =
|
||||||
| SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (accessibility, fields, _range), _) ->
|
sprintf "Module containing an option-truncated version of the %s type" typeDefn.Name.idText
|
||||||
let fieldData = fields |> List.map SynField.extractWithIdent
|
|> PreXmlDoc.create
|
||||||
|
|
||||||
let decls =
|
let info =
|
||||||
[
|
SynComponentInfo.create typeDefn.Name
|
||||||
createType (Some doc) accessibility typeParams fields
|
|> SynComponentInfo.withDocString xmlDoc
|
||||||
createMaker [ Ident.create "Short" ] recordId fieldData
|
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|
||||||
]
|
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
|
||||||
|
|
||||||
let xmlDoc =
|
SynModuleDecl.nestedModule info decls
|
||||||
recordId
|
|> List.singleton
|
||||||
|> Seq.map (fun i -> i.idText)
|
|> SynModuleOrNamespace.createNamespace namespaceId
|
||||||
|> 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"
|
|
||||||
|
|
||||||
open Myriad.Core
|
open Myriad.Core
|
||||||
|
|
||||||
@@ -164,7 +152,24 @@ type RemoveOptionsGenerator () =
|
|||||||
|> List.choose (fun (ns, types) ->
|
|> List.choose (fun (ns, types) ->
|
||||||
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
|
match types |> List.filter Ast.hasAttribute<RemoveOptionsAttribute> with
|
||||||
| [] -> None
|
| [] -> 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 =
|
let modules =
|
||||||
|
@@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins
|
|||||||
|
|
||||||
open System
|
open System
|
||||||
open System.Text
|
open System.Text
|
||||||
|
open System.Text.RegularExpressions
|
||||||
open Fantomas.FCS.Syntax
|
open Fantomas.FCS.Syntax
|
||||||
open Fantomas.FCS.Text.Range
|
open Fantomas.FCS.Text.Range
|
||||||
|
|
||||||
@@ -9,6 +10,53 @@ open Fantomas.FCS.Text.Range
|
|||||||
module internal Ident =
|
module internal Ident =
|
||||||
let inline create (s : string) = Ident (s, range0)
|
let inline create (s : string) = Ident (s, range0)
|
||||||
|
|
||||||
|
/// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical
|
||||||
|
/// apart from the ranges?
|
||||||
|
/// Awful hack: here is a function that does this sort of thing.
|
||||||
|
let createSanitisedParamName (s : string) =
|
||||||
|
match s with
|
||||||
|
| "type" -> create "type'"
|
||||||
|
| _ ->
|
||||||
|
|
||||||
|
let result = StringBuilder ()
|
||||||
|
|
||||||
|
for i = 0 to s.Length - 1 do
|
||||||
|
if Char.IsLetter s.[i] then
|
||||||
|
result.Append s.[i] |> ignore<StringBuilder>
|
||||||
|
elif Char.IsNumber s.[i] then
|
||||||
|
if result.Length > 0 then
|
||||||
|
result.Append s.[i] |> ignore<StringBuilder>
|
||||||
|
elif s.[i] = '_' || s.[i] = '-' then
|
||||||
|
result.Append '_' |> ignore<StringBuilder>
|
||||||
|
else
|
||||||
|
failwith $"could not convert to ident: %s{s}"
|
||||||
|
|
||||||
|
create (result.ToString ())
|
||||||
|
|
||||||
|
let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$"
|
||||||
|
|
||||||
|
let createSanitisedTypeName (s : string) =
|
||||||
|
let result = StringBuilder ()
|
||||||
|
let mutable capitalize = true
|
||||||
|
|
||||||
|
for i = 0 to s.Length - 1 do
|
||||||
|
if Char.IsLetter s.[i] then
|
||||||
|
if capitalize then
|
||||||
|
result.Append (Char.ToUpperInvariant s.[i]) |> ignore<StringBuilder>
|
||||||
|
capitalize <- false
|
||||||
|
else
|
||||||
|
result.Append s.[i] |> ignore<StringBuilder>
|
||||||
|
elif Char.IsNumber s.[i] then
|
||||||
|
if result.Length > 0 then
|
||||||
|
result.Append s.[i] |> ignore<StringBuilder>
|
||||||
|
elif s.[i] = '_' then
|
||||||
|
capitalize <- true
|
||||||
|
|
||||||
|
if result.Length = 0 then
|
||||||
|
failwith $"String %s{s} was not suitable as a type identifier"
|
||||||
|
|
||||||
|
Ident (result.ToString (), range0)
|
||||||
|
|
||||||
let lowerFirstLetter (x : Ident) : Ident =
|
let lowerFirstLetter (x : Ident) : Ident =
|
||||||
let result = StringBuilder x.idText.Length
|
let result = StringBuilder x.idText.Length
|
||||||
result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
|
result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore
|
||||||
|
@@ -6,7 +6,12 @@ open Fantomas.FCS.Text.Range
|
|||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal PreXmlDoc =
|
module internal PreXmlDoc =
|
||||||
let create (s : string) : PreXmlDoc =
|
let create (s : string) : PreXmlDoc =
|
||||||
PreXmlDoc.Create ([| " " + s |], range0)
|
let s = s.Split "\n"
|
||||||
|
|
||||||
|
for i = 0 to s.Length - 1 do
|
||||||
|
s.[i] <- " " + s.[i]
|
||||||
|
|
||||||
|
PreXmlDoc.Create (s, range0)
|
||||||
|
|
||||||
let create' (s : string seq) : PreXmlDoc =
|
let create' (s : string seq) : PreXmlDoc =
|
||||||
PreXmlDoc.Create (Array.ofSeq s, range0)
|
PreXmlDoc.Create (Array.ofSeq s, range0)
|
||||||
|
@@ -9,12 +9,12 @@ module internal SynArgPats =
|
|||||||
match caseNames.Length with
|
match caseNames.Length with
|
||||||
| 0 -> SynArgPats.Pats []
|
| 0 -> SynArgPats.Pats []
|
||||||
| 1 ->
|
| 1 ->
|
||||||
SynPat.Named (SynIdent.SynIdent (Ident.create caseNames.[0], None), false, None, range0)
|
SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0)
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
|> SynArgPats.Pats
|
|> SynArgPats.Pats
|
||||||
| len ->
|
| len ->
|
||||||
caseNames
|
caseNames
|
||||||
|> List.map (fun name -> SynPat.Named (SynIdent.SynIdent (Ident.create name, None), false, None, range0))
|
|> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0))
|
||||||
|> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0)
|
|> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0)
|
||||||
|> fun t -> SynPat.Paren (t, range0)
|
|> fun t -> SynPat.Paren (t, range0)
|
||||||
|> List.singleton
|
|> List.singleton
|
||||||
|
@@ -5,32 +5,23 @@ open Fantomas.FCS.Text.Range
|
|||||||
|
|
||||||
[<RequireQualifiedAccess>]
|
[<RequireQualifiedAccess>]
|
||||||
module internal SynAttribute =
|
module internal SynAttribute =
|
||||||
let internal compilationRepresentation : SynAttribute =
|
let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute =
|
||||||
{
|
{
|
||||||
TypeName = SynLongIdent.createS "CompilationRepresentation"
|
TypeName = typeName
|
||||||
ArgExpr =
|
ArgExpr = arg
|
||||||
[ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
|
|
||||||
|> SynExpr.createLongIdent
|
|
||||||
|> SynExpr.paren
|
|
||||||
Target = None
|
Target = None
|
||||||
AppliesToGetterAndSetter = false
|
AppliesToGetterAndSetter = false
|
||||||
Range = range0
|
Range = range0
|
||||||
}
|
}
|
||||||
|
|
||||||
|
let internal compilationRepresentation : SynAttribute =
|
||||||
|
[ "CompilationRepresentationFlags" ; "ModuleSuffix" ]
|
||||||
|
|> SynExpr.createLongIdent
|
||||||
|
|> SynExpr.paren
|
||||||
|
|> create (SynLongIdent.createS "CompilationRepresentation")
|
||||||
|
|
||||||
let internal requireQualifiedAccess : SynAttribute =
|
let internal requireQualifiedAccess : SynAttribute =
|
||||||
{
|
create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ())
|
||||||
TypeName = SynLongIdent.createS "RequireQualifiedAccess"
|
|
||||||
ArgExpr = SynExpr.CreateConst ()
|
|
||||||
Target = None
|
|
||||||
AppliesToGetterAndSetter = false
|
|
||||||
Range = range0
|
|
||||||
}
|
|
||||||
|
|
||||||
let internal autoOpen : SynAttribute =
|
let internal autoOpen : SynAttribute =
|
||||||
{
|
create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ())
|
||||||
TypeName = SynLongIdent.createS "AutoOpen"
|
|
||||||
ArgExpr = SynExpr.CreateConst ()
|
|
||||||
Target = None
|
|
||||||
AppliesToGetterAndSetter = false
|
|
||||||
Range = range0
|
|
||||||
}
|
|
||||||
|
@@ -80,6 +80,11 @@ module internal SynExpr =
|
|||||||
let equals (a : SynExpr) (b : SynExpr) =
|
let equals (a : SynExpr) (b : SynExpr) =
|
||||||
SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b
|
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}
|
/// {a} + {b}
|
||||||
let plus (a : SynExpr) (b : SynExpr) =
|
let plus (a : SynExpr) (b : SynExpr) =
|
||||||
SynExpr.CreateAppInfix (
|
SynExpr.CreateAppInfix (
|
||||||
|
10
WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs
Normal file
10
WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs
Normal file
@@ -0,0 +1,10 @@
|
|||||||
|
namespace WoofWare.Myriad.Plugins
|
||||||
|
|
||||||
|
open Fantomas.FCS.Syntax
|
||||||
|
|
||||||
|
[<RequireQualifiedAccess>]
|
||||||
|
module internal SynIdent =
|
||||||
|
let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None)
|
||||||
|
|
||||||
|
let inline createS (i : string) : SynIdent =
|
||||||
|
SynIdent.SynIdent (Ident.create i, None)
|
@@ -33,6 +33,9 @@ module internal SynLongIdent =
|
|||||||
let eq =
|
let eq =
|
||||||
SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
|
SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ])
|
||||||
|
|
||||||
|
let booleanAnd =
|
||||||
|
SynLongIdent.SynLongIdent ([ Ident.create "op_BooleanAnd" ], [], [ Some (IdentTrivia.OriginalNotation "&&") ])
|
||||||
|
|
||||||
let pipe =
|
let pipe =
|
||||||
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
|
SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ])
|
||||||
|
|
||||||
|
@@ -17,8 +17,8 @@ module internal SynMemberDefn =
|
|||||||
SynMemberFlags.MemberKind = SynMemberKind.Member
|
SynMemberFlags.MemberKind = SynMemberKind.Member
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
let abstractMember
|
let abstractMember
|
||||||
|
(attrs : SynAttribute list)
|
||||||
(ident : SynIdent)
|
(ident : SynIdent)
|
||||||
(typars : SynTyparDecls option)
|
(typars : SynTyparDecls option)
|
||||||
(arity : SynValInfo)
|
(arity : SynValInfo)
|
||||||
@@ -28,7 +28,13 @@ module internal SynMemberDefn =
|
|||||||
=
|
=
|
||||||
let slot =
|
let slot =
|
||||||
SynValSig.SynValSig (
|
SynValSig.SynValSig (
|
||||||
[],
|
attrs
|
||||||
|
|> List.map (fun attr ->
|
||||||
|
{
|
||||||
|
Attributes = [ attr ]
|
||||||
|
Range = range0
|
||||||
|
}
|
||||||
|
),
|
||||||
ident,
|
ident,
|
||||||
SynValTyparDecls.SynValTyparDecls (typars, true),
|
SynValTyparDecls.SynValTyparDecls (typars, true),
|
||||||
returnType,
|
returnType,
|
||||||
|
@@ -267,6 +267,8 @@ module internal SynType =
|
|||||||
| SynType.Paren (ty, _) -> stripOptionalParen ty
|
| SynType.Paren (ty, _) -> stripOptionalParen ty
|
||||||
| ty -> ty
|
| ty -> ty
|
||||||
|
|
||||||
|
let inline paren (ty : SynType) : SynType = SynType.Paren (ty, range0)
|
||||||
|
|
||||||
let inline createLongIdent (ident : LongIdent) : SynType =
|
let inline createLongIdent (ident : LongIdent) : SynType =
|
||||||
SynType.LongIdent (SynLongIdent.create ident)
|
SynType.LongIdent (SynLongIdent.create ident)
|
||||||
|
|
||||||
@@ -283,6 +285,17 @@ module internal SynType =
|
|||||||
|
|
||||||
let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
|
let inline app (name : string) (args : SynType list) : SynType = app' (named name) args
|
||||||
|
|
||||||
|
/// Returns None if the input list was empty.
|
||||||
|
let inline tupleNoParen (ty : SynType list) : SynType option =
|
||||||
|
match List.rev ty with
|
||||||
|
| [] -> None
|
||||||
|
| [ t ] -> Some t
|
||||||
|
| t :: rest ->
|
||||||
|
([ SynTupleTypeSegment.Type t ], rest)
|
||||||
|
||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty)
|
||||||
|
|> fun segs -> SynType.Tuple (false, segs, range0)
|
||||||
|
|> Some
|
||||||
|
|
||||||
let inline appPostfix (name : string) (arg : SynType) : SynType =
|
let inline appPostfix (name : string) (arg : SynType) : SynType =
|
||||||
SynType.App (named name, None, [ arg ], [], None, true, range0)
|
SynType.App (named name, None, [ arg ], [], None, true, range0)
|
||||||
|
|
||||||
@@ -299,16 +312,54 @@ module internal SynType =
|
|||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|
||||||
let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType =
|
let inline signatureParamOfType
|
||||||
SynType.SignatureParameter ([], false, name, ty, range0)
|
(attrs : SynAttribute list)
|
||||||
|
(ty : SynType)
|
||||||
|
(optional : bool)
|
||||||
|
(name : Ident option)
|
||||||
|
: SynType
|
||||||
|
=
|
||||||
|
SynType.SignatureParameter (
|
||||||
|
attrs
|
||||||
|
|> List.map (fun attr ->
|
||||||
|
{
|
||||||
|
Attributes = [ attr ]
|
||||||
|
Range = range0
|
||||||
|
}
|
||||||
|
),
|
||||||
|
optional,
|
||||||
|
name,
|
||||||
|
ty,
|
||||||
|
range0
|
||||||
|
)
|
||||||
|
|
||||||
let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
|
let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0)
|
||||||
|
|
||||||
let unit : SynType = named "unit"
|
let unit : SynType = named "unit"
|
||||||
|
let obj : SynType = named "obj"
|
||||||
|
let bool : SynType = named "bool"
|
||||||
let int : SynType = named "int"
|
let int : SynType = named "int"
|
||||||
|
let array (elt : SynType) : SynType = SynType.Array (1, elt, range0)
|
||||||
|
|
||||||
|
let list (elt : SynType) : SynType =
|
||||||
|
SynType.App (named "list", None, [ elt ], [], None, true, range0)
|
||||||
|
|
||||||
|
let option (elt : SynType) : SynType =
|
||||||
|
SynType.App (named "option", None, [ elt ], [], None, true, range0)
|
||||||
|
|
||||||
let anon : SynType = SynType.Anon range0
|
let anon : SynType = SynType.Anon range0
|
||||||
|
|
||||||
|
let task (elt : SynType) : SynType =
|
||||||
|
SynType.App (
|
||||||
|
createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "Task" ],
|
||||||
|
None,
|
||||||
|
[ elt ],
|
||||||
|
[],
|
||||||
|
None,
|
||||||
|
true,
|
||||||
|
range0
|
||||||
|
)
|
||||||
|
|
||||||
let string : SynType = named "string"
|
let string : SynType = named "string"
|
||||||
|
|
||||||
/// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.
|
/// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.
|
||||||
|
@@ -13,8 +13,12 @@ module internal SynTypeDefnRepr =
|
|||||||
let inline augmentation () : SynTypeDefnRepr =
|
let inline augmentation () : SynTypeDefnRepr =
|
||||||
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
|
SynTypeDefnRepr.ObjectModel (SynTypeDefnKind.Augmentation range0, [], range0)
|
||||||
|
|
||||||
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr =
|
let inline unionWithAccess (implAccess : SynAccess option) (cases : SynUnionCase list) : SynTypeDefnRepr =
|
||||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (None, cases, range0), range0)
|
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (implAccess, cases, range0), range0)
|
||||||
|
|
||||||
let inline record (fields : SynField list) : SynTypeDefnRepr =
|
let inline union (cases : SynUnionCase list) : SynTypeDefnRepr = unionWithAccess None cases
|
||||||
SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (None, fields, range0), range0)
|
|
||||||
|
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
|
||||||
|
@@ -44,7 +44,7 @@ module internal SynUnionCase =
|
|||||||
|
|
||||||
SynUnionCase.SynUnionCase (
|
SynUnionCase.SynUnionCase (
|
||||||
SynAttributes.ofAttrs case.Attributes,
|
SynAttributes.ofAttrs case.Attributes,
|
||||||
SynIdent.SynIdent (case.Name, None),
|
SynIdent.createI case.Name,
|
||||||
SynUnionCaseKind.Fields fields,
|
SynUnionCaseKind.Fields fields,
|
||||||
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
|
case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty,
|
||||||
case.Access,
|
case.Access,
|
||||||
|
@@ -30,6 +30,7 @@
|
|||||||
<Compile Include="SynExpr\SynAttributes.fs" />
|
<Compile Include="SynExpr\SynAttributes.fs" />
|
||||||
<Compile Include="SynExpr\PreXmlDoc.fs" />
|
<Compile Include="SynExpr\PreXmlDoc.fs" />
|
||||||
<Compile Include="SynExpr\Ident.fs" />
|
<Compile Include="SynExpr\Ident.fs" />
|
||||||
|
<Compile Include="SynExpr\SynIdent.fs" />
|
||||||
<Compile Include="SynExpr\SynLongIdent.fs" />
|
<Compile Include="SynExpr\SynLongIdent.fs" />
|
||||||
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
|
<Compile Include="SynExpr\SynExprLetOrUseTrivia.fs" />
|
||||||
<Compile Include="SynExpr\SynArgPats.fs" />
|
<Compile Include="SynExpr\SynArgPats.fs" />
|
||||||
|
6
flake.lock
generated
6
flake.lock
generated
@@ -20,11 +20,11 @@
|
|||||||
},
|
},
|
||||||
"nixpkgs": {
|
"nixpkgs": {
|
||||||
"locked": {
|
"locked": {
|
||||||
"lastModified": 1725099143,
|
"lastModified": 1725534445,
|
||||||
"narHash": "sha256-CHgumPZaC7z+WYx72WgaLt2XF0yUVzJS60rO4GZ7ytY=",
|
"narHash": "sha256-Yd0FK9SkWy+ZPuNqUgmVPXokxDgMJoGuNpMEtkfcf84=",
|
||||||
"owner": "NixOS",
|
"owner": "NixOS",
|
||||||
"repo": "nixpkgs",
|
"repo": "nixpkgs",
|
||||||
"rev": "5629520edecb69630a3f4d17d3d33fc96c13f6fe",
|
"rev": "9bb1e7571aadf31ddb4af77fc64b2d59580f9a39",
|
||||||
"type": "github"
|
"type": "github"
|
||||||
},
|
},
|
||||||
"original": {
|
"original": {
|
||||||
|
20
nix/deps.nix
20
nix/deps.nix
@@ -8,8 +8,8 @@
|
|||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "fantomas";
|
pname = "fantomas";
|
||||||
version = "6.3.11";
|
version = "6.3.12";
|
||||||
hash = "sha256-11bHGEAZTNtdp2pTg5zqLrQiyI/j/AT7GGL/2CR4+dw=";
|
hash = "sha256-LFZn2cO72FlsmLI0vTLz52Bn4XBeGILTOr8rz/EuXeg=";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Fantomas.Core";
|
pname = "Fantomas.Core";
|
||||||
@@ -78,13 +78,13 @@
|
|||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Microsoft.CodeCoverage";
|
pname = "Microsoft.CodeCoverage";
|
||||||
version = "17.11.0";
|
version = "17.11.1";
|
||||||
hash = "sha256-XglInnx5GePUYHG7n2NLX+WfK7kJnornsWOW/5FnOXE=";
|
hash = "sha256-1dLlK3NGh88PuFYZiYpT+izA96etxhU3BSgixDgdtGA=";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Microsoft.NET.Test.Sdk";
|
pname = "Microsoft.NET.Test.Sdk";
|
||||||
version = "17.11.0";
|
version = "17.11.1";
|
||||||
hash = "sha256-WjyA78+PG9ZloWTt9Hf1ek3VVj2FfJ9fAjqklnN+fWw=";
|
hash = "sha256-0JUEucQ2lzaPgkrjm/NFLBTbqU1dfhvhN3Tl3moE6mI=";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Microsoft.NETCore.App.Host.linux-arm64";
|
pname = "Microsoft.NETCore.App.Host.linux-arm64";
|
||||||
@@ -153,13 +153,13 @@
|
|||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Microsoft.TestPlatform.ObjectModel";
|
pname = "Microsoft.TestPlatform.ObjectModel";
|
||||||
version = "17.11.0";
|
version = "17.11.1";
|
||||||
hash = "sha256-mCI3MCV6nyrGLrBat5VvK5LrXTEKlsdp9NkpZyJYwVg=";
|
hash = "sha256-5vX+vCzFY3S7xfMVIv8OlMMFtdedW9UIJzc0WEc+vm4=";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Microsoft.TestPlatform.TestHost";
|
pname = "Microsoft.TestPlatform.TestHost";
|
||||||
version = "17.11.0";
|
version = "17.11.1";
|
||||||
hash = "sha256-gViDLobza22kuLvB4JdlGtbANqwBHRwf1wLmIHMw9Eo=";
|
hash = "sha256-wSkY0H1fQAq0H3LcKT4u7Y5RzhAAPa6yueVN84g8HxU=";
|
||||||
})
|
})
|
||||||
(fetchNuGet {
|
(fetchNuGet {
|
||||||
pname = "Myriad.Core";
|
pname = "Myriad.Core";
|
||||||
|
Reference in New Issue
Block a user