Compare commits

..

1 Commits

Author SHA1 Message Date
Patrick Stevens
adf497c5db Tidy up a bit more (#156) 2024-06-01 15:57:53 +01:00
20 changed files with 271 additions and 343 deletions

View File

@@ -60,7 +60,7 @@ module TreeCata =
instructions.RemoveAt (instructions.Count - 1) instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with match currentInstruction with
| Instruction.Process__TreeBuilder (x) -> | Instruction.Process__TreeBuilder x ->
match x with match x with
| TreeBuilder.Child (arg0_0) -> | TreeBuilder.Child (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Child instructions.Add Instruction.TreeBuilder_Child
@@ -68,7 +68,7 @@ module TreeCata =
| TreeBuilder.Parent (arg0_0) -> | TreeBuilder.Parent (arg0_0) ->
instructions.Add Instruction.TreeBuilder_Parent instructions.Add Instruction.TreeBuilder_Parent
instructions.Add (Instruction.Process__Tree arg0_0) instructions.Add (Instruction.Process__Tree arg0_0)
| Instruction.Process__Tree (x) -> | Instruction.Process__Tree x ->
match x with match x with
| Tree.Const (arg0_0, arg1_0) -> cata.Tree.Const arg0_0 arg1_0 |> treeStack.Add | Tree.Const (arg0_0, arg1_0) -> cata.Tree.Const arg0_0 arg1_0 |> treeStack.Add
| Tree.Pair (arg0_0, arg1_0, arg2_0) -> | Tree.Pair (arg0_0, arg1_0, arg2_0) ->
@@ -92,13 +92,13 @@ module TreeCata =
let arg0_0 = treeStack.[treeStack.Count - 1] let arg0_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1) treeStack.RemoveAt (treeStack.Count - 1)
cata.TreeBuilder.Parent arg0_0 |> treeBuilderStack.Add cata.TreeBuilder.Parent arg0_0 |> treeBuilderStack.Add
| Instruction.Tree_Pair (arg2_0) -> | Instruction.Tree_Pair arg2_0 ->
let arg0_0 = treeStack.[treeStack.Count - 1] let arg0_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1) treeStack.RemoveAt (treeStack.Count - 1)
let arg1_0 = treeStack.[treeStack.Count - 1] let arg1_0 = treeStack.[treeStack.Count - 1]
treeStack.RemoveAt (treeStack.Count - 1) treeStack.RemoveAt (treeStack.Count - 1)
cata.Tree.Pair arg0_0 arg1_0 arg2_0 |> treeStack.Add cata.Tree.Pair arg0_0 arg1_0 arg2_0 |> treeStack.Add
| Instruction.Tree_Sequential (arg0_0) -> | Instruction.Tree_Sequential arg0_0 ->
let arg0_0_len = arg0_0 let arg0_0_len = arg0_0
let arg0_0 = let arg0_0 =

View File

@@ -41,7 +41,7 @@ module FileSystemItemCata =
instructions.RemoveAt (instructions.Count - 1) instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with match currentInstruction with
| Instruction.Process__FileSystemItem (x) -> | Instruction.Process__FileSystemItem x ->
match x with match x with
| FileSystemItem.Directory ({ | FileSystemItem.Directory ({
Name = name Name = name
@@ -116,7 +116,7 @@ module GiftCata =
instructions.RemoveAt (instructions.Count - 1) instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with match currentInstruction with
| Instruction.Process__Gift (x) -> | Instruction.Process__Gift x ->
match x with match x with
| Gift.Book (arg0_0) -> cata.Gift.Book arg0_0 |> giftStack.Add | Gift.Book (arg0_0) -> cata.Gift.Book arg0_0 |> giftStack.Add
| Gift.Chocolate (arg0_0) -> cata.Gift.Chocolate arg0_0 |> giftStack.Add | Gift.Chocolate (arg0_0) -> cata.Gift.Chocolate arg0_0 |> giftStack.Add
@@ -129,7 +129,7 @@ module GiftCata =
| Gift.WithACard (arg0_0, message) -> | Gift.WithACard (arg0_0, message) ->
instructions.Add (Instruction.Gift_WithACard (message)) instructions.Add (Instruction.Gift_WithACard (message))
instructions.Add (Instruction.Process__Gift arg0_0) instructions.Add (Instruction.Process__Gift arg0_0)
| Instruction.Gift_Wrapped (arg1_0) -> | Instruction.Gift_Wrapped arg1_0 ->
let arg0_0 = giftStack.[giftStack.Count - 1] let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1) giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.Wrapped arg0_0 arg1_0 |> giftStack.Add cata.Gift.Wrapped arg0_0 arg1_0 |> giftStack.Add
@@ -137,7 +137,7 @@ module GiftCata =
let arg0_0 = giftStack.[giftStack.Count - 1] let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1) giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.Boxed arg0_0 |> giftStack.Add cata.Gift.Boxed arg0_0 |> giftStack.Add
| Instruction.Gift_WithACard (message) -> | Instruction.Gift_WithACard message ->
let arg0_0 = giftStack.[giftStack.Count - 1] let arg0_0 = giftStack.[giftStack.Count - 1]
giftStack.RemoveAt (giftStack.Count - 1) giftStack.RemoveAt (giftStack.Count - 1)
cata.Gift.WithACard arg0_0 message |> giftStack.Add cata.Gift.WithACard arg0_0 message |> giftStack.Add

View File

@@ -167,7 +167,7 @@ module FirstDuJsonSerializeExtension =
match input with match input with
| FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase") | FirstDu.EmptyCase -> node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "emptyCase")
| FirstDu.Case1 (arg0) -> | FirstDu.Case1 arg0 ->
node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1") node.Add ("type", System.Text.Json.Nodes.JsonValue.Create "case1")
let dataNode = System.Text.Json.Nodes.JsonObject () let dataNode = System.Text.Json.Nodes.JsonObject ()
dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0) dataNode.Add ("data", System.Text.Json.Nodes.JsonValue.Create<string> arg0)

View File

@@ -41,7 +41,7 @@ module MyListCata =
instructions.RemoveAt (instructions.Count - 1) instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with match currentInstruction with
| Instruction.Process__MyList (x) -> | Instruction.Process__MyList x ->
match x with match x with
| MyList.Nil -> cata.MyList.Nil |> myListStack.Add | MyList.Nil -> cata.MyList.Nil |> myListStack.Add
| MyList.Cons ({ | MyList.Cons ({
@@ -50,7 +50,7 @@ module MyListCata =
}) -> }) ->
instructions.Add (Instruction.MyList_Cons (head)) instructions.Add (Instruction.MyList_Cons (head))
instructions.Add (Instruction.Process__MyList tail) instructions.Add (Instruction.Process__MyList tail)
| Instruction.MyList_Cons (head) -> | Instruction.MyList_Cons head ->
let tail = myListStack.[myListStack.Count - 1] let tail = myListStack.[myListStack.Count - 1]
myListStack.RemoveAt (myListStack.Count - 1) myListStack.RemoveAt (myListStack.Count - 1)
cata.MyList.Cons head tail |> myListStack.Add cata.MyList.Cons head tail |> myListStack.Add
@@ -97,13 +97,13 @@ module MyList2Cata =
instructions.RemoveAt (instructions.Count - 1) instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with match currentInstruction with
| Instruction.Process__MyList2 (x) -> | Instruction.Process__MyList2 x ->
match x with match x with
| MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add | MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
| MyList2.Cons (arg0_0, arg1_0) -> | MyList2.Cons (arg0_0, arg1_0) ->
instructions.Add (Instruction.MyList2_Cons (arg0_0)) instructions.Add (Instruction.MyList2_Cons (arg0_0))
instructions.Add (Instruction.Process__MyList2 arg1_0) instructions.Add (Instruction.Process__MyList2 arg1_0)
| Instruction.MyList2_Cons (arg0_0) -> | Instruction.MyList2_Cons arg0_0 ->
let arg1_0 = myList2Stack.[myList2Stack.Count - 1] let arg1_0 = myList2Stack.[myList2Stack.Count - 1]
myList2Stack.RemoveAt (myList2Stack.Count - 1) myList2Stack.RemoveAt (myList2Stack.Count - 1)
cata.MyList2.Cons arg0_0 arg1_0 |> myList2Stack.Add cata.MyList2.Cons arg0_0 arg1_0 |> myList2Stack.Add

View File

@@ -188,10 +188,6 @@ module internal AstHelper =
} }
| _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType | _ -> failwithf "Didn't have alternating type-and-star in interface member definition: %+A" tupleType
let toFun (inputs : SynType list) (ret : SynType) : SynType =
(ret, List.rev inputs)
||> List.fold (fun ty input -> SynType.funFromDomain input ty)
/// Returns the args (where these are tuple types if curried) in order, and the return type. /// Returns the args (where these are tuple types if curried) in order, and the return type.
let rec getType (ty : SynType) : (SynType * bool) list * SynType = let rec getType (ty : SynType) : (SynType * bool) list * SynType =
match ty with match ty with
@@ -204,7 +200,7 @@ module internal AstHelper =
| SynType.Paren (argType, _) -> getType argType, true | SynType.Paren (argType, _) -> getType argType, true
| _ -> getType argType, false | _ -> getType argType, false
((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret ((SynType.toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret
| _ -> [], ty | _ -> [], ty
let private parseMember (slotSig : SynValSig) (flags : SynMemberFlags) : Choice<MemberInfo, PropertyInfo> = let private parseMember (slotSig : SynValSig) (flags : SynMemberFlags) : Choice<MemberInfo, PropertyInfo> =

View File

@@ -460,7 +460,12 @@ module internal CataGenerator =
unionCase.Fields unionCase.Fields
|> List.map (fun field -> |> List.map (fun field ->
// TODO: adjust type parameters // TODO: adjust type parameters
SynField.Create field.Type {
SynFieldData.Type = field.Type
Attrs = []
Ident = None
}
|> SynField.make
) )
SynUnionCase.Create (unionCase.Name, fields) SynUnionCase.Create (unionCase.Name, fields)
@@ -1148,24 +1153,19 @@ module internal CataGenerator =
let cataRecord = let cataRecord =
SynModuleDecl.Types ([ createCataRecord cataName recordDoc analysis ], range0) SynModuleDecl.Types ([ createCataRecord cataName recordDoc analysis ], range0)
SynModuleOrNamespace.CreateNamespace (
ns,
decls =
[ [
for openStatement in opens do for openStatement in opens do
yield SynModuleDecl.CreateOpen openStatement yield SynModuleDecl.CreateOpen openStatement
yield! cataStructures yield! cataStructures
yield cataRecord yield cataRecord
yield yield
SynModuleDecl.CreateNestedModule (
modInfo,
[ [
SynModuleDecl.Types ([ createInstructionType analysis ], range0) SynModuleDecl.Types ([ createInstructionType analysis ], range0)
SynModuleDecl.CreateLet (loopFunction :: runFunctions) SynModuleDecl.createLets (loopFunction :: runFunctions)
] ]
) |> SynModuleDecl.nestedModule modInfo
] ]
) |> SynModuleOrNamespace.createNamespace ns
let generate (context : GeneratorContext) : Output = let generate (context : GeneratorContext) : Output =
let ast, _ = let ast, _ =

View File

@@ -2,9 +2,6 @@ namespace WoofWare.Myriad.Plugins
open System.Net.Http open System.Net.Http
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Myriad.Core
type internal HttpClientGeneratorOutputSpec = type internal HttpClientGeneratorOutputSpec =
{ {
@@ -14,7 +11,6 @@ type internal HttpClientGeneratorOutputSpec =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal HttpClientGenerator = module internal HttpClientGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
type PathSpec = type PathSpec =
@@ -174,35 +170,6 @@ module internal HttpClientGenerator =
(info : MemberInfo) (info : MemberInfo)
: SynMemberDefn : SynMemberDefn
= =
let valInfo =
SynValInfo.SynValInfo (
[
[ SynArgInfo.Empty ]
[
for arg in info.Args do
match arg.Id with
| None -> yield SynArgInfo.CreateIdString (failwith "TODO: create an arg name")
| Some id -> yield SynArgInfo.CreateId id
]
],
SynArgInfo.Empty
)
let valData =
SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
valInfo,
None
)
let args = let args =
info.Args info.Args
|> List.map (fun arg -> |> List.map (fun arg ->
@@ -217,7 +184,9 @@ module internal HttpClientGenerator =
else else
arg.Type arg.Type
argName, SynPat.CreateTyped (SynPat.CreateNamed argName, argType) // We'll be tupling these up anyway, so don't need the parens
// around the type annotations.
argName, SynPat.annotateTypeNoParen argType (SynPat.namedI argName)
) )
let cancellationTokenArg = let cancellationTokenArg =
@@ -225,16 +194,6 @@ module internal HttpClientGenerator =
| None -> failwith $"expected an optional cancellation token as final arg in %s{info.Identifier.idText}" | None -> failwith $"expected an optional cancellation token as final arg in %s{info.Identifier.idText}"
| Some (arg, _) -> arg | Some (arg, _) -> arg
let headPat =
let thisIdent = if variableHeaders.IsEmpty then "_" else "this"
args
|> List.map snd
|> SynPat.tuple
|> List.singleton
|> SynArgPats.Pats
|> SynPat.identWithArgs [ Ident.create thisIdent ; info.Identifier ]
let requestUriTrailer = let requestUriTrailer =
(info.UrlTemplate, info.Args) (info.UrlTemplate, info.Args)
||> List.fold (fun template arg -> ||> List.fold (fun template arg ->
@@ -436,7 +395,7 @@ module internal HttpClientGenerator =
// new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T) // new RestEase.Response (content : string, response : HttpResponseMessage, deserialiser : unit -> 'T)
SynExpr.createNew SynExpr.createNew
(SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ]) (SynType.app' (SynType.createLongIdent' [ "RestEase" ; "Response" ]) [ SynType.Anon range0 ])
(SynExpr.CreateTuple (SynExpr.tupleNoParen
[ [
SynExpr.createIdent "responseString" SynExpr.createIdent "responseString"
SynExpr.createIdent "response" SynExpr.createIdent "response"
@@ -621,23 +580,15 @@ module internal HttpClientGenerator =
|> SynExpr.createCompExpr "async" returnExpr |> SynExpr.createCompExpr "async" returnExpr
|> SynExpr.startAsTask cancellationTokenArg |> SynExpr.startAsTask cancellationTokenArg
SynBinding.SynBinding ( let thisIdent =
None, if variableHeaders.IsEmpty then "_" else "this"
SynBindingKind.Normal, |> Ident.create
false,
false, let args = args |> List.map snd |> SynPat.tuple |> List.singleton
[],
PreXmlDoc.Empty, SynBinding.basic [ thisIdent ; info.Identifier ] args implementation
valData,
headPat,
None,
implementation,
range0,
DebugPointAtBinding.Yes range0,
SynBinding.triviaZero true
)
|> SynBinding.withAccessibility info.Accessibility |> SynBinding.withAccessibility info.Accessibility
|> fun b -> SynMemberDefn.Member (b, range0) |> SynMemberDefn.memberImplementation
let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list = let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list =
attrs attrs
@@ -811,42 +762,13 @@ module internal HttpClientGenerator =
let propertyMembers = let propertyMembers =
properties properties
|> List.map (fun (_, pi) -> |> List.map (fun (_, pi) ->
SynMemberDefn.Member ( SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ]
SynBinding.SynBinding ( |> SynExpr.applyTo (SynExpr.CreateConst ())
pi.Accessibility, |> SynBinding.basic [ Ident.create "_" ; pi.Identifier ] []
SynBindingKind.Normal, |> SynBinding.withReturnAnnotation pi.Type
pi.IsInline, |> SynBinding.setInline pi.IsInline
false, |> SynBinding.withAccessibility pi.Accessibility
[], |> SynMemberDefn.memberImplementation
PreXmlDoc.Empty,
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
SynValInfo.SynValInfo ([ [ SynArgInfo.Empty ] ; [] ], SynArgInfo.Empty),
None
),
SynPat.CreateLongIdent (SynLongIdent.create [ Ident.create "_" ; pi.Identifier ], []),
Some (SynBindingReturnInfo.Create pi.Type),
SynExpr.applyFunction
(SynExpr.createLongIdent' [ Ident.lowerFirstLetter pi.Identifier ])
(SynExpr.CreateConst ()),
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = if pi.IsInline then Some range0 else None
EqualsRange = Some range0
}
),
range0
)
) )
let members = propertyMembers @ nonPropertyMembers let members = propertyMembers @ nonPropertyMembers
@@ -891,27 +813,6 @@ module internal HttpClientGenerator =
let functionName = Ident.create "client" let functionName = Ident.create "client"
let valData =
let memberFlags =
if spec.ExtensionMethods then
{
SynMemberFlags.IsInstance = false
SynMemberFlags.IsDispatchSlot = false
SynMemberFlags.IsOverrideOrExplicitImpl = false
SynMemberFlags.IsFinal = false
SynMemberFlags.GetterOrSetterIsCompilerGenerated = false
SynMemberFlags.MemberKind = SynMemberKind.Member
}
|> Some
else
None
SynValData.SynValData (
memberFlags,
SynValInfo.SynValInfo ([ [ SynArgInfo.SynArgInfo ([], false, Some functionName) ] ], SynArgInfo.Empty),
None
)
let pattern = SynLongIdent.createS "make" let pattern = SynLongIdent.createS "make"
let returnInfo = SynType.createLongIdent interfaceType.Name let returnInfo = SynType.createLongIdent interfaceType.Name
@@ -948,8 +849,7 @@ module internal HttpClientGenerator =
SynBinding.basic [ Ident.create "make" ] (headerArgs @ [ clientCreationArg ]) interfaceImpl SynBinding.basic [ Ident.create "make" ] (headerArgs @ [ clientCreationArg ]) interfaceImpl
|> SynBinding.withXmlDoc xmlDoc |> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo |> SynBinding.withReturnAnnotation returnInfo
|> List.singleton |> SynModuleDecl.createLet
|> SynModuleDecl.CreateLet
let moduleName = let moduleName =
if spec.ExtensionMethods then if spec.ExtensionMethods then
@@ -969,15 +869,14 @@ module internal HttpClientGenerator =
|> SynComponentInfo.addAttributes attribs |> SynComponentInfo.addAttributes attribs
|> SynComponentInfo.setAccessibility interfaceType.Accessibility |> SynComponentInfo.setAccessibility interfaceType.Accessibility
SynModuleOrNamespace.CreateNamespace (
ns,
decls =
[ [
for openStatement in opens do for openStatement in opens do
yield SynModuleDecl.CreateOpen openStatement yield SynModuleDecl.openAny openStatement
yield SynModuleDecl.CreateNestedModule (modInfo, [ createFunc ]) yield SynModuleDecl.nestedModule modInfo [ createFunc ]
] ]
) |> SynModuleOrNamespace.createNamespace ns
open Myriad.Core
/// Myriad generator that provides an HTTP client for an interface type using RestEase annotations. /// Myriad generator that provides an HTTP client for an interface type using RestEase annotations.
[<MyriadGenerator("http-client")>] [<MyriadGenerator("http-client")>]

View File

@@ -2,9 +2,7 @@ namespace WoofWare.Myriad.Plugins
open System open System
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml open Fantomas.FCS.Xml
open Myriad.Core
type internal GenerateMockOutputSpec = type internal GenerateMockOutputSpec =
{ {
@@ -14,7 +12,6 @@ type internal GenerateMockOutputSpec =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal InterfaceMockGenerator = module internal InterfaceMockGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
let private getName (SynField (_, _, id, _, _, _, _, _, _)) = let private getName (SynField (_, _, id, _, _, _, _, _, _)) =
match id with match id with
@@ -87,21 +84,21 @@ module internal InterfaceMockGenerator =
else else
[ SynPat.unit ]) [ SynPat.unit ])
(AstHelper.instantiateRecord constructorFields) (AstHelper.instantiateRecord constructorFields)
|> SynBinding.makeStaticMember
|> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.") |> SynBinding.withXmlDoc (PreXmlDoc.create "An implementation where every method throws.")
|> SynBinding.withReturnAnnotation constructorReturnType |> SynBinding.withReturnAnnotation constructorReturnType
|> fun m -> SynMemberDefn.Member (m, range0) |> SynMemberDefn.staticMember
let fields = let fields =
let extras = let extras =
if inherits.Contains KnownInheritance.IDisposable then if inherits.Contains KnownInheritance.IDisposable then
[ {
SynField.Create ( Attrs = []
SynType.funFromDomain SynType.unit SynType.unit, Ident = Some (Ident.create "Dispose")
Ident.create "Dispose", Type = SynType.funFromDomain SynType.unit SynType.unit
xmldoc = PreXmlDoc.create "Implementation of IDisposable.Dispose" }
) |> SynField.make
] |> SynField.withDocString (PreXmlDoc.create "Implementation of IDisposable.Dispose")
|> List.singleton
else else
[] []
@@ -111,47 +108,6 @@ module internal InterfaceMockGenerator =
let members = let members =
interfaceType.Members interfaceType.Members
|> List.map (fun memberInfo -> |> List.map (fun memberInfo ->
let synValData =
SynValData.SynValData (
Some
{
IsInstance = true
IsDispatchSlot = false
IsOverrideOrExplicitImpl = true
IsFinal = false
GetterOrSetterIsCompilerGenerated = false
MemberKind = SynMemberKind.Member
},
valInfo =
SynValInfo.SynValInfo (
curriedArgInfos =
[
yield
[
SynArgInfo.SynArgInfo (
attributes = [],
optional = false,
ident = None
)
]
yield!
memberInfo.Args
|> List.mapi (fun i arg ->
arg.Args
|> List.mapi (fun j arg ->
match arg.Type with
| UnitType -> SynArgInfo.SynArgInfo ([], false, None)
| _ -> SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}"
)
)
],
returnInfo =
SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None)
),
thisIdOpt = None
)
let headArgs = let headArgs =
memberInfo.Args memberInfo.Args
|> List.mapi (fun i tupledArgs -> |> List.mapi (fun i tupledArgs ->
@@ -170,16 +126,6 @@ module internal InterfaceMockGenerator =
|> fun i -> if tupledArgs.HasParen then SynPat.paren i else i |> fun i -> if tupledArgs.HasParen then SynPat.paren i else i
) )
let headPat =
SynPat.LongIdent (
SynLongIdent.create [ Ident.create "this" ; memberInfo.Identifier ],
None,
None,
SynArgPats.Pats headArgs,
None,
range0
)
let body = let body =
let tuples = let tuples =
memberInfo.Args memberInfo.Args
@@ -203,28 +149,8 @@ module internal InterfaceMockGenerator =
SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ] SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ]
) )
SynMemberDefn.Member ( SynBinding.basic [ Ident.create "this" ; memberInfo.Identifier ] headArgs body
SynBinding.SynBinding ( |> SynMemberDefn.memberImplementation
None,
SynBindingKind.Normal,
false,
false,
[],
PreXmlDoc.Empty,
synValData,
headPat,
None,
body,
range0,
DebugPointAtBinding.Yes range0,
{
LeadingKeyword = SynLeadingKeyword.Member range0
InlineKeyword = None
EqualsRange = Some range0
}
),
range0
)
) )
let interfaceName = let interfaceName =
@@ -258,14 +184,12 @@ module internal InterfaceMockGenerator =
|> Seq.map (fun inheritance -> |> Seq.map (fun inheritance ->
match inheritance with match inheritance with
| KnownInheritance.IDisposable -> | KnownInheritance.IDisposable ->
let binding = let mem =
SynExpr.createLongIdent [ "this" ; "Dispose" ] SynExpr.createLongIdent [ "this" ; "Dispose" ]
|> SynExpr.applyTo (SynExpr.CreateConst ()) |> SynExpr.applyTo (SynExpr.CreateConst ())
|> SynBinding.basic [ Ident.create "this" ; Ident.create "Dispose" ] [ SynPat.unit ] |> SynBinding.basic [ Ident.create "this" ; Ident.create "Dispose" ] [ SynPat.unit ]
|> SynBinding.withReturnAnnotation SynType.unit |> SynBinding.withReturnAnnotation SynType.unit
|> SynBinding.makeInstanceMember |> SynMemberDefn.memberImplementation
let mem = SynMemberDefn.Member (binding, range0)
SynMemberDefn.Interface ( SynMemberDefn.Interface (
SynType.createLongIdent' [ "System" ; "IDisposable" ], SynType.createLongIdent' [ "System" ; "IDisposable" ],
@@ -309,19 +233,15 @@ module internal InterfaceMockGenerator =
let constructMember (mem : MemberInfo) : SynField = let constructMember (mem : MemberInfo) : SynField =
let inputType = mem.Args |> List.map constructMemberSinglePlace let inputType = mem.Args |> List.map constructMemberSinglePlace
let funcType = AstHelper.toFun inputType mem.ReturnType let funcType = SynType.toFun inputType mem.ReturnType
SynField.SynField ( {
[], Type = funcType
false, Attrs = []
Some mem.Identifier, Ident = Some mem.Identifier
funcType, }
false, |> SynField.make
mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty, |> SynField.withDocString (mem.XmlDoc |> Option.defaultValue PreXmlDoc.Empty)
None,
range0,
SynFieldTrivia.Zero
)
let createRecord let createRecord
(namespaceId : LongIdent) (namespaceId : LongIdent)
@@ -345,10 +265,10 @@ module internal InterfaceMockGenerator =
let typeDecl = createType spec name interfaceType docString fields let typeDecl = createType spec name interfaceType docString fields
SynModuleOrNamespace.CreateNamespace ( [ yield! opens |> List.map SynModuleDecl.openAny ; yield typeDecl ]
namespaceId, |> SynModuleOrNamespace.createNamespace namespaceId
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ typeDecl ]
) open Myriad.Core
/// Myriad generator that creates a record which implements the given interface, /// Myriad generator that creates a record which implements the given interface,
/// but with every field mocked out. /// but with every field mocked out.

View File

@@ -4,7 +4,6 @@ open System
open System.Text open System.Text
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.SyntaxTrivia
open Myriad.Core
type internal JsonParseOutputSpec = type internal JsonParseOutputSpec =
{ {
@@ -14,7 +13,6 @@ type internal JsonParseOutputSpec =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal JsonParseGenerator = module internal JsonParseGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
type JsonParseOption = type JsonParseOption =
{ {
@@ -124,9 +122,10 @@ module internal JsonParseGenerator =
let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.paren let valueArg = SynExpr.createLongIdent [ "kvp" ; "Value" ] |> SynExpr.paren
SynExpr.CreateTuple [ SynExpr.createIdent "key" ; SynExpr.createIdent "value" ] // No need to paren here, we're on the LHS of a `let`
|> SynExpr.createLet [ SynBinding.Let (pattern = SynPat.named "value", expr = value valueArg) ] SynExpr.tupleNoParen [ SynExpr.createIdent "key" ; SynExpr.createIdent "value" ]
|> SynExpr.createLet [ SynBinding.Let (pattern = SynPat.named "key", expr = key keyArg) ] |> SynExpr.createLet [ SynBinding.basic [ Ident.create "value" ] [] (value valueArg) ]
|> SynExpr.createLet [ SynBinding.basic [ Ident.create "key" ] [] (key keyArg) ]
|> SynExpr.createLambda "kvp" |> SynExpr.createLambda "kvp"
/// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user /// A conforming JSON object has only strings as keys. But it would be reasonable to allow the user
@@ -326,8 +325,7 @@ module internal JsonParseGenerator =
SynBinding.basic [ functionName ] [ arg ] functionBody SynBinding.basic [ functionName ] [ arg ] functionBody
|> SynBinding.withXmlDoc xmlDoc |> SynBinding.withXmlDoc xmlDoc
|> SynBinding.withReturnAnnotation returnInfo |> SynBinding.withReturnAnnotation returnInfo
|> List.singleton |> SynModuleDecl.createLet
|> SynModuleDecl.CreateLet
let getParseOptions (fieldAttrs : SynAttribute list) = let getParseOptions (fieldAttrs : SynAttribute list) =
(JsonParseOption.None, fieldAttrs) (JsonParseOption.None, fieldAttrs)
@@ -426,7 +424,7 @@ module internal JsonParseGenerator =
match propertyName with match propertyName with
| SynExpr.Const (synConst, _) -> | SynExpr.Const (synConst, _) ->
SynMatchClause.SynMatchClause ( SynMatchClause.SynMatchClause (
SynPat.CreateConst synConst, SynPat.createConst synConst,
None, None,
body, body,
range0, range0,
@@ -537,11 +535,12 @@ module internal JsonParseGenerator =
|> createUnionMaker spec ident |> createUnionMaker spec ident
| _ -> failwithf "Not a record or union type" | _ -> failwithf "Not a record or union type"
let mdl =
[ scaffolding spec ident decl ] [ scaffolding spec ident decl ]
|> fun d -> SynModuleDecl.CreateNestedModule (info, d) |> SynModuleDecl.nestedModule info
|> List.singleton
|> SynModuleOrNamespace.createNamespace namespaceId
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ]) open Myriad.Core
/// Myriad generator that provides a method (possibly an extension method) for a record type, /// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON parse function. /// containing a JSON parse function.

View File

@@ -3,7 +3,6 @@ namespace WoofWare.Myriad.Plugins
open System open System
open System.Text open System.Text
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Myriad.Core
type internal JsonSerializeOutputSpec = type internal JsonSerializeOutputSpec =
{ {
@@ -13,7 +12,6 @@ type internal JsonSerializeOutputSpec =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal JsonSerializeGenerator = module internal JsonSerializeGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
/// Given `input.Ident`, for example, choose how to add it to the ambient `node`. /// Given `input.Ident`, for example, choose how to add it to the ambient `node`.
/// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`. /// The result is a line like `(fun ident -> InnerType.toJsonNode ident)` or `(fun ident -> JsonValue.Create ident)`.
@@ -51,7 +49,7 @@ module internal JsonSerializeGenerator =
|> SynExpr.paren |> SynExpr.paren
|> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ])
|> SynMatchClause.create ( |> SynMatchClause.create (
SynPat.CreateLongIdent (SynLongIdent.createS "Some", [ SynPat.named "field" ]) SynPat.identWithArgs [ Ident.create "Some" ] (SynArgPats.create [ Ident.create "field" ])
) )
[ noneClause ; someClause ] [ noneClause ; someClause ]
@@ -102,10 +100,9 @@ module internal JsonSerializeGenerator =
SeqExprOnly.SeqExprOnly false, SeqExprOnly.SeqExprOnly false,
true, true,
SynPat.paren ( SynPat.paren (
SynPat.CreateLongIdent ( SynPat.identWithArgs
SynLongIdent.createS "KeyValue", [ Ident.create "KeyValue" ]
[ SynPat.tuple [ SynPat.named "key" ; SynPat.named "value" ] ] (SynArgPats.create [ Ident.create "key" ; Ident.create "value" ])
)
), ),
SynExpr.createIdent "field", SynExpr.createIdent "field",
SynExpr.applyFunction SynExpr.applyFunction
@@ -203,7 +200,7 @@ module internal JsonSerializeGenerator =
] ]
let pattern = let pattern =
SynPat.CreateNamed inputArgName SynPat.namedI inputArgName
|> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName)) |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create typeName))
if spec.ExtensionMethods then if spec.ExtensionMethods then
@@ -225,13 +222,11 @@ module internal JsonSerializeGenerator =
SynModuleDecl.Types ([ containingType ], range0) SynModuleDecl.Types ([ containingType ], range0)
else else
let binding =
assignments assignments
|> SynBinding.basic [ functionName ] [ pattern ] |> SynBinding.basic [ functionName ] [ pattern ]
|> SynBinding.withReturnAnnotation returnInfo |> SynBinding.withReturnAnnotation returnInfo
|> SynBinding.withXmlDoc xmlDoc |> SynBinding.withXmlDoc xmlDoc
|> SynModuleDecl.createLet
SynModuleDecl.CreateLet [ binding ]
let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) = let recordModule (spec : JsonSerializeOutputSpec) (typeName : LongIdent) (fields : SynField list) =
let inputArg = Ident.create "input" let inputArg = Ident.create "input"
@@ -279,13 +274,9 @@ module internal JsonSerializeGenerator =
|> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ])
let dataNode = let dataNode =
SynBinding.Let ( SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ]
pattern = SynPat.named "dataNode", |> SynExpr.applyTo (SynExpr.CreateConst ())
expr = |> SynBinding.basic [ Ident.create "dataNode" ] []
SynExpr.applyFunction
(SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ])
(SynExpr.CreateConst ())
)
let dataBindings = let dataBindings =
(unionCase.Fields, caseNames) (unionCase.Fields, caseNames)
@@ -381,12 +372,13 @@ module internal JsonSerializeGenerator =
[ unionModule spec ident unionFields ] [ unionModule spec ident unionFields ]
| _ -> failwithf "Only record types currently supported." | _ -> failwithf "Only record types currently supported."
let mdl = SynModuleDecl.CreateNestedModule (info, decls) [
yield! opens |> List.map SynModuleDecl.openAny
yield SynModuleDecl.nestedModule info decls
]
|> SynModuleOrNamespace.createNamespace namespaceId
SynModuleOrNamespace.CreateNamespace ( open Myriad.Core
namespaceId,
decls = (opens |> List.map SynModuleDecl.CreateOpen) @ [ mdl ]
)
/// Myriad generator that provides a method (possibly an extension method) for a record type, /// Myriad generator that provides a method (possibly an extension method) for a record type,
/// containing a JSON serialization function. /// containing a JSON serialization function.

View File

@@ -6,7 +6,6 @@ open Fantomas.FCS.Xml
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal RemoveOptionsGenerator = module internal RemoveOptionsGenerator =
open Fantomas.FCS.Text.Range open Fantomas.FCS.Text.Range
open Myriad.Core.Ast
let private removeOption (s : SynField) : SynField = let private removeOption (s : SynField) : SynField =
let (SynField.SynField (synAttributeLists, let (SynField.SynField (synAttributeLists,
@@ -96,7 +95,6 @@ module internal RemoveOptionsGenerator =
) )
|> AstHelper.instantiateRecord |> AstHelper.instantiateRecord
let binding =
SynBinding.basic SynBinding.basic
[ functionName ] [ functionName ]
[ [
@@ -106,8 +104,7 @@ module internal RemoveOptionsGenerator =
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 [ binding ]
let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) = let createRecordModule (namespaceId : LongIdent) (typeDefn : SynTypeDefn) =
let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) = let (SynTypeDefn (synComponentInfo, synTypeDefnRepr, _members, _implicitCtor, _, _)) =
@@ -139,9 +136,9 @@ module internal RemoveOptionsGenerator =
|> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ] |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ]
|> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ] |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ]
let mdl = SynModuleDecl.CreateNestedModule (info, decls) SynModuleDecl.nestedModule info decls
|> List.singleton
SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ]) |> SynModuleOrNamespace.createNamespace namespaceId
| _ -> failwithf "Not a record type" | _ -> failwithf "Not a record type"
open Myriad.Core open Myriad.Core

View File

@@ -5,10 +5,10 @@ open Fantomas.FCS.Syntax
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal SynArgPats = module internal SynArgPats =
let create (caseNames : Ident list) : SynArgPats = let create (caseNames : Ident list) : SynArgPats =
if caseNames.IsEmpty then match caseNames.Length with
SynArgPats.Pats [] | 0 -> SynArgPats.Pats []
else | 1 -> [ SynPat.named caseNames.[0].idText ] |> SynArgPats.Pats
| _ ->
caseNames caseNames
|> List.map (fun i -> SynPat.named i.idText) |> List.map (fun i -> SynPat.named i.idText)
|> SynPat.tuple |> SynPat.tuple

View File

@@ -16,14 +16,18 @@ module internal SynBinding =
let rec private getName (pat : SynPat) : Ident option = let rec private getName (pat : SynPat) : Ident option =
match stripParen pat with match stripParen pat with
| SynPat.Named (SynIdent.SynIdent (name, _), _, _, _) -> Some name | SynPat.Named (SynIdent.SynIdent (name, _), _, _, _) -> Some name
| SynPat.Wild _ -> None
| SynPat.Typed (pat, _, _) -> getName pat | SynPat.Typed (pat, _, _) -> getName pat
| SynPat.Const _ -> None
| SynPat.LongIdent (SynLongIdent.SynLongIdent (longIdent, _, _), _, _, _, _, _) -> | SynPat.LongIdent (SynLongIdent.SynLongIdent (longIdent, _, _), _, _, _, _, _) ->
match longIdent with match longIdent with
| [ x ] -> Some x | [ x ] -> Some x
| _ -> failwithf "got long ident %O ; can only get the name of a long ident with one component" longIdent | _ -> failwithf "got long ident %O ; can only get the name of a long ident with one component" longIdent
| _ -> failwithf "unrecognised pattern: %+A" pat | _ -> None
let private getArgInfo (pat : SynPat) : SynArgInfo list =
// TODO: this only copes with one layer of tupling
match stripParen pat with
| SynPat.Tuple (_, pats, _, _) -> pats |> List.map (fun pat -> SynArgInfo.SynArgInfo ([], false, getName pat))
| pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ]
let triviaZero (isMember : bool) = let triviaZero (isMember : bool) =
{ {
@@ -39,7 +43,7 @@ module internal SynBinding =
let basic (name : LongIdent) (args : SynPat list) (body : SynExpr) : SynBinding = let basic (name : LongIdent) (args : SynPat list) (body : SynExpr) : SynBinding =
let valInfo : SynValInfo = let valInfo : SynValInfo =
args args
|> List.map (fun pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ]) |> List.map getArgInfo
|> fun x -> SynValInfo.SynValInfo (x, SynArgInfo.SynArgInfo ([], false, None)) |> fun x -> SynValInfo.SynValInfo (x, SynArgInfo.SynArgInfo ([], false, None))
SynBinding.SynBinding ( SynBinding.SynBinding (
@@ -103,7 +107,7 @@ module internal SynBinding =
trivia trivia
) )
let makeInline (binding : SynBinding) : SynBinding = let inline makeInline (binding : SynBinding) : SynBinding =
match binding with match binding with
| SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) -> | SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
SynBinding ( SynBinding (
@@ -124,6 +128,33 @@ module internal SynBinding =
} }
) )
let inline makeNotInline (binding : SynBinding) : SynBinding =
match binding with
| SynBinding (acc, kind, _, mut, attrs, doc, valData, headPat, ret, expr, range, debugPoint, trivia) ->
SynBinding (
acc,
kind,
false,
mut,
attrs,
doc,
valData,
headPat,
ret,
expr,
range,
debugPoint,
{ trivia with
InlineKeyword = None
}
)
let inline setInline (isInline : bool) (binding : SynBinding) : SynBinding =
if isInline then
makeInline binding
else
makeNotInline binding
let makeStaticMember (binding : SynBinding) : SynBinding = let makeStaticMember (binding : SynBinding) : SynBinding =
let memberFlags = let memberFlags =
{ {

View File

@@ -1,6 +1,9 @@
namespace WoofWare.Myriad.Plugins namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Text.Range
open Fantomas.FCS.Syntax open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
type internal SynFieldData<'Ident> = type internal SynFieldData<'Ident> =
{ {
@@ -37,3 +40,30 @@ module internal SynField =
| None -> failwith "expected field identifier to have a value, but it did not" | None -> failwith "expected field identifier to have a value, but it did not"
| Some i -> i | Some i -> i
) )
let make (data : SynFieldData<Ident option>) : SynField =
let attrs : SynAttributeList list =
data.Attrs
|> List.map (fun l ->
{
Attributes = [ l ]
Range = range0
}
)
SynField.SynField (
attrs,
false,
data.Ident,
data.Type,
false,
PreXmlDoc.Empty,
None,
range0,
SynFieldTrivia.Zero
)
let withDocString (doc : PreXmlDoc) (f : SynField) : SynField =
match f with
| SynField (attributes, isStatic, idOpt, fieldType, isMutable, _, accessibility, range, trivia) ->
SynField (attributes, isStatic, idOpt, fieldType, isMutable, doc, accessibility, range, trivia)

View File

@@ -59,3 +59,7 @@ module internal SynMemberDefn =
let staticMember (binding : SynBinding) : SynMemberDefn = let staticMember (binding : SynBinding) : SynMemberDefn =
let binding = SynBinding.makeStaticMember binding let binding = SynBinding.makeStaticMember binding
SynMemberDefn.Member (binding, range0) SynMemberDefn.Member (binding, range0)
let memberImplementation (binding : SynBinding) : SynMemberDefn =
let binding = SynBinding.makeInstanceMember binding
SynMemberDefn.Member (binding, range0)

View File

@@ -0,0 +1,28 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynModuleDecl =
let inline openAny (ident : SynOpenDeclTarget) : SynModuleDecl = SynModuleDecl.Open (ident, range0)
let inline createLets (bindings : SynBinding list) : SynModuleDecl =
SynModuleDecl.Let (false, bindings, range0)
let inline createLet (binding : SynBinding) : SynModuleDecl = createLets [ binding ]
let nestedModule (info : SynComponentInfo) (decls : SynModuleDecl list) : SynModuleDecl =
SynModuleDecl.NestedModule (
info,
false,
decls,
false,
range0,
{
ModuleKeyword = Some range0
EqualsRange = Some range0
}
)

View File

@@ -0,0 +1,24 @@
namespace WoofWare.Myriad.Plugins
open Fantomas.FCS.Syntax
open Fantomas.FCS.SyntaxTrivia
open Fantomas.FCS.Xml
open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>]
module internal SynModuleOrNamespace =
let createNamespace (name : LongIdent) (decls : SynModuleDecl list) =
SynModuleOrNamespace.SynModuleOrNamespace (
name,
false,
SynModuleOrNamespaceKind.DeclaredNamespace,
decls,
PreXmlDoc.Empty,
[],
None,
range0,
{
LeadingKeyword = SynModuleOrNamespaceLeadingKeyword.Namespace range0
}
)

View File

@@ -5,9 +5,11 @@ open Fantomas.FCS.Text.Range
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module internal SynPat = module internal SynPat =
let inline paren (pat : SynPat) : SynPat = SynPat.Paren (pat, range0)
let inline annotateType (ty : SynType) (pat : SynPat) = let inline annotateTypeNoParen (ty : SynType) (pat : SynPat) = SynPat.Typed (pat, ty, range0)
SynPat.Paren (SynPat.Typed (pat, ty, range0), range0)
let inline annotateType (ty : SynType) (pat : SynPat) = paren (annotateTypeNoParen ty pat)
let inline named (s : string) : SynPat = let inline named (s : string) : SynPat =
SynPat.Named (SynIdent.SynIdent (Ident (s, range0), None), false, None, range0) SynPat.Named (SynIdent.SynIdent (Ident (s, range0), None), false, None, range0)
@@ -24,10 +26,10 @@ module internal SynPat =
| [ p ] -> p | [ p ] -> p
| elements -> SynPat.Tuple (false, elements, List.replicate (elements.Length - 1) range0, range0) | elements -> SynPat.Tuple (false, elements, List.replicate (elements.Length - 1) range0, range0)
let inline paren (pat : SynPat) : SynPat = SynPat.Paren (pat, range0)
let inline tuple (elements : SynPat list) : SynPat = tupleNoParen elements |> paren let inline tuple (elements : SynPat list) : SynPat = tupleNoParen elements |> paren
let unit = SynPat.Const (SynConst.Unit, range0) let inline createConst (c : SynConst) = SynPat.Const (c, range0)
let unit = createConst SynConst.Unit
let createNull = SynPat.Null range0 let createNull = SynPat.Null range0

View File

@@ -47,6 +47,10 @@ module internal SynType =
let unit : SynType = named "unit" let unit : SynType = named "unit"
let int : SynType = named "int" let int : SynType = named "int"
/// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret.
let toFun (inputs : SynType list) (ret : SynType) : SynType =
(ret, List.rev inputs) ||> List.fold (fun ty input -> funFromDomain input ty)
[<AutoOpen>] [<AutoOpen>]
module internal SynTypePatterns = module internal SynTypePatterns =
let (|OptionType|_|) (fieldType : SynType) = let (|OptionType|_|) (fieldType : SynType) =

View File

@@ -44,6 +44,8 @@
<Compile Include="SynExpr\SynComponentInfo.fs" /> <Compile Include="SynExpr\SynComponentInfo.fs" />
<Compile Include="SynExpr\SynMemberDefn.fs" /> <Compile Include="SynExpr\SynMemberDefn.fs" />
<Compile Include="SynExpr\SynAttribute.fs" /> <Compile Include="SynExpr\SynAttribute.fs" />
<Compile Include="SynExpr\SynModuleDecl.fs" />
<Compile Include="SynExpr\SynModuleOrNamespace.fs" />
<Compile Include="AstHelper.fs" /> <Compile Include="AstHelper.fs" />
<Compile Include="RemoveOptionsGenerator.fs"/> <Compile Include="RemoveOptionsGenerator.fs"/>
<Compile Include="InterfaceMockGenerator.fs"/> <Compile Include="InterfaceMockGenerator.fs"/>