From 09b7109c840ff33301884228bcbbb651df8a64f4 Mon Sep 17 00:00:00 2001 From: Patrick Stevens <3138005+Smaug123@users.noreply.github.com> Date: Sat, 14 Sep 2024 23:02:32 +0100 Subject: [PATCH] Extract some utilities from http-client branch (#260) --- WoofWare.Myriad.Plugins/CataGenerator.fs | 3 +- .../InterfaceMockGenerator.fs | 13 ++--- WoofWare.Myriad.Plugins/SynExpr/Ident.fs | 48 ++++++++++++++++ WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs | 7 ++- WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs | 4 +- .../SynExpr/SynAttribute.fs | 31 ++++------- WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs | 10 ++++ .../SynExpr/SynMemberDefn.fs | 10 +++- WoofWare.Myriad.Plugins/SynExpr/SynType.fs | 55 ++++++++++++++++++- .../SynExpr/SynUnionCase.fs | 2 +- .../WoofWare.Myriad.Plugins.fsproj | 1 + 11 files changed, 147 insertions(+), 37 deletions(-) create mode 100644 WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs diff --git a/WoofWare.Myriad.Plugins/CataGenerator.fs b/WoofWare.Myriad.Plugins/CataGenerator.fs index 3d540e1..4039cab 100644 --- a/WoofWare.Myriad.Plugins/CataGenerator.fs +++ b/WoofWare.Myriad.Plugins/CataGenerator.fs @@ -564,11 +564,12 @@ module internal CataGenerator = let domain = field.FieldName |> Option.map Ident.lowerFirstLetter - |> SynType.signatureParamOfType place + |> SynType.signatureParamOfType [] place false acc |> SynType.funFromDomain domain ) |> SynMemberDefn.abstractMember + [] case.CataMethodIdent None arity diff --git a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs index 5075508..a433767 100644 --- a/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs +++ b/WoofWare.Myriad.Plugins/InterfaceMockGenerator.fs @@ -228,14 +228,11 @@ module internal InterfaceMockGenerator = x.Type 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 + tuple.Args + |> List.map buildType + |> SynType.tupleNoParen + |> Option.defaultWith (fun () -> failwith "no-arg functions not supported yet") + |> if tuple.HasParen then SynType.paren else id let constructMember (mem : MemberInfo) : SynField = let inputType = mem.Args |> List.map constructMemberSinglePlace diff --git a/WoofWare.Myriad.Plugins/SynExpr/Ident.fs b/WoofWare.Myriad.Plugins/SynExpr/Ident.fs index bce6ff2..e054b9b 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/Ident.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/Ident.fs @@ -2,6 +2,7 @@ namespace WoofWare.Myriad.Plugins open System open System.Text +open System.Text.RegularExpressions open Fantomas.FCS.Syntax open Fantomas.FCS.Text.Range @@ -9,6 +10,53 @@ open Fantomas.FCS.Text.Range module internal Ident = let inline create (s : string) = Ident (s, range0) + /// Fantomas bug, perhaps? "type" is not rendered as ``type``, although the ASTs are identical + /// apart from the ranges? + /// Awful hack: here is a function that does this sort of thing. + let createSanitisedParamName (s : string) = + match s with + | "type" -> create "type'" + | _ -> + + let result = StringBuilder () + + for i = 0 to s.Length - 1 do + if Char.IsLetter s.[i] then + result.Append s.[i] |> ignore + elif Char.IsNumber s.[i] then + if result.Length > 0 then + result.Append s.[i] |> ignore + elif s.[i] = '_' || s.[i] = '-' then + result.Append '_' |> ignore + else + failwith $"could not convert to ident: %s{s}" + + create (result.ToString ()) + + let private alnum = Regex @"^[a-zA-Z][a-zA-Z0-9]*$" + + let createSanitisedTypeName (s : string) = + let result = StringBuilder () + let mutable capitalize = true + + for i = 0 to s.Length - 1 do + if Char.IsLetter s.[i] then + if capitalize then + result.Append (Char.ToUpperInvariant s.[i]) |> ignore + capitalize <- false + else + result.Append s.[i] |> ignore + elif Char.IsNumber s.[i] then + if result.Length > 0 then + result.Append s.[i] |> ignore + elif s.[i] = '_' then + capitalize <- true + + if result.Length = 0 then + failwith $"String %s{s} was not suitable as a type identifier" + + Ident (result.ToString (), range0) + let lowerFirstLetter (x : Ident) : Ident = let result = StringBuilder x.idText.Length result.Append (Char.ToLowerInvariant x.idText.[0]) |> ignore diff --git a/WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs b/WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs index abb6b11..45fbdc0 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/PreXmlDoc.fs @@ -6,7 +6,12 @@ open Fantomas.FCS.Text.Range [] module internal PreXmlDoc = let create (s : string) : PreXmlDoc = - PreXmlDoc.Create ([| " " + s |], range0) + let s = s.Split "\n" + + for i = 0 to s.Length - 1 do + s.[i] <- " " + s.[i] + + PreXmlDoc.Create (s, range0) let create' (s : string seq) : PreXmlDoc = PreXmlDoc.Create (Array.ofSeq s, range0) diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs b/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs index 35e9f97..1f742c0 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynArgPats.fs @@ -9,12 +9,12 @@ module internal SynArgPats = match caseNames.Length with | 0 -> SynArgPats.Pats [] | 1 -> - SynPat.Named (SynIdent.SynIdent (Ident.create caseNames.[0], None), false, None, range0) + SynPat.Named (SynIdent.createS caseNames.[0], false, None, range0) |> List.singleton |> SynArgPats.Pats | len -> caseNames - |> List.map (fun name -> SynPat.Named (SynIdent.SynIdent (Ident.create name, None), false, None, range0)) + |> List.map (fun name -> SynPat.Named (SynIdent.createS name, false, None, range0)) |> fun t -> SynPat.Tuple (false, t, List.replicate (len - 1) range0, range0) |> fun t -> SynPat.Paren (t, range0) |> List.singleton diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs b/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs index 2b4784a..60d0c2f 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynAttribute.fs @@ -5,32 +5,23 @@ open Fantomas.FCS.Text.Range [] module internal SynAttribute = - let internal compilationRepresentation : SynAttribute = + let inline create (typeName : SynLongIdent) (arg : SynExpr) : SynAttribute = { - TypeName = SynLongIdent.createS "CompilationRepresentation" - ArgExpr = - [ "CompilationRepresentationFlags" ; "ModuleSuffix" ] - |> SynExpr.createLongIdent - |> SynExpr.paren + TypeName = typeName + ArgExpr = arg Target = None AppliesToGetterAndSetter = false Range = range0 } + let internal compilationRepresentation : SynAttribute = + [ "CompilationRepresentationFlags" ; "ModuleSuffix" ] + |> SynExpr.createLongIdent + |> SynExpr.paren + |> create (SynLongIdent.createS "CompilationRepresentation") + let internal requireQualifiedAccess : SynAttribute = - { - TypeName = SynLongIdent.createS "RequireQualifiedAccess" - ArgExpr = SynExpr.CreateConst () - Target = None - AppliesToGetterAndSetter = false - Range = range0 - } + create (SynLongIdent.createS "RequireQualifiedAccess") (SynExpr.CreateConst ()) let internal autoOpen : SynAttribute = - { - TypeName = SynLongIdent.createS "AutoOpen" - ArgExpr = SynExpr.CreateConst () - Target = None - AppliesToGetterAndSetter = false - Range = range0 - } + create (SynLongIdent.createS "AutoOpen") (SynExpr.CreateConst ()) diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs b/WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs new file mode 100644 index 0000000..d1bd0ea --- /dev/null +++ b/WoofWare.Myriad.Plugins/SynExpr/SynIdent.fs @@ -0,0 +1,10 @@ +namespace WoofWare.Myriad.Plugins + +open Fantomas.FCS.Syntax + +[] +module internal SynIdent = + let inline createI (i : Ident) : SynIdent = SynIdent.SynIdent (i, None) + + let inline createS (i : string) : SynIdent = + SynIdent.SynIdent (Ident.create i, None) diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs b/WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs index 6b10344..f7c83c3 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynMemberDefn.fs @@ -17,8 +17,8 @@ module internal SynMemberDefn = SynMemberFlags.MemberKind = SynMemberKind.Member } - let abstractMember + (attrs : SynAttribute list) (ident : SynIdent) (typars : SynTyparDecls option) (arity : SynValInfo) @@ -28,7 +28,13 @@ module internal SynMemberDefn = = let slot = SynValSig.SynValSig ( - [], + attrs + |> List.map (fun attr -> + { + Attributes = [ attr ] + Range = range0 + } + ), ident, SynValTyparDecls.SynValTyparDecls (typars, true), returnType, diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs index 87375f2..8a6689b 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynType.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynType.fs @@ -267,6 +267,8 @@ module internal SynType = | SynType.Paren (ty, _) -> stripOptionalParen ty | ty -> ty + let inline paren (ty : SynType) : SynType = SynType.Paren (ty, range0) + let inline createLongIdent (ident : LongIdent) : SynType = SynType.LongIdent (SynLongIdent.create ident) @@ -283,6 +285,17 @@ module internal SynType = let inline app (name : string) (args : SynType list) : SynType = app' (named name) args + /// Returns None if the input list was empty. + let inline tupleNoParen (ty : SynType list) : SynType option = + match List.rev ty with + | [] -> None + | [ t ] -> Some t + | t :: rest -> + ([ SynTupleTypeSegment.Type t ], rest) + ||> List.fold (fun ty nextArg -> SynTupleTypeSegment.Type nextArg :: SynTupleTypeSegment.Star range0 :: ty) + |> fun segs -> SynType.Tuple (false, segs, range0) + |> Some + let inline appPostfix (name : string) (arg : SynType) : SynType = SynType.App (named name, None, [ arg ], [], None, true, range0) @@ -299,16 +312,54 @@ module internal SynType = } ) - let inline signatureParamOfType (ty : SynType) (name : Ident option) : SynType = - SynType.SignatureParameter ([], false, name, ty, range0) + let inline signatureParamOfType + (attrs : SynAttribute list) + (ty : SynType) + (optional : bool) + (name : Ident option) + : SynType + = + SynType.SignatureParameter ( + attrs + |> List.map (fun attr -> + { + Attributes = [ attr ] + Range = range0 + } + ), + optional, + name, + ty, + range0 + ) let inline var (ty : SynTypar) : SynType = SynType.Var (ty, range0) let unit : SynType = named "unit" + let obj : SynType = named "obj" + let bool : SynType = named "bool" let int : SynType = named "int" + let array (elt : SynType) : SynType = SynType.Array (1, elt, range0) + + let list (elt : SynType) : SynType = + SynType.App (named "list", None, [ elt ], [], None, true, range0) + + let option (elt : SynType) : SynType = + SynType.App (named "option", None, [ elt ], [], None, true, range0) let anon : SynType = SynType.Anon range0 + let task (elt : SynType) : SynType = + SynType.App ( + createLongIdent' [ "System" ; "Threading" ; "Tasks" ; "Task" ], + None, + [ elt ], + [], + None, + true, + range0 + ) + let string : SynType = named "string" /// Given ['a1, 'a2] and 'ret, returns 'a1 -> 'a2 -> 'ret. diff --git a/WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs b/WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs index d265bf1..9bf1dfc 100644 --- a/WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs +++ b/WoofWare.Myriad.Plugins/SynExpr/SynUnionCase.fs @@ -44,7 +44,7 @@ module internal SynUnionCase = SynUnionCase.SynUnionCase ( SynAttributes.ofAttrs case.Attributes, - SynIdent.SynIdent (case.Name, None), + SynIdent.createI case.Name, SynUnionCaseKind.Fields fields, case.XmlDoc |> Option.defaultValue PreXmlDoc.Empty, case.Access, diff --git a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj index 3a9c464..0fccfcd 100644 --- a/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj +++ b/WoofWare.Myriad.Plugins/WoofWare.Myriad.Plugins.fsproj @@ -30,6 +30,7 @@ +