From 7b14e52e9dd2da010174ba75a54a86956bdf1134 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Fri, 31 May 2024 19:20:28 +0100 Subject: [PATCH] Use our DSLs a bit more (#154) --- ConsumePlugin/GeneratedMock.fs | 2 +- .../TestJsonSerialize/TestJsonSerde.fs | 9 +- WoofWare.Myriad.Plugins/AstHelper.fs | 7 +- WoofWare.Myriad.Plugins/CataGenerator.fs | 185 +++++++----------- .../HttpClientGenerator.fs | 124 +++++------- .../InterfaceMockGenerator.fs | 51 +++-- WoofWare.Myriad.Plugins/JsonParseGenerator.fs | 52 +++-- .../JsonSerializeGenerator.fs | 118 +++++------ .../RemoveOptionsGenerator.fs | 29 +-- WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs | 6 +- .../SynExpr/SynAttribute.fs | 21 +- WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs | 4 +- WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs | 158 ++++++--------- .../SynExpr/SynLongIdent.fs | 23 +++ WoofWare.Myriad.Plugins/SynExpr/SynPat.fs | 23 ++- WoofWare.Myriad.Plugins/SynExpr/SynType.fs | 3 + .../WoofWare.Myriad.Plugins.fsproj | 4 +- 17 files changed, 359 insertions(+), 460 deletions(-) diff --git a/ConsumePlugin/GeneratedMock.fs b/ConsumePlugin/GeneratedMock.fs index 6aeb44d..216f962 100644 --- a/ConsumePlugin/GeneratedMock.fs +++ b/ConsumePlugin/GeneratedMock.fs @@ -195,7 +195,7 @@ type internal TypeWithInterfaceMock = /// An implementation where every method throws. static member Empty : TypeWithInterfaceMock = { - Dispose = (fun _ -> ()) + Dispose = (fun () -> ()) Mem1 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function")) Mem2 = (fun _ -> raise (System.NotImplementedException "Unimplemented mock function")) } diff --git a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs index ba7b86b..f9c0f86 100644 --- a/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs +++ b/WoofWare.Myriad.Plugins.Test/TestJsonSerialize/TestJsonSerde.fs @@ -193,12 +193,13 @@ module TestJsonSerde = let decompose = FSharpValue.PreComputeUnionTagReader typeof - Gen.listOf duGen - |> Gen.eval 100 (StdGen.StdGen (rand.Next (), rand.Next ())) - |> List.iter (fun du -> + let mutable i = 0 + + while i < 10_000 && Array.exists (fun i -> i = 0) counts do + let du = Gen.eval 10 (StdGen.StdGen (rand.Next (), rand.Next ())) duGen let tag = decompose du counts.[tag] <- counts.[tag] + 1 - ) + i <- i + 1 for i in counts do i |> shouldBeGreaterThan 0 diff --git a/WoofWare.Myriad.Plugins/AstHelper.fs b/WoofWare.Myriad.Plugins/AstHelper.fs index 89e8cc3..5869213 100644 --- a/WoofWare.Myriad.Plugins/AstHelper.fs +++ b/WoofWare.Myriad.Plugins/AstHelper.fs @@ -3,7 +3,6 @@ namespace WoofWare.Myriad.Plugins open Fantomas.FCS.Syntax open Fantomas.FCS.Text.Range open Fantomas.FCS.Xml -open Myriad.Core.AstExtensions type internal ParameterInfo = { @@ -137,12 +136,12 @@ module internal AstHelper = | SynType.Paren (inner, _) -> let result, _ = convertSigParam inner result, true - | SynType.LongIdent ident -> + | SynType.LongIdent (SynLongIdent.SynLongIdent (ident, _, _)) -> { Attributes = [] IsOptional = false Id = None - Type = SynType.CreateLongIdent ident + Type = SynType.createLongIdent ident }, false | SynType.SignatureParameter (attrs, opt, id, usedType, _) -> @@ -191,7 +190,7 @@ module internal AstHelper = let toFun (inputs : SynType list) (ret : SynType) : SynType = (ret, List.rev inputs) - ||> List.fold (fun ty input -> SynType.CreateFun (input, ty)) + ||> 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. let rec getType (ty : SynType) : (SynType * bool) list * SynType = diff --git a/WoofWare.Myriad.Plugins/CataGenerator.fs b/WoofWare.Myriad.Plugins/CataGenerator.fs index 5a61273..16bc6a3 100644 --- a/WoofWare.Myriad.Plugins/CataGenerator.fs +++ b/WoofWare.Myriad.Plugins/CataGenerator.fs @@ -62,15 +62,15 @@ module internal CataGenerator = Fields : CataUnionField list /// The corresponding method of the appropriate cata, fully-qualified as a call /// into some specific cata - CataMethodName : SynLongIdent + CataMethodName : LongIdent /// The identifier of the method of the appropriate cata CataMethodIdent : SynIdent /// The Instruction case which instructs the state machine to pull anything /// necessary from the stacks and call into the cata. - AssociatedInstruction : SynLongIdent + AssociatedInstruction : LongIdent /// Matching on an element of this union type, if you match against this /// left-hand side (and give appropriate field arguments), you will enter this union case. - Match : SynLongIdent + Match : LongIdent } member this.FlattenedFields : CataUnionBasicField list = @@ -98,7 +98,7 @@ module internal CataGenerator = /// (i.e. when we enter the loop for the first time). /// The state machine interprets this instruction as "break me apart and /// descend recursively if necessary before coming back to me". - AssociatedProcessInstruction : SynLongIdent + AssociatedProcessInstruction : LongIdent /// Name of the parent type: e.g. in `type Foo = | Blah`, this is `Foo`. ParentTypeName : LongIdent /// The name of the generic type parameter we'll use within the cata @@ -165,7 +165,7 @@ module internal CataGenerator = ) [ - SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction + SynExpr.createLongIdent' analysis.AssociatedProcessInstruction |> SynExpr.applyTo (SynExpr.createLongIdent [ "x" ]) |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ]) @@ -178,17 +178,11 @@ module internal CataGenerator = SynBinding.Let ( valData = SynValData.SynValData (None, SynValInfo.Empty, None), pattern = - SynPat.Tuple ( - false, - List.map - (fun (t : Ident) -> - SynPat.CreateNamed ( - Ident.Create (t.idText + "Stack") |> Ident.lowerFirstLetter - ) - ) - allArtificialTyparNames, - List.replicate (allArtificialTyparNames.Length - 1) range0, - range0 + SynPat.tupleNoParen ( + allArtificialTyparNames + |> List.map (fun (t : Ident) -> + SynPat.namedI (Ident.create (t.idText + "Stack") |> Ident.lowerFirstLetter) + ) ), expr = SynExpr.applyFunction @@ -197,17 +191,15 @@ module internal CataGenerator = ) ] ] - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynExpr.createLet [ SynExpr.createIdent "ResizeArray" |> SynExpr.applyTo (SynExpr.CreateConst ()) - |> SynBinding.basic (SynLongIdent.createS "instructions") [] + |> SynBinding.basic [ Ident.create "instructions" ] [] ] |> SynExpr.typeAnnotate relevantTypar - |> SynBinding.basic - (SynLongIdent.createS ("run" + List.last(relevantTypeName).idText)) - [ cataObject ; inputObject ] + |> SynBinding.basic [ Ident.create ("run" + List.last(relevantTypeName).idText) ] [ cataObject ; inputObject ] |> SynBinding.withReturnAnnotation relevantTypar |> SynBinding.withXmlDoc (PreXmlDoc.create "Execute the catamorphism.") @@ -361,7 +353,7 @@ module internal CataGenerator = | FieldDescription.Self ty -> true, None | FieldDescription.ListSelf ty -> // store the length of the list - true, Some (SynType.Int ()) + true, Some SynType.int type InstructionCase = { @@ -423,9 +415,7 @@ module internal CataGenerator = unions |> List.map (fun union -> { - Name = - match union.AssociatedProcessInstruction with - | SynLongIdent.SynLongIdent (i, _, _) -> List.last i + Name = List.last union.AssociatedProcessInstruction Fields = { Name = None @@ -493,7 +483,7 @@ module internal CataGenerator = |> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText) |> List.distinct |> List.map (fun i -> - SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false)) + SynTyparDecl.SynTyparDecl ([], SynTypar.SynTypar (Ident.create i, TyparStaticReq.None, false)) ) SynTypeDefnRepr.union cases @@ -501,7 +491,7 @@ module internal CataGenerator = SynComponentInfo.create (Ident.create "Instruction") |> SynComponentInfo.withGenerics typars |> SynComponentInfo.withAccessibility (SynAccess.Private range0) - |> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ] + |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ] ) /// Build the cata interfaces, which a user will instantiate to specify a particular @@ -577,7 +567,7 @@ module internal CataGenerator = case.CataMethodIdent None arity - (PreXmlDoc.create $"How to operate on the %s{List.last(case.Match.LongIdent).idText} case") + (PreXmlDoc.create $"How to operate on the %s{List.last(case.Match).idText} case") ) |> SynTypeDefnRepr.interfaceType |> SynTypeDefn.create componentInfo @@ -607,7 +597,7 @@ module internal CataGenerator = analysis.Typars |> List.map (fun (SynTyparDecl.SynTyparDecl (_, SynTypar.SynTypar (ident, _, _))) -> ident.idText) |> List.distinct - |> List.map (fun i -> SynType.var (SynTypar.SynTypar (Ident.Create i, TyparStaticReq.None, false))) + |> List.map (fun i -> SynType.var (SynTypar.SynTypar (Ident.create i, TyparStaticReq.None, false))) let ty = SynType.app' @@ -713,20 +703,19 @@ module internal CataGenerator = InstructionName = instructionName Fields = analysis CaseName = name - CataMethodName = SynLongIdent.create (cataVarName :: unionTypeName @ [ unionCaseName ]) + CataMethodName = cataVarName :: unionTypeName @ [ unionCaseName ] CataMethodIdent = SynIdent.SynIdent (unionCaseName, None) - AssociatedInstruction = - SynLongIdent.create [ Ident.create "Instruction" ; instructionName ] - Match = SynLongIdent.create (unionTypeName @ [ unionCaseName ]) + AssociatedInstruction = [ Ident.create "Instruction" ; instructionName ] + Match = unionTypeName @ [ unionCaseName ] } ) AssociatedProcessInstruction = - SynLongIdent.createS' - [ - "Instruction" - // such jank! - "Process__" + List.last(unionTypeName).idText - ] + [ + "Instruction" + // such jank! + "Process__" + List.last(unionTypeName).idText + ] + |> List.map Ident.create ParentTypeName = getName unionType GenericName = getName unionType |> List.map _.idText |> String.concat "" |> Ident.create CataTypeName = List.last(getName unionType).idText + "CataCase" |> Ident.create @@ -734,9 +723,9 @@ module internal CataGenerator = ) let callCataAndPushResult (resultStackName : Ident) (unionCase : RenderedUnionCase) : SynExpr = - (SynExpr.CreateLongIdent unionCase.CataMethodName, unionCase.FlattenedFields) + (SynExpr.createLongIdent' unionCase.CataMethodName, unionCase.FlattenedFields) ||> List.fold (fun body caseDesc -> SynExpr.applyFunction body (SynExpr.createIdent' caseDesc.ArgName)) - |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' (resultStackName :: [ Ident.Create "Add" ])) + |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent' (resultStackName :: [ Ident.create "Add" ])) /// Create the state-machine matches which deal with receiving the instruction /// to "process one of the user-specified DU cases, pushing recursion instructions onto @@ -771,7 +760,7 @@ module internal CataGenerator = // The instruction to process us again once our inputs are ready: let reprocessCommand = if selfArgs.Length = unionCase.FlattenedFields.Length then - SynExpr.CreateLongIdent unionCase.AssociatedInstruction + SynExpr.createLongIdent' unionCase.AssociatedInstruction else // We need to tell ourselves each non-rec arg, and the length of each input list. listSelfArgs @@ -788,8 +777,8 @@ module internal CataGenerator = ) |> List.sortBy fst |> List.map snd - |> SynExpr.CreateParenedTuple - |> SynExpr.applyFunction (SynExpr.CreateLongIdent unionCase.AssociatedInstruction) + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent' unionCase.AssociatedInstruction) |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ]) @@ -815,7 +804,7 @@ module internal CataGenerator = (SynExpr.createLongIdent [ "instructions" ; "Add" ]) (SynExpr.paren ( SynExpr.applyFunction - (SynExpr.CreateLongIdent analysis.AssociatedProcessInstruction) + (SynExpr.createLongIdent' analysis.AssociatedProcessInstruction) (SynExpr.createIdent "elt") )), range0 @@ -835,66 +824,36 @@ module internal CataGenerator = |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createLongIdent [ "instructions" ; "Add" ]) ] - |> SynExpr.CreateSequential + |> SynExpr.sequential let matchLhs = - if unionCase.Fields.Length > 0 then - SynPat.Tuple ( - false, - unionCase.Fields - |> List.mapi (fun i case -> - match case with - | CataUnionField.Basic case -> - SynPat.CreateNamed (Ident.lowerFirstLetter case.ArgName) - | CataUnionField.Record fields -> - let fields = - fields - |> List.map (fun (name, field) -> - ([], name), range0, SynPat.CreateNamed (Ident.lowerFirstLetter name) - ) + if not unionCase.Fields.IsEmpty then + unionCase.Fields + |> List.mapi (fun i case -> + match case with + | CataUnionField.Basic case -> SynPat.namedI (Ident.lowerFirstLetter case.ArgName) + | CataUnionField.Record fields -> + let fields = + fields + |> List.map (fun (name, field) -> + ([], name), range0, SynPat.namedI (Ident.lowerFirstLetter name) + ) - SynPat.Record (fields, range0) - ), - List.replicate (unionCase.Fields.Length - 1) range0, - range0 + SynPat.Record (fields, range0) ) - |> SynPat.CreateParen + |> SynPat.tuple |> List.singleton else [] - SynMatchClause.SynMatchClause ( - SynPat.CreateLongIdent (unionCase.Match, matchLhs), - None, - matchBody, - range0, - DebugPointAtTarget.Yes, - { - ArrowRange = Some range0 - BarRange = Some range0 - } - ) + SynMatchClause.create + (SynPat.CreateLongIdent (SynLongIdent.create unionCase.Match, matchLhs)) + matchBody ) - let bodyMatch = SynExpr.createMatch (SynExpr.createIdent "x") matchCases - - SynMatchClause.SynMatchClause ( - SynPat.LongIdent ( - analysis.AssociatedProcessInstruction, - None, - None, - SynArgPats.create [ Ident.create "x" ], - None, - range0 - ), - None, - bodyMatch, - range0, - DebugPointAtTarget.Yes, - { - ArrowRange = Some range0 - BarRange = Some range0 - } + SynExpr.createMatch (SynExpr.createIdent "x") matchCases + |> SynMatchClause.create ( + SynPat.identWithArgs analysis.AssociatedProcessInstruction (SynArgPats.create [ Ident.create "x" ]) ) /// Create the state-machine matches which deal with receiving the instruction @@ -927,7 +886,7 @@ module internal CataGenerator = None ) |> List.map (fun unionCase -> - let lhsNames = + let pat = unionCase.FlattenedFields |> Seq.mapi (fun i x -> (i, x)) |> Seq.choose (fun (i, case) -> @@ -937,11 +896,8 @@ module internal CataGenerator = | FieldDescription.Self _ -> None ) |> Seq.toList - - let lhs = SynArgPats.create lhsNames - - let pat = - SynPat.LongIdent (unionCase.AssociatedInstruction, None, None, lhs, None, range0) + |> SynArgPats.create + |> SynPat.identWithArgs unionCase.AssociatedInstruction let populateArgs = unionCase.FlattenedFields @@ -970,7 +926,7 @@ module internal CataGenerator = range0, range0 ) - |> SynBinding.basic (SynLongIdent.createI field.ArgName) [] + |> SynBinding.basic [ field.ArgName ] [] ] |> Some | ListSelf synType -> @@ -1006,7 +962,7 @@ module internal CataGenerator = ) |> SynExpr.applyFunction (SynExpr.createIdent "seq") |> SynExpr.pipeThroughFunction (SynExpr.createLongIdent [ "Seq" ; "toList" ]) - |> SynBinding.basic (SynLongIdent.createI field.ArgName) [] + |> SynBinding.basic [ field.ArgName ] [] let shadowedIdent = Ident.create (field.ArgName.idText + "_len") @@ -1016,23 +972,18 @@ module internal CataGenerator = (SynExpr.createIdent' shadowedIdent) SynExpr.createIdent' shadowedIdent ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction ( SynExpr.createLongIdent' [ stackName ; Ident.create "RemoveRange" ] ) |> SynExpr.createLet [ vals ] |> SynExpr.createLet - [ - SynBinding.basic - (SynLongIdent.createI shadowedIdent) - [] - (SynExpr.createIdent' field.ArgName) - ] + [ SynBinding.basic [ shadowedIdent ] [] (SynExpr.createIdent' field.ArgName) ] |> Some ) (populateArgs @ [ callCataAndPushResult analysis.StackName unionCase ]) - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynMatchClause.create pat ) ) @@ -1082,7 +1033,7 @@ module internal CataGenerator = (SynExpr.paren (SynExpr.minusN (SynLongIdent.createS' [ "instructions" ; "Count" ]) 1)) matchStatement ] - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynExpr.createLet [ SynExpr.DotIndexedGet ( @@ -1091,11 +1042,11 @@ module internal CataGenerator = range0, range0 ) - |> SynBinding.basic (SynLongIdent.createS "currentInstruction") [] + |> SynBinding.basic [ Ident.create "currentInstruction" ] [] ] let body = - SynExpr.CreateSequential + SynExpr.sequential [ SynExpr.createWhile (SynExpr.greaterThan @@ -1126,11 +1077,11 @@ module internal CataGenerator = range0 ) |> SynExpr.applyTo (SynExpr.CreateConst ()) - |> SynBinding.basic (SynLongIdent.createI unionCase.StackName) [] + |> SynBinding.basic [ unionCase.StackName ] [] ] ) - SynBinding.basic (SynLongIdent.createS "loop") args body + SynBinding.basic [ Ident.create "loop" ] args body |> SynBinding.withAccessibility (Some (SynAccess.Private range0)) let createModule @@ -1154,7 +1105,7 @@ module internal CataGenerator = |> SynComponentInfo.withDocString ( PreXmlDoc.Create $" Methods to perform a catamorphism over the type %s{parentName}" ) - |> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ] + |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ] let cataVarName = Ident.create "cata" let analysis = makeUnionAnalyses cataVarName allRecordTypes allUnionTypes diff --git a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs index 65661b4..8239a43 100644 --- a/WoofWare.Myriad.Plugins/HttpClientGenerator.fs +++ b/WoofWare.Myriad.Plugins/HttpClientGenerator.fs @@ -82,7 +82,7 @@ module internal HttpClientGenerator = let matchingAttrs = attrs |> List.choose (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "Get" | "GetAttribute" | "WoofWare.Myriad.Plugins.RestEase.Get" @@ -144,7 +144,7 @@ module internal HttpClientGenerator = let extractHeaderInformation (attrs : SynAttribute list) : SynExpr list list = attrs |> List.choose (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "Header" | "RestEase.Header" | "WoofWare.Myriad.Plugins.RestEase.Header" -> @@ -158,7 +158,7 @@ module internal HttpClientGenerator = let shouldAllowAnyStatusCode (attrs : SynAttribute list) : bool = attrs |> List.exists (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "AllowAnyStatusCode" | "AllowAnyStatusCodeAttribute" | "RestEase.AllowAnyStatusCode" @@ -225,25 +225,15 @@ module internal HttpClientGenerator = | None -> failwith $"expected an optional cancellation token as final arg in %s{info.Identifier.idText}" | Some (arg, _) -> arg - let argPats = - let args = args |> List.map snd - - SynPat.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) - |> SynPat.CreateParen - |> List.singleton - |> SynArgPats.Pats - let headPat = let thisIdent = if variableHeaders.IsEmpty then "_" else "this" - SynPat.LongIdent ( - SynLongIdent.create [ Ident.create thisIdent ; info.Identifier ], - None, - None, - argPats, - None, - range0 - ) + args + |> List.map snd + |> SynPat.tuple + |> List.singleton + |> SynArgPats.Pats + |> SynPat.identWithArgs [ Ident.create thisIdent ; info.Identifier ] let requestUriTrailer = (info.UrlTemplate, info.Args) @@ -265,10 +255,10 @@ module internal HttpClientGenerator = template |> SynExpr.callMethodArg "Replace" - (SynExpr.CreateParenedTuple + (SynExpr.tuple [ SynExpr.CreateConst ("{" + substituteId + "}") - SynExpr.callMethod "ToString" (SynExpr.CreateIdent varName) + SynExpr.callMethod "ToString" (SynExpr.createIdent' varName) |> SynExpr.pipeThroughFunction ( SynExpr.createLongIdent [ "System" ; "Web" ; "HttpUtility" ; "UrlEncode" ] ) @@ -357,45 +347,37 @@ module internal HttpClientGenerator = let baseAddress = [ - SynMatchClause.Create ( - SynPat.CreateNull, - None, - match info.BaseAddress with - | None -> - [ - SynExpr.applyFunction (SynExpr.createIdent "nameof") (SynExpr.paren baseAddress) - SynExpr.CreateConst - "No base address was supplied on the type, and no BaseAddress was on the HttpClient." - ] - |> SynExpr.CreateParenedTuple - |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ]) - |> SynExpr.paren - |> SynExpr.applyFunction (SynExpr.createIdent "raise") - | Some expr -> SynExpr.applyFunction uriIdent expr - ) - SynMatchClause.Create (SynPat.named "v", None, SynExpr.createIdent "v") + SynMatchClause.create + SynPat.createNull + (match info.BaseAddress with + | None -> + [ + SynExpr.applyFunction (SynExpr.createIdent "nameof") (SynExpr.paren baseAddress) + SynExpr.CreateConst + "No base address was supplied on the type, and no BaseAddress was on the HttpClient." + ] + |> SynExpr.tuple + |> SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "ArgumentNullException" ]) + |> SynExpr.paren + |> SynExpr.applyFunction (SynExpr.createIdent "raise") + | Some expr -> SynExpr.applyFunction uriIdent expr) + SynMatchClause.create (SynPat.named "v") (SynExpr.createIdent "v") ] |> SynExpr.createMatch baseAddress |> SynExpr.paren - SynExpr.App ( - ExprAtomicFlag.Atomic, - false, - uriIdent, - SynExpr.CreateParenedTuple - [ - baseAddress - SynExpr.CreateApp ( - uriIdent, - SynExpr.CreateParenedTuple - [ - requestUriTrailer - SynExpr.createLongIdent [ "System" ; "UriKind" ; "Relative" ] - ] - ) - ], - range0 - ) + [ + baseAddress + SynExpr.applyFunction + uriIdent + (SynExpr.tuple + [ + requestUriTrailer + SynExpr.createLongIdent [ "System" ; "UriKind" ; "Relative" ] + ]) + ] + |> SynExpr.tuple + |> SynExpr.applyFunction uriIdent let bodyParams = info.Args @@ -434,7 +416,7 @@ module internal HttpClientGenerator = [ "System" ; "Net" ; "Http" ; "HttpMethod" ; httpMethodString info.HttpMethod ]) SynExpr.equals (SynExpr.createIdent "RequestUri") (SynExpr.createIdent "uri") ] - |> SynExpr.CreateTuple + |> SynExpr.tupleNoParen let returnExpr = match info.TaskReturnType with @@ -559,7 +541,7 @@ module internal HttpClientGenerator = SynExpr.applyFunction (SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ; "ParseAsync" ]) - (SynExpr.CreateParenedTuple + (SynExpr.tuple [ SynExpr.createIdent "responseStream" SynExpr.equals (SynExpr.createIdent "cancellationToken") (SynExpr.createIdent "ct") @@ -574,10 +556,10 @@ module internal HttpClientGenerator = headerName SynExpr.applyFunction (SynExpr.createLongIdent' - [ Ident.Create "this" ; callToGetValue ; Ident.Create "ToString" ]) + [ Ident.create "this" ; callToGetValue ; Ident.create "ToString" ]) (SynExpr.CreateConst ()) ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ]) |> Do ) @@ -587,7 +569,7 @@ module internal HttpClientGenerator = |> List.map (fun (headerName, headerValue) -> SynExpr.applyFunction (SynExpr.createLongIdent [ "httpMessage" ; "Headers" ; "Add" ]) - (SynExpr.CreateParenedTuple [ headerName ; headerValue ]) + (SynExpr.tuple [ headerName ; headerValue ]) |> Do ) @@ -613,8 +595,7 @@ module internal HttpClientGenerator = SynExpr.awaitTask ( SynExpr.applyFunction (SynExpr.createLongIdent [ "client" ; "SendAsync" ]) - (SynExpr.CreateParenedTuple - [ SynExpr.createIdent "httpMessage" ; SynExpr.createIdent "ct" ]) + (SynExpr.tuple [ SynExpr.createIdent "httpMessage" ; SynExpr.createIdent "ct" ]) ) ) if info.EnsureSuccessHttpCode then @@ -638,7 +619,7 @@ module internal HttpClientGenerator = yield jsonNode ] |> SynExpr.createCompExpr "async" returnExpr - |> SynExpr.startAsTask (SynLongIdent.createI cancellationTokenArg) + |> SynExpr.startAsTask cancellationTokenArg SynBinding.SynBinding ( None, @@ -661,7 +642,7 @@ module internal HttpClientGenerator = let getHttpAttributes (attrs : SynAttribute list) : HttpAttribute list = attrs |> List.choose (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "RestEase.Query" | "RestEase.QueryAttribute" | "WoofWare.Myriad.Plugins.RestEase.Query" @@ -702,7 +683,7 @@ module internal HttpClientGenerator = let extractBasePath (attrs : SynAttribute list) : SynExpr option = attrs |> List.tryPick (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "BasePath" | "RestEase.BasePath" | "WoofWare.Myriad.Plugins.RestEase.BasePath" @@ -715,7 +696,7 @@ module internal HttpClientGenerator = let extractBaseAddress (attrs : SynAttribute list) : SynExpr option = attrs |> List.tryPick (fun attr -> - match attr.TypeName.AsString with + match SynLongIdent.toString attr.TypeName with | "BaseAddress" | "RestEase.BaseAddress" | "WoofWare.Myriad.Plugins.RestEase.BaseAddress" @@ -947,7 +928,7 @@ module internal HttpClientGenerator = let createFunc = if spec.ExtensionMethods then let binding = - SynBinding.basic (SynLongIdent.createS "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl + SynBinding.basic [ Ident.create "make" ] (headerArgs @ [ clientCreationArg ]) interfaceImpl |> SynBinding.withXmlDoc xmlDoc |> SynBinding.withReturnAnnotation returnInfo |> SynMemberDefn.staticMember @@ -964,7 +945,7 @@ module internal HttpClientGenerator = SynModuleDecl.Types ([ containingType ], range0) else - SynBinding.basic (SynLongIdent.createS "make") (headerArgs @ [ clientCreationArg ]) interfaceImpl + SynBinding.basic [ Ident.create "make" ] (headerArgs @ [ clientCreationArg ]) interfaceImpl |> SynBinding.withXmlDoc xmlDoc |> SynBinding.withReturnAnnotation returnInfo |> List.singleton @@ -980,10 +961,7 @@ module internal HttpClientGenerator = if spec.ExtensionMethods then [ SynAttribute.autoOpen ] else - [ - SynAttribute.compilationRepresentation - SynAttribute.RequireQualifiedAccess () - ] + [ SynAttribute.compilationRepresentation ; SynAttribute.requireQualifiedAccess ] let modInfo = SynComponentInfo.create moduleName diff --git a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs index 24d0c7b..afe7d16 100644 --- a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs +++ b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs @@ -49,13 +49,13 @@ module internal InterfaceMockGenerator = let failwithFun = SynExpr.createLongIdent [ "System" ; "NotImplementedException" ] |> SynExpr.applyTo (SynExpr.CreateConst "Unimplemented mock function") - |> SynExpr.CreateParen + |> SynExpr.paren |> SynExpr.applyFunction (SynExpr.createIdent "raise") |> SynExpr.createLambda "_" let constructorReturnType = match interfaceType.Generics with - | None -> SynType.CreateLongIdent name + | None -> SynType.createLongIdent' [ name ] | Some generics -> let generics = @@ -67,7 +67,7 @@ module internal InterfaceMockGenerator = let constructorFields = let extras = if inherits.Contains KnownInheritance.IDisposable then - let unitFun = SynExpr.createLambda "_" SynExpr.CreateUnit + let unitFun = SynExpr.createThunk (SynExpr.CreateConst ()) [ (SynLongIdent.createS "Dispose", true), Some unitFun ] else @@ -81,14 +81,14 @@ module internal InterfaceMockGenerator = let constructor = SynBinding.basic - (SynLongIdent.createS "Empty") + [ Ident.create "Empty" ] (if interfaceType.Generics.IsNone then [] else - [ SynPat.CreateConst SynConst.Unit ]) + [ SynPat.unit ]) (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 |> fun m -> SynMemberDefn.Member (m, range0) @@ -97,9 +97,9 @@ module internal InterfaceMockGenerator = if inherits.Contains KnownInheritance.IDisposable then [ SynField.Create ( - SynType.CreateFun (SynType.CreateUnit, SynType.CreateUnit), - Ident.Create "Dispose", - xmldoc = PreXmlDoc.Create " Implementation of IDisposable.Dispose" + SynType.funFromDomain SynType.unit SynType.unit, + Ident.create "Dispose", + xmldoc = PreXmlDoc.create "Implementation of IDisposable.Dispose" ) ] else @@ -159,22 +159,20 @@ module internal InterfaceMockGenerator = tupledArgs.Args |> List.mapi (fun j ty -> match ty.Type with - | UnitType -> SynPat.Const (SynConst.Unit, range0) - | _ -> SynPat.CreateNamed (Ident.Create $"arg_%i{i}_%i{j}") + | UnitType -> SynPat.unit + | _ -> SynPat.named $"arg_%i{i}_%i{j}" ) match args with | [] -> failwith "somehow got no args at all" | [ arg ] -> arg - | args -> - 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 + | args -> SynPat.tuple args + |> fun i -> if tupledArgs.HasParen then SynPat.paren i else i ) let headPat = SynPat.LongIdent ( - SynLongIdent.create [ Ident.Create "this" ; memberInfo.Identifier ], + SynLongIdent.create [ Ident.create "this" ; memberInfo.Identifier ], None, None, SynArgPats.Pats headArgs, @@ -192,7 +190,7 @@ module internal InterfaceMockGenerator = | UnitType -> SynExpr.CreateConst () | _ -> SynExpr.createIdent $"arg_%i{i}_%i{j}" ) - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple ) match tuples |> List.rev with @@ -200,9 +198,9 @@ module internal InterfaceMockGenerator = | last :: rest -> (last, rest) - ||> List.fold (fun trail next -> SynExpr.CreateApp (next, trail)) + ||> List.fold SynExpr.applyTo |> SynExpr.applyFunction ( - SynExpr.createLongIdent' [ Ident.Create "this" ; memberInfo.Identifier ] + SynExpr.createLongIdent' [ Ident.create "this" ; memberInfo.Identifier ] ) SynMemberDefn.Member ( @@ -261,17 +259,16 @@ module internal InterfaceMockGenerator = match inheritance with | KnownInheritance.IDisposable -> let binding = - SynBinding.basic - (SynLongIdent.createS' [ "this" ; "Dispose" ]) - [ SynPat.CreateConst SynConst.Unit ] - (SynExpr.CreateApp (SynExpr.createLongIdent [ "this" ; "Dispose" ], SynExpr.CreateUnit)) - |> SynBinding.withReturnAnnotation (SynType.Unit ()) + SynExpr.createLongIdent [ "this" ; "Dispose" ] + |> SynExpr.applyTo (SynExpr.CreateConst ()) + |> SynBinding.basic [ Ident.create "this" ; Ident.create "Dispose" ] [ SynPat.unit ] + |> SynBinding.withReturnAnnotation SynType.unit |> SynBinding.makeInstanceMember let mem = SynMemberDefn.Member (binding, range0) SynMemberDefn.Interface ( - SynType.CreateLongIdent (SynLongIdent.createS' [ "System" ; "IDisposable" ]), + SynType.createLongIdent' [ "System" ; "IDisposable" ], Some range0, Some [ mem ], range0 @@ -281,7 +278,7 @@ module internal InterfaceMockGenerator = let record = { - Name = Ident.Create name + Name = Ident.create name Fields = fields Members = Some ([ constructor ; interfaceMembers ] @ extraInterfaces) XmlDoc = Some xmlDoc @@ -334,7 +331,7 @@ module internal InterfaceMockGenerator = = let interfaceType = AstHelper.parseInterface interfaceType let fields = interfaceType.Members |> List.map constructMember - let docString = PreXmlDoc.Create " Mock record type for an interface" + let docString = PreXmlDoc.create "Mock record type for an interface" let name = List.last interfaceType.Name diff --git a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs index 2b2352e..048780f 100644 --- a/WoofWare.Myriad.Plugins/JsonParseGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonParseGenerator.fs @@ -4,7 +4,6 @@ open System open System.Text open Fantomas.FCS.Syntax open Fantomas.FCS.SyntaxTrivia -open Fantomas.FCS.Xml open Myriad.Core type internal JsonParseOutputSpec = @@ -42,7 +41,7 @@ module internal JsonParseGenerator = |> SynExpr.applyFunction (SynExpr.createIdent "raise") [ - SynMatchClause.create SynPat.CreateNull raiseExpr + SynMatchClause.create SynPat.createNull raiseExpr SynMatchClause.create (SynPat.named "v") (SynExpr.createIdent "v") ] |> SynExpr.createMatch indexed @@ -104,7 +103,7 @@ module internal JsonParseGenerator = let body = SynExpr.pipeThroughFunction (SynExpr.createIdent "Some") body [ - SynMatchClause.create SynPat.CreateNull (SynExpr.createIdent "None") + SynMatchClause.create SynPat.createNull (SynExpr.createIdent "None") SynMatchClause.create (SynPat.named "v") body ] |> SynExpr.createMatch node @@ -308,14 +307,14 @@ module internal JsonParseGenerator = if spec.ExtensionMethods then let binding = - SynBinding.basic (SynLongIdent.createI functionName) [ arg ] functionBody + SynBinding.basic [ functionName ] [ arg ] functionBody |> SynBinding.withXmlDoc xmlDoc |> SynBinding.withReturnAnnotation returnInfo |> SynMemberDefn.staticMember let componentInfo = SynComponentInfo.createLong typeName - |> SynComponentInfo.withDocString (PreXmlDoc.Create " Extension methods for JSON parsing") + |> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing") let containingType = SynTypeDefnRepr.augmentation () @@ -324,7 +323,7 @@ module internal JsonParseGenerator = SynModuleDecl.Types ([ containingType ], range0) else - SynBinding.basic (SynLongIdent.createI functionName) [ arg ] functionBody + SynBinding.basic [ functionName ] [ arg ] functionBody |> SynBinding.withXmlDoc xmlDoc |> SynBinding.withReturnAnnotation returnInfo |> List.singleton @@ -333,7 +332,10 @@ module internal JsonParseGenerator = let getParseOptions (fieldAttrs : SynAttribute list) = (JsonParseOption.None, fieldAttrs) ||> List.fold (fun options attr -> - if attr.TypeName.AsString.EndsWith ("JsonNumberHandling", StringComparison.Ordinal) then + if + (SynLongIdent.toString attr.TypeName) + .EndsWith ("JsonNumberHandling", StringComparison.Ordinal) + then let qualifiedEnumValue = match SynExpr.stripOptionalParen attr.ArgExpr with | SynExpr.LongIdent (_, SynLongIdent (ident, _, _), _, _) when isJsonNumberHandling ident -> @@ -356,15 +358,15 @@ module internal JsonParseGenerator = options ) - - let createRecordMaker (spec : JsonParseOutputSpec) (typeName : LongIdent) (fields : SynFieldData list) = + let createRecordMaker (spec : JsonParseOutputSpec) (fields : SynFieldData list) = let assignments = fields |> List.mapi (fun i fieldData -> let propertyNameAttr = fieldData.Attrs |> List.tryFind (fun attr -> - attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal) + (SynLongIdent.toString attr.TypeName) + .EndsWith ("JsonPropertyName", StringComparison.Ordinal) ) let options = getParseOptions fieldData.Attrs @@ -384,7 +386,7 @@ module internal JsonParseGenerator = | Some name -> name.ArgExpr createParseRhs options propertyName fieldData.Type - |> SynBinding.basic (SynLongIdent.createS $"arg_%i{i}") [] + |> SynBinding.basic [ Ident.create $"arg_%i{i}" ] [] ) let finalConstruction = @@ -412,13 +414,13 @@ module internal JsonParseGenerator = let options = getParseOptions field.Attrs createParseRhs options propertyName field.Type ) - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent' (typeName @ [ case.Ident ])) |> SynExpr.createLet [ SynExpr.index (SynExpr.CreateConst "data") (SynExpr.createIdent "node") |> assertNotNull (SynExpr.CreateConst "data") - |> SynBinding.basic (SynLongIdent.createS "node") [] + |> SynBinding.basic [ Ident.create "node" ] [] ] match propertyName with @@ -471,7 +473,7 @@ module internal JsonParseGenerator = "v" (SynExpr.callGenericMethod "GetValue" [ Ident.create "string" ] (SynExpr.createIdent "v")) ) - |> SynBinding.basic (SynLongIdent.createS "ty") [] + |> SynBinding.basic [ Ident.create "ty" ] [] ] let createModule (namespaceId : LongIdent) (spec : JsonParseOutputSpec) (typeDefn : SynTypeDefn) = @@ -485,10 +487,7 @@ module internal JsonParseGenerator = if spec.ExtensionMethods then [ SynAttribute.autoOpen ] else - [ - SynAttribute.RequireQualifiedAccess () - SynAttribute.compilationRepresentation - ] + [ SynAttribute.requireQualifiedAccess ; SynAttribute.compilationRepresentation ] let xmlDoc = let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "." @@ -499,8 +498,8 @@ module internal JsonParseGenerator = else "methods" - $" Module containing JSON parsing %s{description} for the %s{fullyQualified} type" - |> PreXmlDoc.Create + $"Module containing JSON parsing %s{description} for the %s{fullyQualified} type" + |> PreXmlDoc.create let moduleName = if spec.ExtensionMethods then @@ -525,20 +524,17 @@ module internal JsonParseGenerator = let decl = match synTypeDefnRepr with | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Record (_accessibility, fields, _range), _) -> - let fields = fields |> List.map SynField.extractWithIdent - createRecordMaker spec ident fields + fields |> List.map SynField.extractWithIdent |> createRecordMaker spec | SynTypeDefnRepr.Simple (SynTypeDefnSimpleRepr.Union (_accessibility, cases, _range), _) -> let optionGet (i : Ident option) = match i with | None -> failwith "WoofWare.Myriad requires union cases to have identifiers on each field." | Some i -> i - let cases = - cases - |> List.map SynUnionCase.extract - |> List.map (UnionCase.mapIdentFields optionGet) - - createUnionMaker spec ident cases + cases + |> List.map SynUnionCase.extract + |> List.map (UnionCase.mapIdentFields optionGet) + |> createUnionMaker spec ident | _ -> failwithf "Not a record or union type" let mdl = diff --git a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs index 07d42cf..189cdcd 100644 --- a/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs +++ b/WoofWare.Myriad.Plugins/JsonSerializeGenerator.fs @@ -3,8 +3,6 @@ namespace WoofWare.Myriad.Plugins open System open System.Text open Fantomas.FCS.Syntax -open Fantomas.FCS.SyntaxTrivia -open Fantomas.FCS.Xml open Myriad.Core type internal JsonSerializeOutputSpec = @@ -40,28 +38,23 @@ module internal JsonSerializeGenerator = ) | OptionType ty -> // fun field -> match field with | None -> JsonValue.Create null | Some v -> {serializeNode ty} field - [ - SynMatchClause.Create ( - SynPat.CreateLongIdent (SynLongIdent.createS "None", []), - None, - // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"` - // identically equal to null. We have to work around this later, but we might as well just - // be efficient here and whip up the null directly. - SynExpr.CreateNull - |> SynExpr.upcast' ( - SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ] + let noneClause = + // The absolutely galaxy-brained implementation of JsonValue has `JsonValue.Parse "null"` + // identically equal to null. We have to work around this later, but we might as well just + // be efficient here and whip up the null directly. + SynExpr.createNull () + |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) + |> SynMatchClause.create (SynPat.named "None") - ) + let someClause = + SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field") + |> SynExpr.paren + |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) + |> SynMatchClause.create ( + SynPat.CreateLongIdent (SynLongIdent.createS "Some", [ SynPat.named "field" ]) ) - SynMatchClause.Create ( - SynPat.CreateLongIdent (SynLongIdent.createS "Some", [ SynPat.named "field" ]), - None, - SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "field") - |> SynExpr.paren - |> SynExpr.upcast' (SynType.createLongIdent' [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonNode" ]) - ) - ] + [ noneClause ; someClause ] |> SynExpr.createMatch (SynExpr.createIdent "field") |> SynExpr.createLambda "field" | ArrayType ty @@ -79,18 +72,18 @@ module internal JsonSerializeGenerator = SynPat.named "mem", SynExpr.createIdent "field", SynExpr.applyFunction - (SynExpr.CreateLongIdent (SynLongIdent.createS' [ "arr" ; "Add" ])) - (SynExpr.CreateParen (SynExpr.CreateApp (serializeNode ty, SynExpr.createIdent "mem"))), + (SynExpr.createLongIdent [ "arr" ; "Add" ]) + (SynExpr.paren (SynExpr.applyFunction (serializeNode ty) (SynExpr.createIdent "mem"))), range0 ) SynExpr.createIdent "arr" ] - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynExpr.createLet [ SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonArray" ] |> SynExpr.applyTo (SynExpr.CreateConst ()) - |> SynBinding.basic (SynLongIdent.createS "arr") [] + |> SynBinding.basic [ Ident.create "arr" ] [] ] |> SynExpr.createLambda "field" | IDictionaryType (_keyType, valueType) @@ -108,46 +101,31 @@ module internal JsonSerializeGenerator = DebugPointAtInOrTo.Yes range0, SeqExprOnly.SeqExprOnly false, true, - SynPat.CreateParen ( + SynPat.paren ( SynPat.CreateLongIdent ( SynLongIdent.createS "KeyValue", - [ - SynPat.CreateParen ( - SynPat.Tuple ( - false, - [ - SynPat.CreateNamed (Ident.Create "key") - SynPat.CreateNamed (Ident.Create "value") - ], - [ range0 ], - range0 - ) - ) - ] + [ SynPat.tuple [ SynPat.named "key" ; SynPat.named "value" ] ] ) ), - SynExpr.CreateIdent (Ident.Create "field"), - SynExpr.CreateApp ( - SynExpr.createLongIdent [ "ret" ; "Add" ], - SynExpr.CreateParenedTuple + SynExpr.createIdent "field", + SynExpr.applyFunction + (SynExpr.createLongIdent [ "ret" ; "Add" ]) + (SynExpr.tuple [ - SynExpr.CreateApp ( - SynExpr.createLongIdent [ "key" ; "ToString" ], - SynExpr.CreateConst () - ) - SynExpr.CreateApp (serializeNode valueType, SynExpr.createIdent "value") - ] - ), + SynExpr.createLongIdent [ "key" ; "ToString" ] + |> SynExpr.applyTo (SynExpr.CreateConst ()) + SynExpr.applyFunction (serializeNode valueType) (SynExpr.createIdent "value") + ]), range0 ) SynExpr.createIdent "ret" ] - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynExpr.createLet [ SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] |> SynExpr.applyTo (SynExpr.CreateConst ()) - |> SynBinding.basic (SynLongIdent.createS "ret") [] + |> SynBinding.basic [ Ident.create "ret" ] [] ] |> SynExpr.createLambda "field" | _ -> @@ -157,7 +135,7 @@ module internal JsonSerializeGenerator = | SynType.LongIdent ident -> ident.LongIdent | _ -> failwith $"Unrecognised type: %+A{fieldType}" - SynExpr.createLongIdent' (typeName @ [ Ident.Create "toJsonNode" ]) + SynExpr.createLongIdent' (typeName @ [ Ident.create "toJsonNode" ]) /// propertyName is probably a string literal, but it could be a [] variable /// `node.Add ({propertyName}, {toJsonNode})` @@ -168,13 +146,16 @@ module internal JsonSerializeGenerator = (serializeNode fieldType) (SynExpr.createLongIdent' [ Ident.create "input" ; fieldId ]) ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) let getPropertyName (fieldId : Ident) (attrs : SynAttribute list) : SynExpr = let propertyNameAttr = attrs - |> List.tryFind (fun attr -> attr.TypeName.AsString.EndsWith ("JsonPropertyName", StringComparison.Ordinal)) + |> List.tryFind (fun attr -> + (SynLongIdent.toString attr.TypeName) + .EndsWith ("JsonPropertyName", StringComparison.Ordinal) + ) match propertyNameAttr with | None -> @@ -213,12 +194,12 @@ module internal JsonSerializeGenerator = populateNode SynExpr.Upcast (SynExpr.createIdent "node", SynType.Anon range0, range0) ] - |> SynExpr.CreateSequential + |> SynExpr.sequential |> SynExpr.createLet [ SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonObject" ] |> SynExpr.applyTo (SynExpr.CreateConst ()) - |> SynBinding.basic (SynLongIdent.createS "node") [] + |> SynBinding.basic [ Ident.create "node" ] [] ] let pattern = @@ -228,11 +209,11 @@ module internal JsonSerializeGenerator = if spec.ExtensionMethods then let componentInfo = SynComponentInfo.createLong typeName - |> SynComponentInfo.withDocString (PreXmlDoc.Create " Extension methods for JSON parsing") + |> SynComponentInfo.withDocString (PreXmlDoc.create "Extension methods for JSON parsing") let memberDef = assignments - |> SynBinding.basic (SynLongIdent.createI functionName) [ pattern ] + |> SynBinding.basic [ functionName ] [ pattern ] |> SynBinding.withXmlDoc xmlDoc |> SynBinding.withReturnAnnotation returnInfo |> SynMemberDefn.staticMember @@ -246,7 +227,7 @@ module internal JsonSerializeGenerator = else let binding = assignments - |> SynBinding.basic (SynLongIdent.createI functionName) [ pattern ] + |> SynBinding.basic [ functionName ] [ pattern ] |> SynBinding.withReturnAnnotation returnInfo |> SynBinding.withXmlDoc xmlDoc @@ -261,7 +242,7 @@ module internal JsonSerializeGenerator = let propertyName = getPropertyName fieldData.Ident fieldData.Attrs createSerializeRhsRecord propertyName fieldData.Ident fieldData.Type ) - |> SynExpr.CreateSequential + |> SynExpr.sequential |> fun expr -> SynExpr.Do (expr, range0) |> scaffolding spec typeName inputArg @@ -294,7 +275,7 @@ module internal JsonSerializeGenerator = (SynExpr.createLongIdent [ "System" ; "Text" ; "Json" ; "Nodes" ; "JsonValue" ; "Create" ]) propertyName ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) let dataNode = @@ -316,17 +297,17 @@ module internal JsonSerializeGenerator = SynExpr.applyFunction (serializeNode fieldData.Type) (SynExpr.createIdent' caseName) [ propertyName ; node ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "dataNode" ; "Add" ]) ) let assignToNode = [ SynExpr.CreateConst "data" ; SynExpr.createIdent "dataNode" ] - |> SynExpr.CreateParenedTuple + |> SynExpr.tuple |> SynExpr.applyFunction (SynExpr.createLongIdent [ "node" ; "Add" ]) let dataNode = - SynExpr.CreateSequential (dataBindings @ [ assignToNode ]) + SynExpr.sequential (dataBindings @ [ assignToNode ]) |> SynExpr.createLet [ dataNode ] let action = @@ -335,7 +316,7 @@ module internal JsonSerializeGenerator = if not dataBindings.IsEmpty then yield dataNode ] - |> SynExpr.CreateSequential + |> SynExpr.sequential SynMatchClause.create pattern action ) @@ -358,10 +339,7 @@ module internal JsonSerializeGenerator = if spec.ExtensionMethods then [ SynAttribute.autoOpen ] else - [ - SynAttribute.RequireQualifiedAccess () - SynAttribute.compilationRepresentation - ] + [ SynAttribute.requireQualifiedAccess ; SynAttribute.compilationRepresentation ] let xmlDoc = let fullyQualified = ident |> Seq.map (fun i -> i.idText) |> String.concat "." diff --git a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs index 623e3ac..ed8f428 100644 --- a/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs +++ b/WoofWare.Myriad.Plugins/RemoveOptionsGenerator.fs @@ -1,9 +1,7 @@ namespace WoofWare.Myriad.Plugins open Fantomas.FCS.Syntax -open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.Xml -open Myriad.Core [] module internal RemoveOptionsGenerator = @@ -83,26 +81,15 @@ module internal RemoveOptionsGenerator = let body = match fieldData.Type with | OptionType _ -> - SynExpr.applyFunction - (SynExpr.CreateAppInfix ( - SynExpr.LongIdent ( - false, - SynLongIdent.SynLongIdent ( - [ Ident.Create "op_PipeRight" ], - [], - [ Some (IdentTrivia.OriginalNotation "|>") ] - ), - None, - range0 - ), - accessor - )) - (SynExpr.applyFunction + accessor + |> SynExpr.pipeThroughFunction ( + SynExpr.applyFunction (SynExpr.createLongIdent [ "Option" ; "defaultWith" ]) (SynExpr.createLongIdent' ( withoutOptionsType @ [ Ident.create (sprintf "Default%s" fieldData.Ident.idText) ] - ))) + )) + ) | _ -> accessor (SynLongIdent.createI fieldData.Ident, true), Some body @@ -111,7 +98,7 @@ module internal RemoveOptionsGenerator = let binding = SynBinding.basic - (SynLongIdent.createI functionName) + [ functionName ] [ SynPat.named inputArg.idText |> SynPat.annotateType (SynType.LongIdent (SynLongIdent.create withoutOptionsType)) @@ -150,13 +137,15 @@ module internal RemoveOptionsGenerator = SynComponentInfo.createLong recordId |> SynComponentInfo.withDocString xmlDoc |> SynComponentInfo.addAttributes [ SynAttribute.compilationRepresentation ] - |> SynComponentInfo.addAttributes [ SynAttribute.RequireQualifiedAccess () ] + |> SynComponentInfo.addAttributes [ SynAttribute.requireQualifiedAccess ] let mdl = SynModuleDecl.CreateNestedModule (info, decls) SynModuleOrNamespace.CreateNamespace (namespaceId, decls = [ mdl ]) | _ -> failwithf "Not a record type" +open Myriad.Core + /// Myriad generator that stamps out a record with option types stripped /// from the fields at the top level. [] diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs b/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs index d54b492..950074f 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs @@ -1,7 +1,6 @@ namespace WoofWare.Myriad.Plugins open Fantomas.FCS.Syntax -open Fantomas.FCS.Text.Range [] module internal SynArgPats = @@ -11,8 +10,7 @@ module internal SynArgPats = else caseNames - |> List.map (fun ident -> SynPat.Named (SynIdent.SynIdent (ident, None), false, None, range0)) - |> fun ps -> SynPat.Tuple (false, ps, List.replicate (ps.Length - 1) range0, range0) - |> fun p -> SynPat.Paren (p, range0) + |> List.map (fun i -> SynPat.named i.idText) + |> SynPat.tuple |> List.singleton |> SynArgPats.Pats diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs b/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs index 8303275..2b4784a 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs @@ -2,7 +2,6 @@ namespace WoofWare.Myriad.Plugins open Fantomas.FCS.Syntax open Fantomas.FCS.Text.Range -open Myriad.Core [] module internal SynAttribute = @@ -10,12 +9,18 @@ module internal SynAttribute = { TypeName = SynLongIdent.createS "CompilationRepresentation" ArgExpr = - SynExpr.CreateLongIdent ( - false, - SynLongIdent.createS' [ "CompilationRepresentationFlags" ; "ModuleSuffix" ], - None - ) - |> SynExpr.CreateParen + [ "CompilationRepresentationFlags" ; "ModuleSuffix" ] + |> SynExpr.createLongIdent + |> SynExpr.paren + Target = None + AppliesToGetterAndSetter = false + Range = range0 + } + + let internal requireQualifiedAccess : SynAttribute = + { + TypeName = SynLongIdent.createS "RequireQualifiedAccess" + ArgExpr = SynExpr.CreateConst () Target = None AppliesToGetterAndSetter = false Range = range0 @@ -24,7 +29,7 @@ module internal SynAttribute = let internal autoOpen : SynAttribute = { TypeName = SynLongIdent.createS "AutoOpen" - ArgExpr = SynExpr.CreateConst SynConst.Unit + ArgExpr = SynExpr.CreateConst () Target = None AppliesToGetterAndSetter = false Range = range0 diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs b/WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs index ad25a2a..2a9f771 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynBinding.fs @@ -36,7 +36,7 @@ module internal SynBinding = SynLeadingKeyword.Let range0 } - let basic (name : SynLongIdent) (args : SynPat list) (body : SynExpr) : SynBinding = + let basic (name : LongIdent) (args : SynPat list) (body : SynExpr) : SynBinding = let valInfo : SynValInfo = args |> List.map (fun pat -> [ SynArgInfo.SynArgInfo (SynAttributes.Empty, false, getName pat) ]) @@ -50,7 +50,7 @@ module internal SynBinding = [], PreXmlDoc.Empty, SynValData.SynValData (None, valInfo, None), - SynPat.LongIdent (name, None, None, SynArgPats.Pats args, None, range0), + SynPat.identWithArgs name (SynArgPats.Pats args), None, body, range0, diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs index 5452bd7..e631d98 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynExpr.fs @@ -23,20 +23,11 @@ module internal SynExpr = let applyFunction (f : SynExpr) (x : SynExpr) : SynExpr = SynExpr.CreateApp (f, x) /// {f} {x} - let applyTo (x : SynExpr) (f : SynExpr) : SynExpr = SynExpr.CreateApp (f, x) + let inline applyTo (x : SynExpr) (f : SynExpr) : SynExpr = applyFunction f x /// {expr} |> {func} let pipeThroughFunction (func : SynExpr) (expr : SynExpr) : SynExpr = - SynExpr.CreateAppInfix ( - SynExpr.CreateLongIdent ( - SynLongIdent.SynLongIdent ( - [ Ident.Create "op_PipeRight" ], - [], - [ Some (IdentTrivia.OriginalNotation "|>") ] - ) - ), - expr - ) + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.pipe, expr) |> applyTo func /// if {cond} then {trueBranch} else {falseBranch} @@ -80,17 +71,7 @@ module internal SynExpr = /// {a} = {b} let equals (a : SynExpr) (b : SynExpr) = - SynExpr.CreateAppInfix ( - SynExpr.CreateLongIdent ( - SynLongIdent.SynLongIdent ( - Ident.CreateLong "op_Equality", - [], - [ Some (IdentTrivia.OriginalNotation "=") ] - ) - ), - a - ) - |> applyTo b + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.eq, a) |> applyTo b /// {a} + {b} let plus (a : SynExpr) (b : SynExpr) = @@ -116,7 +97,7 @@ module internal SynExpr = SynExpr.DotGet ( obj, range0, - SynLongIdent.SynLongIdent (id = [ Ident.Create meth ], dotRanges = [], trivia = [ None ]), + SynLongIdent.SynLongIdent (id = [ Ident.create meth ], dotRanges = [], trivia = [ None ]), range0 ) |> applyTo arg @@ -142,7 +123,7 @@ module internal SynExpr = SynExpr.TypeApp ( SynExpr.DotGet (obj, range0, SynLongIdent.createS meth, range0), range0, - [ SynType.CreateLongIdent ty ], + [ SynType.createLongIdent' [ ty ] ], [], Some range0, range0, @@ -150,9 +131,12 @@ module internal SynExpr = ) |> applyTo (SynExpr.CreateConst ()) - let index (property : SynExpr) (obj : SynExpr) : SynExpr = + let inline index (property : SynExpr) (obj : SynExpr) : SynExpr = SynExpr.DotIndexedGet (obj, property, range0, range0) + let inline paren (e : SynExpr) : SynExpr = + SynExpr.Paren (e, range0, Some range0, range0) + /// (fun {varName} -> {body}) let createLambda (varName : string) (body : SynExpr) : SynExpr = let parsedDataPat = [ SynPat.named varName ] @@ -168,59 +152,68 @@ module internal SynExpr = ArrowRange = Some range0 } ) - |> SynExpr.CreateParen + |> paren let createThunk (body : SynExpr) : SynExpr = - let parsedDataPat = [ SynPat.Const (SynConst.Unit, range0) ] - SynExpr.Lambda ( false, false, SynSimplePats.Create [], body, - Some (parsedDataPat, body), + Some ([ SynPat.unit ], body), range0, { ArrowRange = Some range0 } ) - |> SynExpr.CreateParen - - /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct) - let startAsTask (ct : SynLongIdent) (body : SynExpr) = - let lambda = - [ - SynExpr.CreateLongIdent (SynLongIdent.createS "a") - equals - (SynExpr.LongIdent (true, SynLongIdent.createS "cancellationToken", None, range0)) - (SynExpr.CreateLongIdent ct) - ] - |> SynExpr.CreateParenedTuple - |> applyFunction (SynExpr.CreateLongIdent (SynLongIdent.createS' [ "Async" ; "StartAsTask" ])) - |> createLambda "a" - - pipeThroughFunction lambda body + |> paren let inline createIdent (s : string) : SynExpr = SynExpr.Ident (Ident (s, range0)) let inline createIdent' (i : Ident) : SynExpr = SynExpr.Ident i - let inline createLongIdent (ident : string list) : SynExpr = - SynExpr.CreateLongIdent (SynLongIdent.createS' ident) - let inline createLongIdent' (ident : Ident list) : SynExpr = - SynExpr.CreateLongIdent (SynLongIdent.create ident) + SynExpr.LongIdent (false, SynLongIdent.create ident, None, range0) + + let inline createLongIdent (ident : string list) : SynExpr = + createLongIdent' (ident |> List.map Ident.create) + + let tupleNoParen (args : SynExpr list) : SynExpr = + SynExpr.Tuple (false, args, List.replicate (args.Length - 1) range0, range0) + + let inline tuple (args : SynExpr list) = args |> tupleNoParen |> paren + + /// {body} |> fun a -> Async.StartAsTask (a, ?cancellationToken=ct) + let startAsTask (ct : Ident) (body : SynExpr) = + let lambda = + [ + createIdent "a" + equals + (SynExpr.LongIdent (true, SynLongIdent.createS "cancellationToken", None, range0)) + (createIdent' ct) + ] + |> tuple + |> applyFunction (createLongIdent [ "Async" ; "StartAsTask" ]) + |> createLambda "a" + + pipeThroughFunction lambda body let inline createLet (bindings : SynBinding list) (body : SynExpr) : SynExpr = SynExpr.LetOrUse (false, false, bindings, body, range0, SynExprLetOrUseTrivia.empty) let inline createMatch (matchOn : SynExpr) (cases : SynMatchClause list) : SynExpr = - SynExpr.CreateMatch (matchOn, cases) + SynExpr.Match ( + DebugPointAtBinding.Yes range0, + matchOn, + cases, + range0, + { + MatchKeyword = range0 + WithKeyword = range0 + } + ) - let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.CreateTyped (expr, ty) - - let inline paren (e : SynExpr) : SynExpr = - SynExpr.Paren (e, range0, Some range0, range0) + let typeAnnotate (ty : SynType) (expr : SynExpr) : SynExpr = SynExpr.Typed (expr, ty, range0) let inline createNew (ty : SynType) (args : SynExpr) : SynExpr = SynExpr.New (false, ty, paren args, range0) @@ -228,8 +221,14 @@ module internal SynExpr = let inline createWhile (cond : SynExpr) (body : SynExpr) : SynExpr = SynExpr.While (DebugPointAtWhile.Yes range0, cond, body, range0) + let inline createNull () : SynExpr = SynExpr.Null range0 + let reraise : SynExpr = createIdent "reraise" |> applyTo (SynExpr.CreateConst ()) + let sequential (exprs : SynExpr list) : SynExpr = + exprs + |> List.reduce (fun a b -> SynExpr.Sequential (DebugPointAtSequential.SuppressNeither, false, a, b, range0)) + /// {compExpr} { {lets} ; return {ret} } let createCompExpr (compExpr : string) (retBody : SynExpr) (lets : CompExprBinding list) : SynExpr = let retStatement = SynExpr.YieldOrReturn ((false, true), retBody, range0) @@ -252,25 +251,22 @@ module internal SynExpr = EqualsRange = Some range0 } ) - | Let (lhs, rhs) -> createLet [ SynBinding.basic (SynLongIdent.createS lhs) [] rhs ] state + | Let (lhs, rhs) -> createLet [ SynBinding.basic [ Ident.create lhs ] [] rhs ] state | Use (lhs, rhs) -> SynExpr.LetOrUse ( false, true, - [ SynBinding.basic (SynLongIdent.createS lhs) [] rhs ], + [ SynBinding.basic [ Ident.create lhs ] [] rhs ], state, range0, { SynExprLetOrUseTrivia.InKeyword = None } ) - | Do body -> SynExpr.CreateSequential [ SynExpr.Do (body, range0) ; state ] + | Do body -> sequential [ SynExpr.Do (body, range0) ; state ] ) - SynExpr.CreateApp ( - SynExpr.CreateIdent (Ident.Create compExpr), - SynExpr.ComputationExpr (false, contents, range0) - ) + applyFunction (createIdent compExpr) (SynExpr.ComputationExpr (false, contents, range0)) /// {expr} |> Async.AwaitTask let awaitTask (expr : SynExpr) : SynExpr = @@ -288,49 +284,17 @@ module internal SynExpr = /// {ident} - {rhs} let minus (ident : SynLongIdent) (rhs : SynExpr) : SynExpr = - SynExpr.CreateApp ( - SynExpr.CreateAppInfix ( - SynExpr.CreateLongIdent ( - SynLongIdent.SynLongIdent ( - [ Ident.Create "op_Subtraction" ], - [], - [ Some (IdentTrivia.OriginalNotation "-") ] - ) - ), - SynExpr.CreateLongIdent ident - ), - rhs - ) + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.sub, SynExpr.CreateLongIdent ident) + |> applyTo rhs /// {ident} - {n} let minusN (ident : SynLongIdent) (n : int) : SynExpr = minus ident (SynExpr.CreateConst n) /// {y} > {x} let greaterThan (x : SynExpr) (y : SynExpr) : SynExpr = - SynExpr.CreateApp ( - SynExpr.CreateAppInfix ( - SynExpr.CreateLongIdent ( - SynLongIdent.SynLongIdent ( - [ Ident.Create "op_GreaterThan" ], - [], - [ Some (IdentTrivia.OriginalNotation ">") ] - ) - ), - y - ), - x - ) + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.ge, y) |> applyTo x /// {y} >= {x} let greaterThanOrEqual (x : SynExpr) (y : SynExpr) : SynExpr = - SynExpr.CreateAppInfix ( - SynExpr.CreateLongIdent ( - SynLongIdent.SynLongIdent ( - [ Ident.Create "op_GreaterThanOrEqual" ], - [], - [ Some (IdentTrivia.OriginalNotation ">=") ] - ) - ), - y - ) + SynExpr.CreateAppInfix (SynExpr.CreateLongIdent SynLongIdent.geq, y) |> applyTo x diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs index c5dee09..23ecb0d 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynLongIdent.fs @@ -1,11 +1,34 @@ namespace WoofWare.Myriad.Plugins +open Fantomas.FCS.SyntaxTrivia open Fantomas.FCS.Text.Range open Fantomas.FCS.Syntax [] module internal SynLongIdent = + let geq = + SynLongIdent.SynLongIdent ( + [ Ident.create "op_GreaterThanOrEqual" ], + [], + [ Some (IdentTrivia.OriginalNotation ">=") ] + ) + + let ge = + SynLongIdent.SynLongIdent ([ Ident.create "op_GreaterThan" ], [], [ Some (IdentTrivia.OriginalNotation ">") ]) + + let sub = + SynLongIdent.SynLongIdent ([ Ident.create "op_Subtraction" ], [], [ Some (IdentTrivia.OriginalNotation "-") ]) + + let eq = + SynLongIdent.SynLongIdent ([ Ident.create "op_Equality" ], [], [ Some (IdentTrivia.OriginalNotation "=") ]) + + let pipe = + SynLongIdent.SynLongIdent ([ Ident.create "op_PipeRight" ], [], [ Some (IdentTrivia.OriginalNotation "|>") ]) + + let toString (sli : SynLongIdent) : string = + sli.LongIdent |> List.map _.idText |> String.concat "." + let create (ident : LongIdent) : SynLongIdent = let commas = match ident with diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynPat.fs b/WoofWare.Myriad.Plugins/SynExpr/SynPat.fs index 894ae70..d1cd2d6 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynPat.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynPat.fs @@ -6,11 +6,28 @@ open Fantomas.FCS.Text.Range [] module internal SynPat = - let annotateType (ty : SynType) (pat : SynPat) = + let inline annotateType (ty : SynType) (pat : SynPat) = SynPat.Paren (SynPat.Typed (pat, ty, range0), range0) - let named (s : string) : SynPat = + let inline named (s : string) : SynPat = SynPat.Named (SynIdent.SynIdent (Ident (s, range0), None), false, None, range0) - let namedI (i : Ident) : SynPat = + let inline namedI (i : Ident) : SynPat = SynPat.Named (SynIdent.SynIdent (i, None), false, None, range0) + + let inline identWithArgs (i : LongIdent) (args : SynArgPats) : SynPat = + SynPat.LongIdent (SynLongIdent.create i, None, None, args, None, range0) + + let inline tupleNoParen (elements : SynPat list) : SynPat = + match elements with + | [] -> failwith "Can't tuple no elements in a pattern" + | [ p ] -> p + | 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 unit = SynPat.Const (SynConst.Unit, range0) + + let createNull = SynPat.Null range0 diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs index c88b424..3c60f4b 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs @@ -44,6 +44,9 @@ module internal SynType = let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0) + let unit : SynType = named "unit" + let int : SynType = named "int" + [] module internal SynTypePatterns = let (|OptionType|_|) (fieldType : SynType) = diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index dd6455e..65041b4 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -30,13 +30,12 @@ + - - @@ -44,6 +43,7 @@ +