Skip to content

Commit

Permalink
support json format on flat schema, reenable json tests (#60)
Browse files Browse the repository at this point in the history 
Support json as format using a flat schema

reenable json tests:

- `proto schema with collection` test is skipped, expected to not work
- `proto schema with just fields (flat)` test is reenabled
- added scala json interop
    - sanity check scala -> json -> scala
    - scala -> json -> .net
    - .net -> json -> scala
  • Loading branch information
@enricosada
enricosada authored Nov 9, 2018
1 parent 251e750 commit d6c8b68
Show file tree
Hide file tree
Showing 16 changed files with 428 additions and 120 deletions.
57 changes: 46 additions & 11 deletions Falanx.Machinery/FSAstExtensions.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,22 +63,42 @@ namespace Falanx.Machinery
Expr = synExpr
ValData = SynValData(flags, SynValInfo.Empty, None)
}

static member CreateFromProvidedProperty (pp:ProvidedProperty, ?ommitEnclosingType : Type, ?knownNamespaces: _ Set) =
let ident =
let ident = if pp.IsStatic then pp.Name else (thisPrefix +.+ pp.Name)
LongIdentWithDots.CreateString ident

let synExpr, _parseTree =
Quotations.ToAst(ProvidedProperty.toExpr pp, ?ommitEnclosingType = ommitEnclosingType, ?knownNamespaces = knownNamespaces)

let flags = if pp.IsStatic then Some MemberFlags.StaticMember else Some MemberFlags.InstanceMember

SynMemberDefn.CreateMember
{ SynBindingRcd.Null with
Pattern = SynPatRcd.CreateLongIdent(ident, [ ] )
Expr = synExpr
ValData = SynValData(flags, SynValInfo.Empty, None)
}

type SynFieldRcd with
static member CreateFromPropertyInfo(pp: Reflection.PropertyInfo, isMutable, ?ommitEnclosingType) =
let typeName = SynType.CreateFromType(pp.PropertyType, ?ommitEnclosingType = ommitEnclosingType)
SynFieldRcd.Create(Ident.Create(pp.Name), typeName, isMutable)

static member CreateFromFieldInfo(fi: Reflection.FieldInfo, isMutable, ?ommitEnclosingType) =
let typeName = SynType.CreateFromType(fi.FieldType, ?ommitEnclosingType = ommitEnclosingType)
SynFieldRcd.Create(Ident.Create(fi.Name), typeName, isMutable)

type SynModuleDecl with
static member CreateRecord (pt: ProvidedRecord, ?ommitEnclosingType, ?knownNamespaces) =
static member CreateRecord (pr: ProvidedRecord, ?ommitEnclosingType, ?knownNamespaces) =
let recordFields =
let props =
pt.GetProperties()
|> Seq.choose (function :? ProvidedProperty as pp -> Some pp | _ -> None)
|> Seq.map (fun pp -> SynFieldRcd.CreateFromPropertyInfo(pp, true, ?ommitEnclosingType = ommitEnclosingType))
|> Seq.toList
pr.RecordFields
|> List.map (fun pi -> SynFieldRcd.CreateFromPropertyInfo(pi, true, ?ommitEnclosingType = ommitEnclosingType))
props

let interfacesAndMembers = ProvidedTypeDefinition.getMethodOverridesByInterfaceType pt
let interfacesAndMembers = ProvidedTypeDefinition.getMethodOverridesByInterfaceType pr
let membersInInterfaces = interfacesAndMembers |> Array.collect (fun (_, m) -> m |> Array.map fst ) |> ResizeArray

let interfaces =
Expand All @@ -91,7 +111,7 @@ namespace Falanx.Machinery
]

let staticMethods =
pt.GetMethods()
pr.GetMethods()
|> Seq.choose(fun pm -> match pm with
| :? ProvidedMethod as pm when pm.IsStatic ->
let name = pm.Name
Expand All @@ -102,7 +122,7 @@ namespace Falanx.Machinery
|> Seq.toList

let instanceMethodsNotInInterface =
pt.GetMethods()
pr.GetMethods()
|> Seq.choose(fun pm -> match pm with
| :? ProvidedMethod as pm when not pm.IsStatic && not (membersInInterfaces.Contains pm) ->
let name = pm.Name
Expand All @@ -112,17 +132,32 @@ namespace Falanx.Machinery
| _ -> None)
|> Seq.toList

let properties =
let recordProperties = pr.RecordFields
let props =
pr.GetProperties()
|> Array.choose (fun prop -> if recordProperties |> List.contains prop
then None
else Some (prop :?> ProvidedProperty))
props

let properties =
properties
|> Seq.map (fun pp ->
SynMemberDefn.CreateFromProvidedProperty(pp, ?ommitEnclosingType = ommitEnclosingType, ?knownNamespaces = knownNamespaces))

let attributes =
let cliMutableAttribute =
SynModuleDecl.CreateAttribute(LongIdentWithDots.CreateString("CLIMutable"), SynExpr.CreateConst SynConst.Unit, false)
[cliMutableAttribute]

SynModuleDecl.CreateSimpleType (
{ SynComponentInfoRcd.Create (Ident.CreateLong pt.Name) with
XmlDoc = PreXmlDoc.Create (ProvidedTypeDefinition.getXmlDocs pt)
{ SynComponentInfoRcd.Create (Ident.CreateLong pr.Name) with
XmlDoc = PreXmlDoc.Create (ProvidedTypeDefinition.getXmlDocs pr)
Attributes = attributes },
SynTypeDefnSimpleReprRecordRcd.Create(recordFields) |> SynTypeDefnSimpleReprRcd.Record,
members = [ yield! staticMethods
members = [ yield! properties
yield! staticMethods
yield! instanceMethodsNotInInterface
yield! interfaces ]
)
Expand Down
49 changes: 41 additions & 8 deletions Falanx.Machinery/ProvidedAdapter.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,23 +4,31 @@ open Microsoft.FSharp.Quotations
open ProviderImplementation.ProvidedTypes
open Falanx.Machinery.Prelude
open Falanx.Machinery.Expr
open Utils

[<RequireQualifiedAccess>]
module ProvidedMethod =
open Utils

let toExpr (m:ProvidedMethod) =
let parameters=

let parameters =
[ if not m.IsStatic then
yield Expr.Var <| Var(thisPrefix, m.DeclaringType)

for p in m.GetParameters() do
yield Expr.Var <| Var(p.Name, p.ParameterType) ]

m.GetInvokeCode |> function Some ik -> ik parameters | _ -> <@@ () @@>

[<RequireQualifiedAccess>]
module ProvidedProperty =
///Note: this only support Properties with a getter
let toExpr (m:ProvidedProperty) =
let getter = match m.Getter with Some getter -> getter() | _ -> failwith "No getter"
match getter with
| :? ProvidedMethod as pm -> ProvidedMethod.toExpr pm
| _ -> failwith "Unknown type"

[<RequireQualifiedAccess>]
[<RequireQualifiedAccess>]
module ProvidedTypeDefinition =
let getXmlDocs (providedType: ProvidedTypeDefinition) =
providedType.GetCustomAttributesData()
Expand Down Expand Up @@ -65,7 +73,32 @@ module ProvidedTypeDefinition =
|> Expr.callStatic [Expr.Value name; Expr.box args.[1]],
setter)))

property, field
property, field

let mkRecordPropertyWithField propertyType name readonly =
let field = ProvidedField(Naming.pascalToCamel name, propertyType)
field.SetFieldAttributes(Reflection.FieldAttributes.InitOnly ||| Reflection.FieldAttributes.Private)
let property =
ProvidedRecordProperty(
name,
propertyType,
getterCode = (fun args -> Expr.FieldGet(args.[0], field)),
?setterCode =
if readonly then None
else Some(fun args ->
let setter = Expr.FieldSet(args.[0], field, args.[1])
if propertyType.IsValueType ||
// None appears to be represented as null.
(propertyType.IsGenericType && propertyType.GetGenericTypeDefinition() = typedefof<option<_>>)
then setter
else
Expr.Sequential(
<@@ argNotNull x x @@>
|> Expr.methoddefof
|> Expr.callStatic [Expr.Value name; Expr.box args.[1]],
setter)))

property, field

module TypeProviderConfig =
let makeConfig resolutionFolder runtimeAssembly runtimeAssemblyRefs =
Expand Down
27 changes: 18 additions & 9 deletions Falanx.Machinery/ProvidedTypesExtensions.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -89,7 +89,18 @@ type ProvidedUnion(isTgt: bool, container:TypeContainer, className: string, getB
unionCaseType = unionCaseType }

member __.UnionCases = unionCases.ToArray()


type ProvidedRecordProperty(isTgt: bool, propertyName: string, attrs: PropertyAttributes, propertyType: Type, isStatic: bool, getter: (unit -> MethodInfo) option, setter: (unit -> MethodInfo) option, indexParameters: ProvidedParameter[], customAttributesData) =
inherit ProvidedProperty(isTgt, propertyName, attrs, propertyType, isStatic, getter, setter, indexParameters, customAttributesData)

new (propertyName, propertyType, ?getterCode, ?setterCode, ?isStatic, ?indexParameters) =
let isStatic = defaultArg isStatic false
let indexParameters = defaultArg indexParameters []
let pattrs = (if isStatic then MethodAttributes.Static else enum<MethodAttributes>(0)) ||| MethodAttributes.Public ||| MethodAttributes.SpecialName
let getter = getterCode |> Option.map (fun _ -> ProvidedMethod(false, "get_" + propertyName, pattrs, Array.ofList indexParameters, propertyType, getterCode, [], None, K [| |]) :> MethodInfo)
let setter = setterCode |> Option.map (fun _ -> ProvidedMethod(false, "set_" + propertyName, pattrs, [| yield! indexParameters; yield ProvidedParameter(false, "value",propertyType,isOut=Some false,optionalValue=None) |], typeof<Void>, setterCode, [], None, K [| |]) :> MethodInfo)
ProvidedRecordProperty(false, propertyName, PropertyAttributes.None, propertyType, isStatic, Option.map K getter, Option.map K setter, Array.ofList indexParameters, K [| |])

type ProvidedRecord(isTgt: bool, container:TypeContainer, className: string, getBaseType: (unit -> Type option), attrs: TypeAttributes, getEnumUnderlyingType, staticParams, staticParamsApply, backingDataSource, customAttributesData, nonNullable, hideObjectMethods) =
inherit ProvidedTypeDefinition(isTgt, container, className, getBaseType, attrs, getEnumUnderlyingType, staticParams, staticParamsApply, backingDataSource, customAttributesData, nonNullable, hideObjectMethods)

Expand All @@ -115,6 +126,11 @@ type ProvidedRecord(isTgt: bool, container:TypeContainer, className: string, get

override this.GetCustomAttributes(_inherit) = recordAttribs
override this.GetCustomAttributes(_attributeType, _inherit) = recordAttribs

member this.RecordFields =
this.GetProperties()
|> Array.choose (function :? ProvidedRecordProperty as prp -> Some (prp :> PropertyInfo) | _ -> None)
|> Array.toList

module ProvidedUnion =
let inline private apply (uc: ProvidedUnion) f = uc.UnionCases |> Seq.tryFind f
Expand All @@ -125,11 +141,4 @@ module ProvidedUnion =
apply uc (fun uc -> uc.name = name)

let tryGetUnionCaseByPosition position (uc:ProvidedUnion) =
apply uc (fun uc -> uc.position = position)


module ProvidedRecord =
let getRecordFields (providedRecord: ProvidedRecord) =
providedRecord.GetProperties()
|> Array.choose (function :? ProvidedProperty as pp -> Some pp | _ -> None)
|> Array.toList
apply uc (fun uc -> uc.position = position)
Loading

0 comments on commit d6c8b68

Please sign in to comment.