diff --git a/ConsumePlugin/GeneratedMock.fs b/ConsumePlugin/GeneratedMock.fs index 918d11b..41292af 100644 --- a/ConsumePlugin/GeneratedMock.fs +++ b/ConsumePlugin/GeneratedMock.fs @@ -10,17 +10,20 @@ type internal PublicTypeMock = { Mem1 : string * int -> string list Mem2 : string -> int + Mem3 : int * option -> string } static member Empty : PublicTypeMock = { Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) } interface IPublicType with - member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1) - member this.Mem2 (arg0) = this.Mem2 (arg0) + member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) + member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) + member this.Mem3 (arg_0_0, arg_0_1) = this.Mem3 (arg_0_0, arg_0_1) namespace SomeNamespace /// Mock record type for an interface @@ -37,8 +40,8 @@ type internal InternalTypeMock = } interface InternalType with - member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1) - member this.Mem2 (arg0) = this.Mem2 (arg0) + member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) + member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) namespace SomeNamespace /// Mock record type for an interface @@ -55,8 +58,8 @@ type private PrivateTypeMock = } interface PrivateType with - member this.Mem1 (arg0, arg1) = this.Mem1 (arg0, arg1) - member this.Mem2 (arg0) = this.Mem2 (arg0) + member this.Mem1 (arg_0_0, arg_0_1) = this.Mem1 (arg_0_0, arg_0_1) + member this.Mem2 (arg_0_0) = this.Mem2 (arg_0_0) namespace SomeNamespace /// Mock record type for an interface @@ -65,10 +68,46 @@ type internal VeryPublicTypeMock<'a, 'b> = Mem1 : 'a -> 'b } - static member Empty<'a, 'b> () : VeryPublicTypeMock<'a, 'b> = + static member Empty () : VeryPublicTypeMock<'a, 'b> = { Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) } interface VeryPublicType<'a, 'b> with - member this.Mem1 (arg0) = this.Mem1 (arg0) + member this.Mem1 (arg_0_0) = this.Mem1 (arg_0_0) +namespace SomeNamespace + +/// Mock record type for an interface +type internal CurriedMock<'a> = + { + Mem1 : int -> 'a -> string + Mem2 : int * string -> 'a -> string + Mem3 : (int * string) -> 'a -> string + Mem4 : (int * string) -> ('a * int) -> string + Mem5 : int * string -> ('a * int) -> string + Mem6 : int * string -> 'a * int -> string + } + + static member Empty () : CurriedMock<'a> = + { + Mem1 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem2 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem3 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem4 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem5 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + Mem6 = (fun x -> raise (System.NotImplementedException "Unimplemented mock function")) + } + + interface Curried<'a> with + member this.Mem1 (arg_0_0) (arg_1_0) = this.Mem1 (arg_0_0) (arg_1_0) + member this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) = this.Mem2 (arg_0_0, arg_0_1) (arg_1_0) + member this.Mem3 ((arg_0_0, arg_0_1)) (arg_1_0) = this.Mem3 (arg_0_0, arg_0_1) (arg_1_0) + + member this.Mem4 ((arg_0_0, arg_0_1)) ((arg_1_0, arg_1_1)) = + this.Mem4 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) + + member this.Mem5 (arg_0_0, arg_0_1) ((arg_1_0, arg_1_1)) = + this.Mem5 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) + + member this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) = + this.Mem6 (arg_0_0, arg_0_1) (arg_1_0, arg_1_1) diff --git a/ConsumePlugin/GeneratedRestClient.fs b/ConsumePlugin/GeneratedRestClient.fs index 1c3262f..9b0da01 100644 --- a/ConsumePlugin/GeneratedRestClient.fs +++ b/ConsumePlugin/GeneratedRestClient.fs @@ -644,7 +644,7 @@ open RestEase /// Module for constructing a REST client. [] [] -module ApiWithoutBaseAddress = +module internal ApiWithoutBaseAddress = /// Create a REST client. let make (client : System.Net.Http.HttpClient) : IApiWithoutBaseAddress = { new IApiWithoutBaseAddress with diff --git a/ConsumePlugin/MockExample.fs b/ConsumePlugin/MockExample.fs index 569fe9f..35930c5 100644 --- a/ConsumePlugin/MockExample.fs +++ b/ConsumePlugin/MockExample.fs @@ -6,6 +6,7 @@ open WoofWare.Myriad.Plugins type IPublicType = abstract Mem1 : string * int -> string list abstract Mem2 : string -> int + abstract Mem3 : x : int * ?ct : System.Threading.CancellationToken -> string [] type internal InternalType = @@ -20,3 +21,12 @@ type private PrivateType = [] type VeryPublicType<'a, 'b> = abstract Mem1 : 'a -> 'b + +[] +type Curried<'a> = + abstract Mem1 : int -> 'a -> string + abstract Mem2 : int * string -> 'a -> string + abstract Mem3 : (int * string) -> 'a -> string + abstract Mem4 : (int * string) -> ('a * int) -> string + abstract Mem5 : x : int * string -> ('a * int) -> string + abstract Mem6 : int * string -> y : 'a * int -> string diff --git a/ConsumePlugin/RestApiExample.fs b/ConsumePlugin/RestApiExample.fs index 381b271..7e97703 100644 --- a/ConsumePlugin/RestApiExample.fs +++ b/ConsumePlugin/RestApiExample.fs @@ -83,7 +83,7 @@ type IPureGymApi = abstract GetWithoutAnyReturnCode : ?ct : CancellationToken -> Task [] -type IApiWithoutBaseAddress = +type internal IApiWithoutBaseAddress = [] abstract GetPathParam : [] parameter : string * ?ct : CancellationToken -> Task diff --git a/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs b/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs index 9511801..7da125d 100644 --- a/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs +++ b/WoofWare.Myriad.Plugins.Test/TestMockGenerator/TestMockGenerator.fs @@ -10,7 +10,7 @@ module TestMockGenerator = [] let ``Example of use: IPublicType`` () = - let mock = + let mock : IPublicType = { PublicTypeMock.Empty with Mem1 = fun (s, count) -> List.replicate count s } @@ -19,3 +19,16 @@ module TestMockGenerator = Assert.Throws (fun () -> mock.Mem2 "hi" |> ignore) mock.Mem1 ("hi", 3) |> shouldEqual [ "hi" ; "hi" ; "hi" ] + + [] + let ``Example of use: curried args`` () = + let mock : Curried<_> = + { CurriedMock.Empty () with + Mem1 = fun i c -> Array.replicate i c |> String + Mem2 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s) + Mem3 = fun (i, s) c -> String.concat $"%c{c}" (List.replicate i s) + } + + mock.Mem1 3 'a' |> shouldEqual "aaa" + mock.Mem2 (3, "hi") 'a' |> shouldEqual "hiahiahi" + mock.Mem3 (3, "hi") 'a' |> shouldEqual "hiahiahi" diff --git a/WoofWare.Myriad.Plugins/AstHelper.fs b/WoofWare.Myriad.Plugins/AstHelper.fs index dd6f196..4d04b46 100644 --- a/WoofWare.Myriad.Plugins/AstHelper.fs +++ b/WoofWare.Myriad.Plugins/AstHelper.fs @@ -14,14 +14,23 @@ type internal ParameterInfo = Type : SynType } +type internal TupledArg = + { + HasParen : bool + Args : ParameterInfo list + } + type internal MemberInfo = { ReturnType : SynType - Arity : SynArgInfo list - Args : ParameterInfo list + Accessibility : SynAccess option + /// Each element of this list is a list of args in a tuple, or just one arg if not a tuple. + Args : TupledArg list Identifier : Ident Attributes : SynAttribute list XmlDoc : PreXmlDoc option + IsInline : bool + IsMutable : bool } type internal InterfaceType = @@ -114,16 +123,19 @@ module internal AstHelper = |> List.collect (fun (SynModuleOrNamespace (_, _, _, decls, _, _, _, _, _)) -> extractOpensFromDecl decls) | _ -> [] - let rec convertSigParam (ty : SynType) : ParameterInfo = + let rec convertSigParam (ty : SynType) : ParameterInfo * bool = match ty with - | SynType.Paren (inner, _) -> convertSigParam inner + | SynType.Paren (inner, _) -> + let result, _ = convertSigParam inner + result, true | SynType.LongIdent ident -> { Attributes = [] IsOptional = false Id = None Type = SynType.CreateLongIdent ident - } + }, + false | SynType.SignatureParameter (attrs, opt, id, usedType, _) -> let attrs = attrs |> List.collect (fun attrs -> attrs.Attributes) @@ -132,17 +144,61 @@ module internal AstHelper = IsOptional = opt Id = id Type = usedType - } + }, + false + | SynType.Var (typar, _) -> + { + Attributes = [] + IsOptional = false + Id = None + Type = SynType.Var (typar, range0) + }, + false | _ -> failwithf "expected SignatureParameter, got: %+A" ty - let rec extractTupledTypes (tupleType : SynTupleTypeSegment list) : ParameterInfo list = + let rec extractTupledTypes (tupleType : SynTupleTypeSegment list) : TupledArg = match tupleType with - | [] -> [] - | [ SynTupleTypeSegment.Type param ] -> [ convertSigParam param ] + | [] -> + { + HasParen = false + Args = [] + } + | [ SynTupleTypeSegment.Type param ] -> + let converted, hasParen = convertSigParam param + + { + HasParen = hasParen + Args = [ converted ] + } | SynTupleTypeSegment.Type param :: SynTupleTypeSegment.Star _ :: rest -> - convertSigParam param :: extractTupledTypes rest + let rest = extractTupledTypes rest + let converted, _ = convertSigParam param + + { + HasParen = false + Args = converted :: rest.Args + } | _ -> 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.CreateFun (input, ty)) + + /// 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 = + match ty with + | SynType.Paren (ty, _) -> getType ty + | SynType.Fun (argType, returnType, _, _) -> + let args, ret = getType returnType + // TODO this code is clearly wrong + let (inputArgs, inputRet), hasParen = + match argType with + | SynType.Paren (argType, _) -> getType argType, true + | _ -> getType argType, false + + ((toFun (List.map fst inputArgs) inputRet), hasParen) :: args, ret + | _ -> [], ty + /// Assumes that the input type is an ObjectModel, i.e. a `type Foo = member ...` let parseInterface (interfaceType : SynTypeDefn) : InterfaceType = let (SynTypeDefn (SynComponentInfo (attrs, typars, _, interfaceName, _, _, accessibility, _), @@ -182,74 +238,74 @@ module internal AstHelper = synExpr, _, _) -> - if isInline then - failwith "inline members not supported" - - if isMutable then - failwith "mutable members not supported" - - match accessibility with - | Some (SynAccess.Internal _) - | Some (SynAccess.Private _) -> failwith "only public members are supported" - | _ -> () match synExpr with | Some _ -> failwith "literal members are not supported" | None -> () - let arity = - match arity with - | SynValInfo ([ curriedArgs ], SynArgInfo ([], false, _)) -> curriedArgs - | SynValInfo (curriedArgs, SynArgInfo ([], false, _)) -> - failwithf "only tupled arguments are currently supported, but got: %+A" curriedArgs - | SynValInfo (_, info) -> - failwithf - "only bare return values like `Task` are supported, but got: %+A" - info - let attrs = attrs |> List.collect (fun attr -> attr.Attributes) - let args, ret = - match synType with - | SynType.Fun (argType, returnType, _, _) -> argType, returnType - | _ -> - failwithf - "Expected a return type of a generic Task; bad signature was: %+A" - synType + let args, ret = getType synType let args = - match args with - | SynType.SignatureParameter _ -> [ convertSigParam args ] - | SynType.Tuple (false, path, _) -> extractTupledTypes path - | SynType.LongIdent (SynLongIdent (ident, _, _)) -> - { - Attributes = [] - IsOptional = false - Id = None - Type = SynType.CreateLongIdent (SynLongIdent.CreateFromLongIdent ident) - } - |> List.singleton - | SynType.Var (typar, _) -> - { - Attributes = [] - IsOptional = false - Id = None - Type = SynType.Var (typar, range0) - } - |> List.singleton - | _ -> failwithf "Unrecognised args in interface method declaration: %+A" args + args + |> List.map (fun (args, hasParen) -> + match args with + | SynType.Tuple (false, path, _) -> extractTupledTypes path + | SynType.SignatureParameter _ -> + let arg, hasParen = convertSigParam args + + { + HasParen = hasParen + Args = [ arg ] + } + | SynType.LongIdent (SynLongIdent (ident, _, _)) -> + { + HasParen = false + Args = + { + Attributes = [] + IsOptional = false + Id = None + Type = + SynType.CreateLongIdent ( + SynLongIdent.CreateFromLongIdent ident + ) + } + |> List.singleton + } + | SynType.Var (typar, _) -> + { + HasParen = false + Args = + { + Attributes = [] + IsOptional = false + Id = None + Type = SynType.Var (typar, range0) + } + |> List.singleton + } + | _ -> failwith $"Unrecognised args in interface method declaration: %+A{args}" + |> fun ty -> + { ty with + HasParen = ty.HasParen || hasParen + } + ) { ReturnType = ret - Arity = arity Args = args Identifier = ident Attributes = attrs XmlDoc = Some xmlDoc + Accessibility = accessibility + IsInline = isInline + IsMutable = isMutable } - | _ -> failwithf "Unrecognised member definition: %+A" defn + | _ -> failwith $"Unrecognised member definition: %+A{defn}" ) - | _ -> failwithf "Unrecognised SynTypeDefnRepr for an interface type: %+A" synTypeDefnRepr + | _ -> failwith $"Unrecognised SynTypeDefnRepr for an interface type: %+A{synTypeDefnRepr}" { Members = members diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 3adcc7b..3e2b8f5 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -3,7 +3,6 @@ namespace WoofWare.Myriad.Plugins open System open System.Net.Http open Fantomas.FCS.Syntax -open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.Xml open Myriad.Core @@ -56,12 +55,12 @@ module internal HttpClientGenerator = /// E.g. "v1/gyms/{gym_id}/attendance" UrlTemplate : string TaskReturnType : SynType - Arity : SynArgInfo list Args : Parameter list Identifier : Ident EnsureSuccessHttpCode : bool BaseAddress : SynExpr option BasePath : SynExpr option + Accessibility : SynAccess option } let httpMethodString (m : HttpMethod) : string = @@ -121,10 +120,10 @@ module internal HttpClientGenerator = match arg with | SynExpr.Const (SynConst.String (text, SynStringKind.Regular, _), _) -> meth, text | arg -> - failwithf "Unrecognised AST member in attribute argument. Only regular strings are supported: %+A" arg + failwith $"Unrecognised AST member in attribute argument. Only regular strings are supported: %+A{arg}" | [] -> failwith "Required exactly one recognised RestEase attribute on member, but got none" | matchingAttrs -> - failwithf "Required exactly one recognised RestEase attribute on member, but got %i" matchingAttrs.Length + failwith $"Required exactly one recognised RestEase attribute on member, but got %i{matchingAttrs.Length}" let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool = attrs @@ -581,7 +580,7 @@ module internal HttpClientGenerator = SynMemberDefn.Member ( SynBinding.SynBinding ( - None, + info.Accessibility, SynBindingKind.Normal, false, false, @@ -608,19 +607,19 @@ module internal HttpClientGenerator = | SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Query None) | SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) -> Some (HttpAttribute.Query (Some s)) - | SynExpr.Const (a, _) -> failwithf "unrecognised constant arg to the Query attribute: %+A" a + | SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Query attribute: %+A{a}" | _ -> None | "Path" | "PathAttribute" -> match attr.ArgExpr with | SynExpr.Const (SynConst.String (s, SynStringKind.Regular, _), _) -> Some (HttpAttribute.Path s) - | SynExpr.Const (a, _) -> failwithf "unrecognised constant arg to the Path attribute: %+A" a + | SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Path attribute: %+A{a}" | _ -> None | "Body" | "BodyAttribute" -> match attr.ArgExpr with - | SynExpr.Const (SynConst.Unit, _) -> Some (HttpAttribute.Body) - | SynExpr.Const (a, _) -> failwithf "unrecognised constant arg to the Body attribute: %+A" a + | SynExpr.Const (SynConst.Unit, _) -> Some HttpAttribute.Body + | SynExpr.Const (a, _) -> failwith $"unrecognised constant arg to the Body attribute: %+A{a}" | _ -> None | _ -> None ) @@ -670,13 +669,16 @@ module internal HttpClientGenerator = | Task ty -> ty | a -> failwith $"Method must return a generic Task; returned %+A{a}" - { - HttpMethod = httpMethod - UrlTemplate = url - TaskReturnType = returnType - Arity = mem.Arity - Args = - mem.Args + if mem.IsMutable then + failwith $"mutable methods not supported (identifier: %+A{mem.Identifier})" + + if mem.IsInline then + failwith $"inline methods not supported (identifier: %+A{mem.Identifier})" + + let args = + match mem.Args with + | [ args ] -> + args.Args |> List.map (fun arg -> { Attributes = arg.Attributes |> getHttpAttributes @@ -685,10 +687,21 @@ module internal HttpClientGenerator = Type = arg.Type } ) + | [] -> failwith $"Expected %+A{mem.Identifier} to have tupled args, but it had no args." + | _ -> + failwith + $"Expected %+A{mem.Identifier} to have tupled args, but it was curried: %+A{mem.Args}." + + { + HttpMethod = httpMethod + UrlTemplate = url + TaskReturnType = returnType + Args = args Identifier = mem.Identifier EnsureSuccessHttpCode = shouldEnsureSuccess BaseAddress = baseAddress BasePath = basePath + Accessibility = mem.Accessibility } ) @@ -756,7 +769,7 @@ module internal HttpClientGenerator = if s.StartsWith 'I' then s.[1..] else - failwithf "Expected interface type to start with 'I', but was: %s" s + failwith $"Expected interface type to start with 'I', but was: %s{s}" |> Ident.Create |> List.singleton @@ -767,7 +780,12 @@ module internal HttpClientGenerator = ] let modInfo = - SynComponentInfo.Create (moduleName, attributes = attribs, xmldoc = docString) + SynComponentInfo.Create ( + moduleName, + attributes = attribs, + xmldoc = docString, + access = interfaceType.Accessibility + ) SynModuleOrNamespace.CreateNamespace ( ns, diff --git a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs index b48bfd0..307c2dc 100644 --- a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs +++ b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs @@ -62,7 +62,7 @@ module internal InterfaceMockGenerator = SynPat.LongIdent ( SynLongIdent.CreateString "Empty", None, - generics, + None, // no generics on the "Empty", only on the return type SynArgPats.Pats ( if generics.IsNone then [] @@ -126,7 +126,7 @@ module internal InterfaceMockGenerator = let synValData = SynValData.SynValData ( - Some ( + Some { IsInstance = true IsDispatchSlot = false @@ -134,14 +134,27 @@ module internal InterfaceMockGenerator = IsFinal = false GetterOrSetterIsCompilerGenerated = false MemberKind = SynMemberKind.Member - } - ), + }, valInfo = SynValInfo.SynValInfo ( curriedArgInfos = [ - [ SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None) ] - [] + yield + [ + SynArgInfo.SynArgInfo ( + attributes = [], + optional = false, + ident = None + ) + ] + yield! + memberInfo.Args + |> List.mapi (fun i arg -> + arg.Args + |> List.mapi (fun j arg -> + SynArgInfo.CreateIdString $"arg_%i{i}_%i{j}" + ) + ) ], returnInfo = SynArgInfo.SynArgInfo (attributes = [], optional = false, ident = None) @@ -150,25 +163,50 @@ module internal InterfaceMockGenerator = ) let headArgs = - SynPat.Tuple ( - false, - memberInfo.Args - |> List.mapi (fun i _arg -> SynPat.CreateNamed (Ident.Create $"arg%i{i}")), - List.replicate (memberInfo.Args.Length - 1) range0, - range0 + memberInfo.Args + |> List.mapi (fun i tupledArgs -> + let args = + tupledArgs.Args + |> List.mapi (fun j _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}")) + + SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) + |> SynPat.CreateParen + |> fun i -> if tupledArgs.HasParen then SynPat.Paren (i, range0) else i ) - |> SynPat.CreateParen let headPat = SynPat.LongIdent ( SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ], None, None, - SynArgPats.Pats [ headArgs ], + SynArgPats.Pats headArgs, None, range0 ) + let body = + let tuples = + memberInfo.Args + |> List.mapi (fun i args -> + args.Args + |> List.mapi (fun j args -> SynExpr.CreateIdentString $"arg_%i{i}_%i{j}") + |> SynExpr.CreateParenedTuple + ) + + match tuples |> List.rev with + | [] -> failwith "expected args but got none" + | last :: rest -> + + (last, rest) + ||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail)) + |> fun args -> + SynExpr.CreateApp ( + SynExpr.CreateLongIdent ( + SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ] + ), + args + ) + SynMemberDefn.Member ( SynBinding.SynBinding ( None, @@ -180,16 +218,7 @@ module internal InterfaceMockGenerator = synValData, headPat, None, - SynExpr.CreateApp ( - SynExpr.CreateLongIdent ( - SynLongIdent.CreateFromLongIdent [ Ident.Create "this" ; memberInfo.Identifier ] - ), - SynExpr.CreateParen ( - memberInfo.Args - |> List.mapi (fun i _arg -> SynExpr.CreateIdentString $"arg%i{i}") - |> SynExpr.CreateTuple - ) - ), + body, range0, DebugPointAtBinding.Yes range0, { @@ -250,23 +279,30 @@ module internal InterfaceMockGenerator = SynModuleDecl.Types ([ typeDecl ], range0) - let constructMember (mem : MemberInfo) : SynField = - let inputType = - match mem.Args |> List.map (fun pi -> pi.Type) |> List.rev with - | [] -> failwith "no-arg functions not supported yet" - | [ x ] -> x - | last :: rest -> - ([ SynTupleTypeSegment.Type last ], rest) - ||> List.fold (fun ty nextArg -> - SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty - ) - |> fun segs -> SynType.Tuple (false, segs, range0) + let private buildType (x : ParameterInfo) : SynType = + if x.IsOptional then + SynType.App (SynType.CreateLongIdent "option", Some range0, [ x.Type ], [], Some range0, false, range0) + else + x.Type - let funcType = SynType.CreateFun (inputType, mem.ReturnType) + let private constructMemberSinglePlace (tuple : TupledArg) : SynType = + match tuple.Args |> List.rev |> List.map buildType with + | [] -> failwith "no-arg functions not supported yet" + | [ x ] -> x + | last :: rest -> + ([ SynTupleTypeSegment.Type last ], rest) + ||> 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 inputType = mem.Args |> List.map constructMemberSinglePlace + + let funcType = AstHelper.toFun inputType mem.ReturnType SynField.SynField ( [], - true, + false, Some mem.Identifier, funcType, false,