From a637e81593fd9fc18ced56012e5da144f944d4b0 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Fri, 10 May 2024 22:20:25 +0100 Subject: [PATCH 1/4] Update GenerateTests to use Fabulous.AST pre7 --- .gitignore | 1 + tests/GenerateTests.fs | 242 ++++++------------ ...Ionide.LanguageServerProtocol.Tests.fsproj | 2 +- 3 files changed, 75 insertions(+), 170 deletions(-) diff --git a/.gitignore b/.gitignore index 0eefb3e..57d583c 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,4 @@ bin obj release BenchmarkDotNet.Artifacts +.idea diff --git a/tests/GenerateTests.fs b/tests/GenerateTests.fs index b818e7c..bd9cd17 100644 --- a/tests/GenerateTests.fs +++ b/tests/GenerateTests.fs @@ -28,7 +28,6 @@ module rec MetaModel = open System open Newtonsoft.Json.Linq open Newtonsoft.Json - open Newtonsoft.Json.Converters let metaModel = IO.Path.Join(__SOURCE_DIRECTORY__, "..", "data", "3.17.0", "metaModel.json") let metaModelSchema = IO.Path.Join(__SOURCE_DIRECTORY__, "..", "data", "3.17.0", "metaModel.schema.json") @@ -279,7 +278,6 @@ module rec MetaModel = MapKeyType.Base {| Kind = kind; Name = MapKeyNameEnum.Parse name |} | _ -> failwithf "Unknown map key type: %s" kind - type TypeConverter() = inherit JsonConverter() @@ -344,8 +342,6 @@ module rec MetaModel = module GenerateTests = - let rangeZero = FSharp.Compiler.Text.Range.Zero - open System open Expecto open Fantomas.Core @@ -358,37 +354,15 @@ module GenerateTests = open Newtonsoft.Json open Fantomas.Core.SyntaxOak - let createOption (t: Type) = Type.AppPostfix(TypeAppPostFixNode(t, Type.FromString "option", rangeZero)) - - let createGeneric name types = - TypeAppPrefixNode(name, None, SingleTextNode("<", rangeZero), types, SingleTextNode(">", rangeZero), rangeZero) - |> Type.AppPrefix - - let createAnonymousRecord types = - TypeAnonRecordNode(None, Some(SingleTextNode("{|", rangeZero)), types, SingleTextNode("|}", rangeZero), rangeZero) - |> Type.AnonRecord - - let createDictionary types = createGeneric (Type.FromString "System.Collections.Generic.Dictionary") types - - let createTuple (types: Type array) = - let types = - types - |> Array.map (Choice1Of2) - - let asterisk = SingleTextNode("*", rangeZero) + let createOption (t: WidgetBuilder) = AppPostfix(t, (LongIdent "option")) - let types = - types - |> Array.intersperse (Choice2Of2(asterisk)) - |> Array.toList + let createDictionary (types: WidgetBuilder list) = + AppPrefix(LongIdent("System.Collections.Generic.Dictionary"), types) - TypeTupleNode(types, rangeZero) - |> Type.Tuple - - let createErasedUnion (types: Type array) = + let createErasedUnion (types: WidgetBuilder array) = if types.Length > 1 then - let duType = Type.FromString $"U%d{types.Length}" - createGeneric duType (Array.toList types) + let duType = LongIdent $"U%d{types.Length}" + AppPrefix(duType, (Array.toList types)) else types.[0] @@ -403,17 +377,17 @@ module GenerateTests = | None -> s - let rec createField (currentType: MetaModel.Type) (currentProperty: MetaModel.Property) = + let rec createField (currentType: MetaModel.Type) (currentProperty: MetaModel.Property): string * WidgetBuilder = try - let rec getType (currentType: MetaModel.Type) = + let rec getType (currentType: MetaModel.Type): WidgetBuilder = match currentType with | MetaModel.Type.ReferenceType r -> let name = r.Name - Type.FromString name + LongIdent name | MetaModel.Type.BaseType b -> let name = b.Name.ToDotNetType() - Type.FromString name + LongIdent name | MetaModel.Type.OrType o -> @@ -445,63 +419,55 @@ module GenerateTests = else createErasedUnion ts - | MetaModel.Type.ArrayType a -> - - TypeArrayNode(getType a.Element, 1, rangeZero) - |> Type.Array + Array(getType a.Element, 1) | MetaModel.Type.StructureLiteralType l -> if l.Value.Properties |> Array.isEmpty then - Type.FromString "obj" + Obj() else let ts = l.Value.Properties |> Array.map (fun p -> createField p.Type p - |> Tree.compile ) - |> Array.map (fun (t: FieldNode) -> t.Name.Value, t.Type) |> Array.toList - - createAnonymousRecord ts + AnonRecord(ts) | MetaModel.Type.MapType m -> let key = match m.Key with | MetaModel.MapKeyType.Base b -> b.Name.ToDotNetType() - |> Type.FromString + |> LongIdent | MetaModel.MapKeyType.ReferenceType r -> - r.Name - |> Type.FromString + LongIdent(r.Name) let value = getType m.Value - createDictionary [ - key - value - ] + AppPrefix(LongIdent("System.Collections.Generic.Dictionary"), [ key; value ]) - | MetaModel.Type.StringLiteralType t -> Type.FromString "string" + | MetaModel.Type.StringLiteralType t -> + LongIdent("string") | MetaModel.Type.TupleType t -> let ts = t.Items |> Array.map getType + |> Array.toList - createTuple ts + Tuple(ts) - | _ -> failwithf "todo Property %A" currentType + | _ -> failwithf $"todo Property %A{currentType}" let t = getType currentType let t = if currentProperty.IsOptional then createOption t else t - Field(currentProperty.NameAsPascalCase, t) + let name = currentProperty.NameAsPascalCase + name, t with e -> - raise - <| Exception(sprintf "createField on %A " currentProperty, e) + raise <| Exception(sprintf "createField on %A " currentProperty, e) let createSafeStructure (structure: MetaModel.Structure) = @@ -605,7 +571,10 @@ module GenerateTests = try - Record structure.Name { yield! expandFields structure } + Record(structure.Name) { + // expandFields structure + Field("TODO", LongIdent "TODO") + } with e -> raise <| Exception(sprintf "createStructure on %A" structure, e) @@ -613,11 +582,11 @@ module GenerateTests = let createTypeAlias (alias: MetaModel.TypeAlias) = let rec getType (t: MetaModel.Type) = if alias.Name = "LSPAny" then - Type.FromString "obj" + Obj() else match t with - | MetaModel.Type.ReferenceType r -> Type.FromString r.Name - | MetaModel.Type.BaseType b -> Type.FromString(b.Name.ToDotNetType()) + | MetaModel.Type.ReferenceType r -> LongIdent r.Name + | MetaModel.Type.BaseType b -> LongIdent(b.Name.ToDotNetType()) | MetaModel.Type.OrType o -> let ts = o.Items @@ -625,51 +594,45 @@ module GenerateTests = createErasedUnion ts | MetaModel.Type.ArrayType a -> - TypeArrayNode(getType a.Element, 1, rangeZero) - |> Type.Array + Array(getType a.Element, 1) | MetaModel.Type.StructureLiteralType l -> if l.Value.Properties |> Array.isEmpty then - Type.FromString "obj" + Obj() else let ts = l.Value.Properties |> Array.map (fun p -> createField p.Type p - |> Tree.compile ) - |> Array.map (fun (t: FieldNode) -> t.Name.Value, t.Type) |> Array.toList - createAnonymousRecord ts + AnonRecord ts | MetaModel.Type.MapType m -> let key = match m.Key with | MetaModel.MapKeyType.Base b -> b.Name.ToDotNetType() - |> Type.FromString + |> LongIdent | MetaModel.MapKeyType.ReferenceType r -> r.Name - |> Type.FromString + |> LongIdent let value = getType m.Value + AppPrefix(LongIdent("System.Collections.Generic.Dictionary"), [ key; value ]) - createDictionary [ - key - value - ] - - | MetaModel.Type.StringLiteralType t -> Type.FromString "string" + | MetaModel.Type.StringLiteralType t -> String() | MetaModel.Type.TupleType t -> let ts = t.Items |> Array.map getType + |> Array.toList - createTuple ts + Tuple ts | _ -> failwithf "todo Property %A" t @@ -705,105 +668,46 @@ module GenerateTests = let parsedMetaModel = JsonConvert.DeserializeObject(metaModel, MetaModel.metaModelSerializerSettings) - - let createErasedUnionType i = - let unionName = SingleTextNode($"U%d{i}", rangeZero) - - let createAttribute name = - let attributeName = - AttributeNode( - (IdentListNode([ IdentifierOrDot.Ident(SingleTextNode(name, rangeZero)) ], rangeZero)), - None, - None, - rangeZero - ) - - AttributeListNode( - (SingleTextNode("[<", rangeZero)), - [ attributeName ], - (SingleTextNode(">]", rangeZero)), - rangeZero - ) - - let nameNode = - let attributes = MultipleAttributeListNode([ createAttribute "ErasedUnion" ], rangeZero) - - let typeParams = - let decls = [ - for j = 1 to i do - TyparDeclNode(None, (SingleTextNode($"'T{j}", rangeZero)), rangeZero) - ] - - TyparDeclsPostfixListNode( - SingleTextNode("<", rangeZero), - decls, - [], - SingleTextNode(">", rangeZero), - rangeZero - ) - |> TyparDecls.PostfixList - - TypeNameNode( - None, - (Some attributes), - SingleTextNode("type", rangeZero), - None, - IdentListNode([ IdentifierOrDot.Ident(unionName) ], rangeZero), - (Some typeParams), - [], - None, - Some(SingleTextNode("=", rangeZero)), - None, - rangeZero - ) - - let cases = [ - for j = 1 to i do - UnionCaseNode( - None, - None, - (Some(SingleTextNode("|", rangeZero))), - SingleTextNode($"C{j}", rangeZero), - [ FieldNode(None, None, None, false, None, None, Type.FromString $"'T{j}", rangeZero) ], - rangeZero - ) - ] - - TypeDefnUnionNode(nameNode, None, cases, [], rangeZero) - let source = - Namespace("Ionide.LanguageServerProtocol.Types").isRecursive () { - // Simple aliases for types that are not in dotnet - Abbrev("URI", Type.FromString "string") - Abbrev("DocumentUri", Type.FromString "string") - Abbrev("RegExp", Type.FromString "string") - - // Assuming the max is 5, can be increased if needed - for i in [ 2..5 ] do - EscapeHatch(createErasedUnionType i) - - for s in parsedMetaModel.Structures do - if isUnitStructure s then - Abbrev(s.Name, Type.FromString "unit") - else - createStructure s parsedMetaModel - - for t in parsedMetaModel.TypeAliases do - Abbrev(t.Name, createTypeAlias t) - - for e in parsedMetaModel.Enumerations do - createEnumeration e - - } + Ast.Oak() { + Namespace("Ionide.LanguageServerProtocol.Types") { + // Simple aliases for types that are not in dotnet + Abbrev("URI", "string") + Abbrev("DocumentUri", "string") + Abbrev("RegExp", "string") + + // Assuming the max is 5, can be increased if needed + for i in [ 2..5 ] do + Union($"U%d{i}") { + for j = 1 to i do + UnionCase($"C{j}", Field $"'T{j}") + } + |> _.attribute(Attribute "ErasedUnion") + |> _.typeParams([ for j = 1 to i do $"T{j}" ]) + + for s in parsedMetaModel.Structures do + if isUnitStructure s then + Abbrev(s.Name, "unit") + else + createStructure s parsedMetaModel + + for t in parsedMetaModel.TypeAliases do + Abbrev(t.Name, createTypeAlias t) + + for e in parsedMetaModel.Enumerations do + createEnumeration e + + } + |> _.toRecursive() + } let writeToFile path contents = File.WriteAllText(path, contents) - Tree.compile source + source + |> Gen.mkOak |> CodeFormatter.FormatOakAsync |> Async.RunSynchronously |> writeToFile "test.fsx" - - () } ] diff --git a/tests/Ionide.LanguageServerProtocol.Tests.fsproj b/tests/Ionide.LanguageServerProtocol.Tests.fsproj index fbd75bc..a1c8380 100644 --- a/tests/Ionide.LanguageServerProtocol.Tests.fsproj +++ b/tests/Ionide.LanguageServerProtocol.Tests.fsproj @@ -21,7 +21,7 @@ - + runtime; build; native; contentfiles; analyzers; buildtransitive all From 3bfd9e668927d1b67724e69727467e94fc252064 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Thu, 9 May 2024 19:07:50 -0400 Subject: [PATCH 2/4] Cleanup null arrays --- tests/GenerateTests.fs | 97 ++++++++++++++++++++++-------------------- 1 file changed, 50 insertions(+), 47 deletions(-) diff --git a/tests/GenerateTests.fs b/tests/GenerateTests.fs index bd9cd17..b00ca6d 100644 --- a/tests/GenerateTests.fs +++ b/tests/GenerateTests.fs @@ -1,5 +1,16 @@ namespace Ionide.LanguageServerProtocol +module Option = + module Array = + /// Returns true if the given array is empty or None + let isEmpty (x: 'a array option) = + match x with + | None -> true + | Some x -> Array.isEmpty x + + /// Returns empty array if None, otherwise the array + let toArray (x: 'a array option) = Option.defaultValue [||] x + module String = open System @@ -197,10 +208,10 @@ module rec MetaModel = type Structure = { Deprecated: string option Documentation: string option - Extends: Type array - Mixins: Type array + Extends: Type array option + Mixins: Type array option Name: string - Properties: Property array + Properties: Property array option Proposed: bool option Since: string option } @@ -470,69 +481,55 @@ module GenerateTests = raise <| Exception(sprintf "createField on %A " currentProperty, e) - let createSafeStructure (structure: MetaModel.Structure) = - let structure = - if - structure.Extends - |> isNull - then - { structure with Extends = [||] } - else - structure - - let structure = - if - structure.Mixins - |> isNull - then - { structure with Mixins = [||] } - else - structure - - let structure = - if - structure.Properties - |> isNull - then - { structure with Properties = [||] } - else - structure - - structure - let isUnitStructure (structure: MetaModel.Structure) = let isEmptyExtends = structure.Extends - |> isNull - || structure.Extends - |> Array.isEmpty + |> Option.Array.isEmpty let isEmptyMixins = structure.Mixins - |> isNull - || structure.Mixins - |> Array.isEmpty + |> Option.Array.isEmpty let isEmptyProperties = structure.Properties - |> isNull - || structure.Properties - |> Array.isEmpty + |> Option.Array.isEmpty isEmptyExtends && isEmptyMixins && isEmptyProperties + let createInterfaceStructures (structure: MetaModel.Structure array) (model: MetaModel.MetaModel) = + let interfaceStructures = + structure + |> Array.collect (fun s -> + s.Extends + |> Option.Array.toArray + |> Array.map (fun e -> + match e with + | MetaModel.Type.ReferenceType r -> + match + model.Structures + |> Array.tryFind (fun s -> s.Name = r.Name) + with + | Some s -> s + | None -> failwithf "Could not find structure %s" r.Name + | _ -> failwithf "todo Extends %A" e + ) + ) + + () + let createStructure (structure: MetaModel.Structure) (model: MetaModel.MetaModel) = let alreadyAddedKey = ResizeArray() let rec expandFields (structure: MetaModel.Structure) = [ - let structure = createSafeStructure structure // TODO create interfaces from extensions and implement them - for e in structure.Extends do + for e in + structure.Extends + |> Option.Array.toArray do match e with | MetaModel.Type.ReferenceType r -> match @@ -544,7 +541,9 @@ module GenerateTests = | _ -> failwithf "todo Extends %A" e // Mixins are inlined fields - for m in structure.Mixins do + for m in + structure.Mixins + |> Option.Array.toArray do match m with | MetaModel.Type.ReferenceType r -> match @@ -552,7 +551,9 @@ module GenerateTests = |> Array.tryFind (fun s -> s.Name = r.Name) with | Some s -> - for p in s.Properties do + for p in + s.Properties + |> Option.Array.toArray do if alreadyAddedKey.Contains(p.NameAsPascalCase) then () else @@ -561,7 +562,9 @@ module GenerateTests = | None -> failwithf "Could not find structure %s" r.Name | _ -> failwithf "todo Mixins %A" m - for p in structure.Properties do + for p in + structure.Properties + |> Option.Array.toArray do if alreadyAddedKey.Contains(p.NameAsPascalCase) then () else From d852232503a573de98b1b687f6589e7d2ada87d5 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sat, 11 May 2024 07:43:31 -0400 Subject: [PATCH 3/4] fix record field emit --- tests/GenerateTests.fs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/tests/GenerateTests.fs b/tests/GenerateTests.fs index b00ca6d..1d2f901 100644 --- a/tests/GenerateTests.fs +++ b/tests/GenerateTests.fs @@ -458,7 +458,7 @@ module GenerateTests = let value = getType m.Value - AppPrefix(LongIdent("System.Collections.Generic.Dictionary"), [ key; value ]) + createDictionary [ key; value ] | MetaModel.Type.StringLiteralType t -> LongIdent("string") @@ -573,10 +573,10 @@ module GenerateTests = ] try - Record(structure.Name) { - // expandFields structure - Field("TODO", LongIdent "TODO") + yield! + expandFields structure + |> List.map (fun (name, t) -> Field(name, t)) } with e -> raise @@ -625,7 +625,7 @@ module GenerateTests = |> LongIdent let value = getType m.Value - AppPrefix(LongIdent("System.Collections.Generic.Dictionary"), [ key; value ]) + createDictionary [ key; value ] | MetaModel.Type.StringLiteralType t -> String() | MetaModel.Type.TupleType t -> @@ -679,6 +679,10 @@ module GenerateTests = Abbrev("DocumentUri", "string") Abbrev("RegExp", "string") + Class("ErasedUnionAttribute") { + Inherit("System.Attribute()") + } + // Assuming the max is 5, can be increased if needed for i in [ 2..5 ] do Union($"U%d{i}") { @@ -686,7 +690,7 @@ module GenerateTests = UnionCase($"C{j}", Field $"'T{j}") } |> _.attribute(Attribute "ErasedUnion") - |> _.typeParams([ for j = 1 to i do $"T{j}" ]) + |> _.typeParams([ for j = 1 to i do $"'T{j}" ]) for s in parsedMetaModel.Structures do if isUnitStructure s then @@ -704,7 +708,11 @@ module GenerateTests = |> _.toRecursive() } - let writeToFile path contents = File.WriteAllText(path, contents) + + + let writeToFile path contents = + printfn "%A" contents + File.WriteAllText(path, contents) source |> Gen.mkOak From c1ba00ce59aeabb41674e59f29361f58a9a2a482 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sat, 11 May 2024 07:56:17 -0400 Subject: [PATCH 4/4] formatting --- tests/GenerateTests.fs | 81 ++++++++++++++++++++++-------------------- 1 file changed, 42 insertions(+), 39 deletions(-) diff --git a/tests/GenerateTests.fs b/tests/GenerateTests.fs index 1d2f901..2987d92 100644 --- a/tests/GenerateTests.fs +++ b/tests/GenerateTests.fs @@ -296,13 +296,7 @@ module rec MetaModel = failwith "Should never be writing this structure, it comes from Microsoft LSP Spec" override _.ReadJson - ( - reader: JsonReader, - objectType: System.Type, - existingValue: Type, - hasExistingValue, - serializer: JsonSerializer - ) = + (reader: JsonReader, objectType: System.Type, existingValue: Type, hasExistingValue, serializer: JsonSerializer) = let jobj = JObject.Load(reader) let kind = jobj.["kind"].Value() @@ -388,9 +382,12 @@ module GenerateTests = | None -> s - let rec createField (currentType: MetaModel.Type) (currentProperty: MetaModel.Property): string * WidgetBuilder = + let rec createField + (currentType: MetaModel.Type) + (currentProperty: MetaModel.Property) + : string * WidgetBuilder = try - let rec getType (currentType: MetaModel.Type): WidgetBuilder = + let rec getType (currentType: MetaModel.Type) : WidgetBuilder = match currentType with | MetaModel.Type.ReferenceType r -> let name = r.Name @@ -430,8 +427,7 @@ module GenerateTests = else createErasedUnion ts - | MetaModel.Type.ArrayType a -> - Array(getType a.Element, 1) + | MetaModel.Type.ArrayType a -> Array(getType a.Element, 1) | MetaModel.Type.StructureLiteralType l -> if l.Value.Properties @@ -441,10 +437,9 @@ module GenerateTests = else let ts = l.Value.Properties - |> Array.map (fun p -> - createField p.Type p - ) + |> Array.map (fun p -> createField p.Type p) |> Array.toList + AnonRecord(ts) | MetaModel.Type.MapType m -> @@ -453,15 +448,16 @@ module GenerateTests = | MetaModel.MapKeyType.Base b -> b.Name.ToDotNetType() |> LongIdent - | MetaModel.MapKeyType.ReferenceType r -> - LongIdent(r.Name) + | MetaModel.MapKeyType.ReferenceType r -> LongIdent(r.Name) let value = getType m.Value - createDictionary [ key; value ] + createDictionary [ + key + value + ] - | MetaModel.Type.StringLiteralType t -> - LongIdent("string") + | MetaModel.Type.StringLiteralType t -> LongIdent("string") | MetaModel.Type.TupleType t -> let ts = @@ -476,9 +472,10 @@ module GenerateTests = let t = getType currentType let t = if currentProperty.IsOptional then createOption t else t let name = currentProperty.NameAsPascalCase - name, t + name, t with e -> - raise <| Exception(sprintf "createField on %A " currentProperty, e) + raise + <| Exception(sprintf "createField on %A " currentProperty, e) let isUnitStructure (structure: MetaModel.Structure) = @@ -574,7 +571,7 @@ module GenerateTests = try Record(structure.Name) { - yield! + yield! expandFields structure |> List.map (fun (name, t) -> Field(name, t)) } @@ -596,8 +593,7 @@ module GenerateTests = |> Array.map getType createErasedUnion ts - | MetaModel.Type.ArrayType a -> - Array(getType a.Element, 1) + | MetaModel.Type.ArrayType a -> Array(getType a.Element, 1) | MetaModel.Type.StructureLiteralType l -> if l.Value.Properties @@ -607,9 +603,7 @@ module GenerateTests = else let ts = l.Value.Properties - |> Array.map (fun p -> - createField p.Type p - ) + |> Array.map (fun p -> createField p.Type p) |> Array.toList AnonRecord ts @@ -625,7 +619,11 @@ module GenerateTests = |> LongIdent let value = getType m.Value - createDictionary [ key; value ] + + createDictionary [ + key + value + ] | MetaModel.Type.StringLiteralType t -> String() | MetaModel.Type.TupleType t -> @@ -671,6 +669,7 @@ module GenerateTests = let parsedMetaModel = JsonConvert.DeserializeObject(metaModel, MetaModel.metaModelSerializerSettings) + let source = Ast.Oak() { Namespace("Ionide.LanguageServerProtocol.Types") { @@ -679,18 +678,23 @@ module GenerateTests = Abbrev("DocumentUri", "string") Abbrev("RegExp", "string") - Class("ErasedUnionAttribute") { - Inherit("System.Attribute()") - } + Class("ErasedUnionAttribute") { Inherit("System.Attribute()") } // Assuming the max is 5, can be increased if needed for i in [ 2..5 ] do + Union($"U%d{i}") { - for j = 1 to i do - UnionCase($"C{j}", Field $"'T{j}") + for j = 1 to i do + UnionCase($"C{j}", Field $"'T{j}") } - |> _.attribute(Attribute "ErasedUnion") - |> _.typeParams([ for j = 1 to i do $"'T{j}" ]) + |> fun x -> x.attribute (Attribute "ErasedUnion") + |> fun x -> + x.typeParams ( + [ + for j = 1 to i do + $"'T{j}" + ] + ) for s in parsedMetaModel.Structures do if isUnitStructure s then @@ -705,12 +709,11 @@ module GenerateTests = createEnumeration e } - |> _.toRecursive() - } + |> fun x -> x.toRecursive () + } - - let writeToFile path contents = + let writeToFile path contents = printfn "%A" contents File.WriteAllText(path, contents)