Skip to content

Commit

Permalink
Fix #97: implement notification interfaces
Browse files Browse the repository at this point in the history
  • Loading branch information
@Tarmil
Tarmil committed Nov 8, 2021
1 parent cff6551 commit b5bc81f
Show file tree
Hide file tree
Showing 2 changed files with 79 additions and 57 deletions.
14 changes: 12 additions & 2 deletions src/FSharp.SystemTextJson/Record.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,12 @@ type internal IRecordConverter =
type JsonRecordConverter<'T>(options: JsonSerializerOptions, fsOptions: JsonFSharpOptions) =
inherit JsonConverter<'T>()

let recordType: Type = typeof<'T>
static let recordType: Type = typeof<'T>

static let hasOnSerializing = recordType.IsAssignableFrom(typeof<IJsonOnSerializing>)
static let hasOnSerialized = recordType.IsAssignableFrom(typeof<IJsonOnSerialized>)
static let hasOnDeserializing = recordType.IsAssignableFrom(typeof<IJsonOnDeserializing>)
static let hasOnDeserialized = recordType.IsAssignableFrom(typeof<IJsonOnDeserialized>)

let fieldProps =
FSharpType.GetRecordFields(recordType, true)
Expand Down Expand Up @@ -140,13 +145,17 @@ type JsonRecordConverter<'T>(options: JsonSerializerOptions, fsOptions: JsonFSha
if isNull fields.[i] && fieldProps.[i].MustBePresent then
raise (JsonException("Missing field for record type " + recordType.FullName + ": " + fieldProps.[i].Name))

ctor fields :?> 'T
let res = ctor fields :?> 'T
if hasOnDeserializing then (unbox<IJsonOnDeserializing> res).OnDeserializing()
if hasOnDeserialized then (unbox<IJsonOnDeserialized> res).OnDeserialized()
res

override this.Write(writer, value, options) =
writer.WriteStartObject()
this.WriteRestOfObject(writer, value, options)

member internal _.WriteRestOfObject(writer, value, options) =
if hasOnSerializing then (unbox<IJsonOnSerializing> value).OnSerializing()
let values = dector value
for i in 0..fieldProps.Length-1 do
let v = values.[i]
Expand All @@ -155,6 +164,7 @@ type JsonRecordConverter<'T>(options: JsonSerializerOptions, fsOptions: JsonFSha
writer.WritePropertyName(p.Name)
JsonSerializer.Serialize(writer, v, p.Type, options)
writer.WriteEndObject()
if hasOnSerialized then (unbox<IJsonOnSerialized> value).OnSerialized()

interface IRecordConverter with
member this.ReadRestOfObject(reader, options, skipFirstRead) =
Expand Down
122 changes: 67 additions & 55 deletions src/FSharp.SystemTextJson/Union.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,12 @@ type JsonUnionConverter<'T>
let namedFields = fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.NamedFields
let unwrapFieldlessTags = fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.UnwrapFieldlessTags

let ty = typeof<'T>
static let unionType = typeof<'T>

static let hasOnSerializing = unionType.IsAssignableFrom(typeof<IJsonOnSerializing>)
static let hasOnSerialized = unionType.IsAssignableFrom(typeof<IJsonOnSerialized>)
static let hasOnDeserializing = unionType.IsAssignableFrom(typeof<IJsonOnDeserializing>)
static let hasOnDeserialized = unionType.IsAssignableFrom(typeof<IJsonOnDeserialized>)

let cases =
cases
Expand Down Expand Up @@ -115,7 +120,7 @@ type JsonUnionConverter<'T>
MinExpectedFieldCount = fields |> Seq.filter (fun f -> f.MustBePresent) |> Seq.length
})

let tagReader = FSharpValue.PreComputeUnionTagReader(ty, true)
let tagReader = FSharpValue.PreComputeUnionTagReader(unionType, true)

let hasDistinctFieldNames, fieldlessCase, allFields =
let mutable fieldlessCase = ValueNone
Expand Down Expand Up @@ -184,7 +189,7 @@ type JsonUnionConverter<'T>
| false, _ -> ValueNone
match found with
| ValueNone ->
raise (JsonException("Unknown case for union type " + ty.FullName + ": " + reader.GetString()))
raise (JsonException("Unknown case for union type " + unionType.FullName + ": " + reader.GetString()))
| ValueSome case ->
case

Expand All @@ -207,7 +212,7 @@ type JsonUnionConverter<'T>
| false, _ -> ValueNone
match found with
| ValueNone ->
raise (JsonException("Unknown case for union type " + ty.FullName + ": " + tag))
raise (JsonException("Unknown case for union type " + unionType.FullName + ": " + tag))
| ValueSome case ->
case

Expand All @@ -230,7 +235,7 @@ type JsonUnionConverter<'T>
| false, _ -> ValueNone
match found with
| ValueNone ->
raise (JsonException("Unknown case for union type " + ty.FullName + " due to unknown field: " + reader.GetString()))
raise (JsonException("Unknown case for union type " + unionType.FullName + " due to unknown field: " + reader.GetString()))
| ValueSome case ->
case

Expand All @@ -254,7 +259,7 @@ type JsonUnionConverter<'T>
let readField (reader: byref<Utf8JsonReader>) (case: Case) (f: Field) (options: JsonSerializerOptions) =
reader.Read() |> ignore
if f.MustBeNonNull && reader.TokenType = JsonTokenType.Null then
let msg = sprintf "%s.%s(%s) was expected to be of type %s, but was null." ty.Name case.Name f.Name f.Type.Name
let msg = sprintf "%s.%s(%s) was expected to be of type %s, but was null." unionType.Name case.Name f.Name f.Type.Name
raise (JsonException msg)
else
JsonSerializer.Deserialize(&reader, f.Type, options)
Expand All @@ -264,11 +269,11 @@ type JsonUnionConverter<'T>
let fields = Array.copy case.DefaultFields
for i in 0..fieldCount-1 do
fields.[i] <- readField &reader case case.Fields.[i] options
readExpecting JsonTokenType.EndArray "end of array" &reader ty
readExpecting JsonTokenType.EndArray "end of array" &reader unionType
case.Ctor fields :?> 'T

let readFieldsAsArray (reader: byref<Utf8JsonReader>) (case: Case) (options: JsonSerializerOptions) =
readExpecting JsonTokenType.StartArray "array" &reader ty
readExpecting JsonTokenType.StartArray "array" &reader unionType
readFieldsAsRestOfArray &reader case options

let coreReadFieldsAsRestOfObject (reader: byref<Utf8JsonReader>) (case: Case) (skipFirstRead: bool) (options: JsonSerializerOptions) =
Expand All @@ -292,7 +297,7 @@ type JsonUnionConverter<'T>
| _ -> ()

if fieldsFound < case.MinExpectedFieldCount && not options.IgnoreNullValues then
raise (JsonException("Missing field for union type " + ty.FullName))
raise (JsonException("Missing field for union type " + unionType.FullName))
case.Ctor fields :?> 'T

let readFieldsAsRestOfObject (reader: byref<Utf8JsonReader>) (case: Case) (skipFirstRead: bool) (options: JsonSerializerOptions) =
Expand All @@ -304,7 +309,7 @@ type JsonUnionConverter<'T>
coreReadFieldsAsRestOfObject &reader case skipFirstRead options

let readFieldsAsObject (reader: byref<Utf8JsonReader>) (case: Case) (options: JsonSerializerOptions) =
readExpecting JsonTokenType.StartObject "object" &reader ty
readExpecting JsonTokenType.StartObject "object" &reader unionType
readFieldsAsRestOfObject &reader case false options

let readFields (reader: byref<Utf8JsonReader>) case options =
Expand All @@ -327,60 +332,60 @@ type JsonUnionConverter<'T>
match document.RootElement.TryGetProperty fsOptions.UnionTagName with
| true, element -> getCaseByTagString (element.GetString())
| false, _ ->
sprintf "Failed to find union case field for %s: expected %s" ty.FullName fsOptions.UnionTagName
sprintf "Failed to find union case field for %s: expected %s" unionType.FullName fsOptions.UnionTagName
|> JsonException
|> raise

let getCase (reader: byref<Utf8JsonReader>) =
let mutable snapshot = reader
if readIsExpectingPropertyNamed fsOptions.UnionTagName &snapshot ty then
readExpectingPropertyNamed fsOptions.UnionTagName &reader ty
readExpecting JsonTokenType.String "case name" &reader ty
if readIsExpectingPropertyNamed fsOptions.UnionTagName &snapshot unionType then
readExpectingPropertyNamed fsOptions.UnionTagName &reader unionType
readExpecting JsonTokenType.String "case name" &reader unionType
struct (getCaseByTagReader &reader, false)
elif fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.AllowUnorderedTag then
struct (getCaseFromDocument reader, true)
else
sprintf "Failed to find union case field for %s: expected %s" ty.FullName fsOptions.UnionTagName
sprintf "Failed to find union case field for %s: expected %s" unionType.FullName fsOptions.UnionTagName
|> JsonException
|> raise

let readAdjacentTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
let struct (case, usedDocument) = getCase &reader
let res =
if case.Fields.Length > 0 then
readExpectingPropertyNamed fsOptions.UnionFieldsName &reader ty
readExpectingPropertyNamed fsOptions.UnionFieldsName &reader unionType
readFields &reader case options
else
case.Ctor [||] :?> 'T
if usedDocument then
reader.Read() |> ignore
reader.Skip()
readExpecting JsonTokenType.EndObject "end of object" &reader ty
readExpecting JsonTokenType.EndObject "end of object" &reader unionType
res

let readExternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
readExpecting JsonTokenType.PropertyName "case name" &reader ty
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
readExpecting JsonTokenType.PropertyName "case name" &reader unionType
let case = getCaseByTagReader &reader
let res = readFields &reader case options
readExpecting JsonTokenType.EndObject "end of object" &reader ty
readExpecting JsonTokenType.EndObject "end of object" &reader unionType
res

let readInternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
if namedFields then
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
let mutable snapshot = reader
let struct (case, _usedDocument) = getCase &snapshot
readFieldsAsRestOfObject &reader case false options
else
expectAlreadyRead JsonTokenType.StartArray "array" &reader ty
readExpecting JsonTokenType.String "case name" &reader ty
expectAlreadyRead JsonTokenType.StartArray "array" &reader unionType
readExpecting JsonTokenType.String "case name" &reader unionType
let case = getCaseByTagReader &reader
readFieldsAsRestOfArray &reader case options

let readUntagged (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
reader.Read() |> ignore
match reader.TokenType with
| JsonTokenType.PropertyName ->
Expand All @@ -389,9 +394,9 @@ type JsonUnionConverter<'T>
| JsonTokenType.EndObject ->
match fieldlessCase with
| ValueSome case -> case.Ctor [||] :?> 'T
| ValueNone -> fail "case field" &reader ty
| ValueNone -> fail "case field" &reader unionType
| _ ->
fail "case field" &reader ty
fail "case field" &reader unionType

let writeFieldsAsRestOfArray (writer: Utf8JsonWriter) (case: Case) (value: obj) (options: JsonSerializerOptions) =
let fields = case.Fields
Expand Down Expand Up @@ -462,38 +467,45 @@ type JsonUnionConverter<'T>
writeFieldsAsObject writer case value options

override _.Read(reader, _typeToConvert, options) =
match reader.TokenType with
| JsonTokenType.Null when Helpers.isNullableUnion ty ->
(null : obj) :?> 'T
| JsonTokenType.String when unwrapFieldlessTags ->
let case = getCaseByTagReader &reader
case.Ctor [||] :?> 'T
| _ ->
match baseFormat with
| JsonUnionEncoding.AdjacentTag -> readAdjacentTag &reader options
| JsonUnionEncoding.ExternalTag -> readExternalTag &reader options
| JsonUnionEncoding.InternalTag -> readInternalTag &reader options
| UntaggedBit ->
if not hasDistinctFieldNames then
raise (JsonException(sprintf "Union %s can't be deserialized as Untagged because it has duplicate field names across unions" ty.FullName))
readUntagged &reader options
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
let v =
match reader.TokenType with
| JsonTokenType.Null when Helpers.isNullableUnion unionType ->
(null : obj) :?> 'T
| JsonTokenType.String when unwrapFieldlessTags ->
let case = getCaseByTagReader &reader
case.Ctor [||] :?> 'T
| _ ->
match baseFormat with
| JsonUnionEncoding.AdjacentTag -> readAdjacentTag &reader options
| JsonUnionEncoding.ExternalTag -> readExternalTag &reader options
| JsonUnionEncoding.InternalTag -> readInternalTag &reader options
| UntaggedBit ->
if not hasDistinctFieldNames then
raise (JsonException(sprintf "Union %s can't be deserialized as Untagged because it has duplicate field names across unions" unionType.FullName))
readUntagged &reader options
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
if hasOnDeserializing then (unbox<IJsonOnDeserializing> v).OnDeserializing()
if hasOnDeserialized then (unbox<IJsonOnDeserialized> v).OnDeserialized()
v

override _.Write(writer, value, options) =
if hasOnSerializing then (unbox<IJsonOnSerializing> value).OnSerializing()
let value = box value
if isNull value then writer.WriteNullValue() else

let tag = tagReader value
let case = cases.[tag]
if unwrapFieldlessTags && case.Fields.Length = 0 then
writer.WriteStringValue(case.Name)
if isNull value then
writer.WriteNullValue()
else
match baseFormat with
| JsonUnionEncoding.AdjacentTag -> writeAdjacentTag writer case value options
| JsonUnionEncoding.ExternalTag -> writeExternalTag writer case value options
| JsonUnionEncoding.InternalTag -> writeInternalTag writer case value options
| UntaggedBit -> writeUntagged writer case value options
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
let tag = tagReader value
let case = cases.[tag]
if unwrapFieldlessTags && case.Fields.Length = 0 then
writer.WriteStringValue(case.Name)
else
match baseFormat with
| JsonUnionEncoding.AdjacentTag -> writeAdjacentTag writer case value options
| JsonUnionEncoding.ExternalTag -> writeExternalTag writer case value options
| JsonUnionEncoding.InternalTag -> writeInternalTag writer case value options
| UntaggedBit -> writeUntagged writer case value options
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
if hasOnSerialized then (unbox<IJsonOnSerialized> value).OnSerialized()

type JsonSkippableConverter<'T>() =
inherit JsonConverter<Skippable<'T>>()
Expand Down

0 comments on commit b5bc81f

Please sign in to comment.