From ddc776248125d575f8a270173b58ae40ddb836ce Mon Sep 17 00:00:00 2001 From: Alfonso Garcia-Caro Date: Mon, 1 Aug 2016 23:20:56 +0200 Subject: [PATCH] Add class properties for unions and records in declaration --- src/fable/Fable.Compiler/FSharp2Fable.Util.fs | 9 ++++- src/fable/Fable.Compiler/FSharp2Fable.fs | 15 +++---- src/fable/Fable.Compiler/Fable2Babel.fs | 40 +++++++++++++------ src/fable/Fable.Core/AST/AST.Babel.fs | 5 ++- src/fable/Fable.Core/AST/AST.Fable.fs | 6 +-- 5 files changed, 46 insertions(+), 29 deletions(-) diff --git a/src/fable/Fable.Compiler/FSharp2Fable.Util.fs b/src/fable/Fable.Compiler/FSharp2Fable.Util.fs index 509945bc42..67239e943b 100644 --- a/src/fable/Fable.Compiler/FSharp2Fable.Util.fs +++ b/src/fable/Fable.Compiler/FSharp2Fable.Util.fs @@ -377,11 +377,16 @@ module Types = None and makeEntity (com: IFableCompiler) (tdef: FSharpEntity) = + let makeFields (tdef: FSharpEntity) = + tdef.FSharpFields + // It's ok to use an empty context here, because we don't need to resolve generic params + |> Seq.map (fun x -> x.Name, makeType com Context.Empty x.FieldType) + |> Seq.toList let kind = if tdef.IsInterface then Fable.Interface - elif tdef.IsFSharpRecord then Fable.Record elif tdef.IsFSharpUnion then Fable.Union - elif tdef.IsFSharpExceptionDeclaration then Fable.Exception + elif tdef.IsFSharpRecord then makeFields tdef |> Fable.Record + elif tdef.IsFSharpExceptionDeclaration then makeFields tdef |> Fable.Exception elif tdef.IsFSharpModule || tdef.IsNamespace then Fable.Module else Fable.Class (getBaseClass com tdef) let genParams = diff --git a/src/fable/Fable.Compiler/FSharp2Fable.fs b/src/fable/Fable.Compiler/FSharp2Fable.fs index df2876a5ba..ec48881df8 100644 --- a/src/fable/Fable.Compiler/FSharp2Fable.fs +++ b/src/fable/Fable.Compiler/FSharp2Fable.fs @@ -739,22 +739,19 @@ let rec private transformEntityDecl declInfo.AddIgnoredChild ent declInfo, ctx else + let fableEnt = com.GetEntity ent // Unions, records and F# exceptions don't have a constructor let cons = - if ent.IsFSharpUnion - then [makeUnionCons()] - elif ent.IsFSharpRecord || ent.IsFSharpExceptionDeclaration - then ent.FSharpFields - |> Seq.map (fun x -> (x.Name, makeType com ctx x.FieldType)) |> Seq.toList - |> makeRecordCons - |> List.singleton - else [] + match fableEnt.Kind with + | Fable.Union -> [makeUnionCons()] + | Fable.Record fields + | Fable.Exception fields -> [makeRecordCons fields] + | _ -> [] let compareMeths = // If F# union or records implement System.IComparable (in that case they // allways implement System.Equatable too) generate Equals and CompareTo methods // Note: F# compiler generates these methods too but see `IsIgnoredMethod` // Note: If `ReferenceEqualityAttribute` is used, the type doesn't implement IComparable - let fableEnt = com.GetEntity ent let fableType = Fable.DeclaredType(fableEnt, fableEnt.GenericParameters |> List.map Fable.GenericParam) if ent.IsFSharpUnion && fableEnt.HasInterface "System.IComparable" then makeUnionCompareMethods com fableType diff --git a/src/fable/Fable.Compiler/Fable2Babel.fs b/src/fable/Fable.Compiler/Fable2Babel.fs index 05d715c65f..5fec96d71f 100644 --- a/src/fable/Fable.Compiler/Fable2Babel.fs +++ b/src/fable/Fable.Compiler/Fable2Babel.fs @@ -635,12 +635,17 @@ module Util = args, body let transformClass com ctx range (ent: Fable.Entity option) baseClass decls = - let declareMember range kind name args (body: Fable.Expr) typeParams hasRestParams isStatic = + let declareProperty com ctx name typ = + let typ = Babel.TypeAnnotation(typeAnnotation com ctx typ) + Babel.ClassProperty(Babel.Identifier(name), typeAnnotation=typ) + |> U2.Case2 + let declareMethod range kind name args (body: Fable.Expr) typeParams hasRestParams isStatic = let name, computed = sanitizeName name let args, body, returnType, typeParams = getMemberArgs com ctx args body typeParams hasRestParams Babel.ClassMethod(kind, name, args, body, computed, isStatic, ?returnType=returnType, ?typeParams=typeParams, loc=range) + |> U2<_,Babel.ClassProperty>.Case1 let baseClass = baseClass |> Option.map (transformExpr com ctx) decls |> List.map (function @@ -651,21 +656,30 @@ module Util = | Fable.Method -> Babel.ClassFunction, m.Name, m.IsStatic | Fable.Getter | Fable.Field -> Babel.ClassGetter, m.Name, m.IsStatic | Fable.Setter -> Babel.ClassSetter, m.Name, m.IsStatic - declareMember m.Range kind name m.Arguments m.Body m.GenericParameters m.HasRestParams isStatic + declareMethod m.Range kind name m.Arguments m.Body m.GenericParameters m.HasRestParams isStatic | Fable.ActionDeclaration _ | Fable.EntityDeclaration _ as decl -> failwithf "Unexpected declaration in class: %A" decl) - |> List.map U2<_,Babel.ClassProperty>.Case1 - |> fun meths -> + |> fun members -> let id = ent |> Option.map (fun x -> identFromName x.Name) - let typeParams = + let typeParams, members = match com.Options.declaration, ent with | true, Some ent -> - ent.GenericParameters - |> List.map Babel.TypeParameter - |> Babel.TypeParameterDeclaration |> Some - | _ -> None - Babel.ClassExpression(Babel.ClassBody(meths, ?loc=range), + let typeParams = + ent.GenericParameters + |> List.map Babel.TypeParameter + |> Babel.TypeParameterDeclaration |> Some + let props = + match ent.Kind with + | Fable.Union -> + ["Case", Fable.String; "Fields", Fable.Array Fable.Any] + |> List.map (fun (name, typ) -> declareProperty com ctx name typ) + | Fable.Record fields | Fable.Exception fields -> + fields |> List.map (fun (name, typ) -> declareProperty com ctx name typ) + | _ -> [] + typeParams, props@members + | _ -> None, members + Babel.ClassExpression(Babel.ClassBody(members, ?loc=range), ?id=id, ?typeParams=typeParams, ?super=baseClass, ?loc=range) let declareInterfaces (com: IBabelCompiler) ctx (ent: Fable.Entity) isClass = @@ -676,8 +690,8 @@ module Util = let interfaces = match ent.Kind with | Fable.Union -> "FSharpUnion"::ent.Interfaces - | Fable.Record -> "FSharpRecord"::ent.Interfaces - | Fable.Exception -> "FSharpException"::ent.Interfaces + | Fable.Record _ -> "FSharpRecord"::ent.Interfaces + | Fable.Exception _ -> "FSharpException"::ent.Interfaces | _ -> ent.Interfaces [ getCoreLibImport com ctx "Util" typeRef com ctx ent None @@ -836,7 +850,7 @@ module Util = declareClass com ctx declareMember modIdent ent privateName entDecls entRange baseClass true |> List.append <| acc - | Fable.Union | Fable.Record | Fable.Exception -> + | Fable.Union | Fable.Record _ | Fable.Exception _ -> declareClass com ctx declareMember modIdent ent privateName entDecls entRange None false |> List.append <| acc diff --git a/src/fable/Fable.Core/AST/AST.Babel.fs b/src/fable/Fable.Core/AST/AST.Babel.fs index 9cec76cb7c..94691ee451 100644 --- a/src/fable/Fable.Core/AST/AST.Babel.fs +++ b/src/fable/Fable.Core/AST/AST.Babel.fs @@ -526,10 +526,11 @@ type ClassMethod(kind, key, args, body, computed, ``static``, /// ES Class Fields & Static Properties /// https://github.com/jeffmo/es-class-fields-and-static-properties /// e.g, class MyClass { static myStaticProp = 5; myProp /* = 10 */; } -type ClassProperty(key, value, ?loc) = +type ClassProperty(key, ?value, ?typeAnnotation, ?loc) = inherit Node("ClassProperty", ?loc = loc) member x.key: Identifier = key - member x.value: Expression = value + member x.value: Expression option = value + member x.typeAnnotation: TypeAnnotation option = typeAnnotation type ClassBody(body, ?loc) = inherit Node("ClassBody", ?loc = loc) diff --git a/src/fable/Fable.Core/AST/AST.Fable.fs b/src/fable/Fable.Core/AST/AST.Fable.fs index 930ff9041e..320ad098a4 100644 --- a/src/fable/Fable.Core/AST/AST.Fable.fs +++ b/src/fable/Fable.Core/AST/AST.Fable.fs @@ -43,10 +43,10 @@ type Type = (** ##Entities *) and EntityKind = | Module - | Class of baseClass: (string*Expr) option | Union - | Record - | Exception + | Record of fields: (string*Type) list + | Exception of fields: (string*Type) list + | Class of baseClass: (string*Expr) option | Interface and Entity(kind, file, fullName, genParams, interfaces, decorators, isPublic) =