Skip to content

Commit 4a73b7a

Browse files
TarmilTarmil
committed
Fix #97: implement notification interfaces
1 parent 4e45606 commit 4a73b7a

File tree

2 files changed

+79
-57
lines changed

2 files changed

+79
-57
lines changed

‎src/FSharp.SystemTextJson/Record.fs‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,12 @@ type internal IRecordConverter =
2727
type JsonRecordConverter<'T>(options: JsonSerializerOptions, fsOptions: JsonFSharpOptions) =
2828
inherit JsonConverter<'T>()
2929

30-
let recordType: Type = typeof<'T>
30+
static let recordType: Type = typeof<'T>
31+
32+
static let hasOnSerializing = recordType.IsAssignableFrom(typeof<IJsonOnSerializing>)
33+
static let hasOnSerialized = recordType.IsAssignableFrom(typeof<IJsonOnSerialized>)
34+
static let hasOnDeserializing = recordType.IsAssignableFrom(typeof<IJsonOnDeserializing>)
35+
static let hasOnDeserialized = recordType.IsAssignableFrom(typeof<IJsonOnDeserialized>)
3136

3237
let fields = FSharpType.GetRecordFields(recordType, true)
3338

@@ -174,20 +179,25 @@ type JsonRecordConverter<'T>(options: JsonSerializerOptions, fsOptions: JsonFSha
174179
if isNull fields[i] && fieldProps[i].MustBePresent then
175180
raise (JsonException("Missing field for record type " + recordType.FullName + ": " + fieldProps[i].Name))
176181

177-
ctor fields :?> 'T
182+
let res = ctor fields
183+
if hasOnDeserializing then (res :?> IJsonOnDeserializing).OnDeserializing()
184+
if hasOnDeserialized then (res :?> IJsonOnDeserialized).OnDeserialized()
185+
res :?> 'T
178186

179187
override this.Write(writer, value, options) =
180188
writer.WriteStartObject()
181189
this.WriteRestOfObject(writer, value, options)
182190

183191
member internal _.WriteRestOfObject(writer, value, options) =
192+
if hasOnSerializing then (box value :?> IJsonOnSerializing).OnSerializing()
184193
let values = dector value
185194
for struct (i, p) in writeOrderedFieldProps do
186195
let v = values[i]
187196
if not p.Ignore && not (options.IgnoreNullValues && isNull v) && not (p.IsSkip v) then
188197
writer.WritePropertyName(p.Name)
189198
JsonSerializer.Serialize(writer, v, p.Type, options)
190199
writer.WriteEndObject()
200+
if hasOnSerialized then (box value :?> IJsonOnSerialized).OnSerialized()
191201

192202
interface IRecordConverter with
193203
member this.ReadRestOfObject(reader, options, skipFirstRead) =

‎src/FSharp.SystemTextJson/Union.fs‎

Lines changed: 67 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,12 @@ type JsonUnionConverter<'T>
4646
let namedFields = fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.NamedFields
4747
let unwrapFieldlessTags = fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.UnwrapFieldlessTags
4848

49-
let ty = typeof<'T>
49+
static let unionType = typeof<'T>
50+
51+
static let hasOnSerializing = unionType.IsAssignableFrom(typeof<IJsonOnSerializing>)
52+
static let hasOnSerialized = unionType.IsAssignableFrom(typeof<IJsonOnSerialized>)
53+
static let hasOnDeserializing = unionType.IsAssignableFrom(typeof<IJsonOnDeserializing>)
54+
static let hasOnDeserialized = unionType.IsAssignableFrom(typeof<IJsonOnDeserialized>)
5055

5156
let cases =
5257
cases
@@ -116,7 +121,7 @@ type JsonUnionConverter<'T>
116121
MinExpectedFieldCount = fields |> Seq.filter (fun f -> f.MustBePresent) |> Seq.length
117122
})
118123

119-
let tagReader = FSharpValue.PreComputeUnionTagReader(ty, true)
124+
let tagReader = FSharpValue.PreComputeUnionTagReader(unionType, true)
120125

121126
let hasDistinctFieldNames, fieldlessCase, allFields =
122127
let mutable fieldlessCase = ValueNone
@@ -185,7 +190,7 @@ type JsonUnionConverter<'T>
185190
| false, _ -> ValueNone
186191
match found with
187192
| ValueNone ->
188-
raise (JsonException("Unknown case for union type " + ty.FullName + ": " + reader.GetString()))
193+
raise (JsonException("Unknown case for union type " + unionType.FullName + ": " + reader.GetString()))
189194
| ValueSome case ->
190195
case
191196

@@ -208,7 +213,7 @@ type JsonUnionConverter<'T>
208213
| false, _ -> ValueNone
209214
match found with
210215
| ValueNone ->
211-
raise (JsonException("Unknown case for union type " + ty.FullName + ": " + tag))
216+
raise (JsonException("Unknown case for union type " + unionType.FullName + ": " + tag))
212217
| ValueSome case ->
213218
case
214219

@@ -231,7 +236,7 @@ type JsonUnionConverter<'T>
231236
| false, _ -> ValueNone
232237
match found with
233238
| ValueNone ->
234-
raise (JsonException("Unknown case for union type " + ty.FullName + " due to unknown field: " + reader.GetString()))
239+
raise (JsonException("Unknown case for union type " + unionType.FullName + " due to unknown field: " + reader.GetString()))
235240
| ValueSome case ->
236241
case
237242

@@ -255,7 +260,7 @@ type JsonUnionConverter<'T>
255260
let readField (reader: byref<Utf8JsonReader>) (case: Case) (f: Field) (options: JsonSerializerOptions) =
256261
reader.Read() |> ignore
257262
if f.MustBeNonNull && reader.TokenType = JsonTokenType.Null then
258-
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
263+
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
259264
raise (JsonException msg)
260265
else
261266
JsonSerializer.Deserialize(&reader, f.Type, options)
@@ -265,11 +270,11 @@ type JsonUnionConverter<'T>
265270
let fields = Array.copy case.DefaultFields
266271
for i in 0..fieldCount-1 do
267272
fields[i] <- readField &reader case case.Fields[i] options
268-
readExpecting JsonTokenType.EndArray "end of array" &reader ty
273+
readExpecting JsonTokenType.EndArray "end of array" &reader unionType
269274
case.Ctor fields :?> 'T
270275

271276
let readFieldsAsArray (reader: byref<Utf8JsonReader>) (case: Case) (options: JsonSerializerOptions) =
272-
readExpecting JsonTokenType.StartArray "array" &reader ty
277+
readExpecting JsonTokenType.StartArray "array" &reader unionType
273278
readFieldsAsRestOfArray &reader case options
274279

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

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

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

306311
let readFieldsAsObject (reader: byref<Utf8JsonReader>) (case: Case) (options: JsonSerializerOptions) =
307-
readExpecting JsonTokenType.StartObject "object" &reader ty
312+
readExpecting JsonTokenType.StartObject "object" &reader unionType
308313
readFieldsAsRestOfObject &reader case false options
309314

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

334339
let getCase (reader: byref<Utf8JsonReader>) =
335340
let mutable snapshot = reader
336-
if readIsExpectingPropertyNamed fsOptions.UnionTagName &snapshot ty then
337-
readExpectingPropertyNamed fsOptions.UnionTagName &reader ty
338-
readExpecting JsonTokenType.String "case name" &reader ty
341+
if readIsExpectingPropertyNamed fsOptions.UnionTagName &snapshot unionType then
342+
readExpectingPropertyNamed fsOptions.UnionTagName &reader unionType
343+
readExpecting JsonTokenType.String "case name" &reader unionType
339344
struct (getCaseByTagReader &reader, false)
340345
elif fsOptions.UnionEncoding.HasFlag JsonUnionEncoding.AllowUnorderedTag then
341346
struct (getCaseFromDocument reader, true)
342347
else
343-
sprintf "Failed to find union case field for %s: expected %s" ty.FullName fsOptions.UnionTagName
348+
sprintf "Failed to find union case field for %s: expected %s" unionType.FullName fsOptions.UnionTagName
344349
|> JsonException
345350
|> raise
346351

347352
let readAdjacentTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
348-
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
353+
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
349354
let struct (case, usedDocument) = getCase &reader
350355
let res =
351356
if case.Fields.Length > 0 then
352-
readExpectingPropertyNamed fsOptions.UnionFieldsName &reader ty
357+
readExpectingPropertyNamed fsOptions.UnionFieldsName &reader unionType
353358
readFields &reader case options
354359
else
355360
case.Ctor [||] :?> 'T
356361
if usedDocument then
357362
reader.Read() |> ignore
358363
reader.Skip()
359-
readExpecting JsonTokenType.EndObject "end of object" &reader ty
364+
readExpecting JsonTokenType.EndObject "end of object" &reader unionType
360365
res
361366

362367
let readExternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
363-
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
364-
readExpecting JsonTokenType.PropertyName "case name" &reader ty
368+
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
369+
readExpecting JsonTokenType.PropertyName "case name" &reader unionType
365370
let case = getCaseByTagReader &reader
366371
let res = readFields &reader case options
367-
readExpecting JsonTokenType.EndObject "end of object" &reader ty
372+
readExpecting JsonTokenType.EndObject "end of object" &reader unionType
368373
res
369374

370375
let readInternalTag (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
371376
if namedFields then
372-
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
377+
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
373378
let mutable snapshot = reader
374379
let struct (case, _usedDocument) = getCase &snapshot
375380
readFieldsAsRestOfObject &reader case false options
376381
else
377-
expectAlreadyRead JsonTokenType.StartArray "array" &reader ty
378-
readExpecting JsonTokenType.String "case name" &reader ty
382+
expectAlreadyRead JsonTokenType.StartArray "array" &reader unionType
383+
readExpecting JsonTokenType.String "case name" &reader unionType
379384
let case = getCaseByTagReader &reader
380385
readFieldsAsRestOfArray &reader case options
381386

382387
let readUntagged (reader: byref<Utf8JsonReader>) (options: JsonSerializerOptions) =
383-
expectAlreadyRead JsonTokenType.StartObject "object" &reader ty
388+
expectAlreadyRead JsonTokenType.StartObject "object" &reader unionType
384389
reader.Read() |> ignore
385390
match reader.TokenType with
386391
| JsonTokenType.PropertyName ->
@@ -389,9 +394,9 @@ type JsonUnionConverter<'T>
389394
| JsonTokenType.EndObject ->
390395
match fieldlessCase with
391396
| ValueSome case -> case.Ctor [||] :?> 'T
392-
| ValueNone -> fail "case field" &reader ty
397+
| ValueNone -> fail "case field" &reader unionType
393398
| _ ->
394-
fail "case field" &reader ty
399+
fail "case field" &reader unionType
395400

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

464469
override _.Read(reader, _typeToConvert, options) =
465-
match reader.TokenType with
466-
| JsonTokenType.Null when isNullableUnion ty ->
467-
(null : obj) :?> 'T
468-
| JsonTokenType.String when unwrapFieldlessTags ->
469-
let case = getCaseByTagReader &reader
470-
case.Ctor [||] :?> 'T
471-
| _ ->
472-
match baseFormat with
473-
| JsonUnionEncoding.AdjacentTag -> readAdjacentTag &reader options
474-
| JsonUnionEncoding.ExternalTag -> readExternalTag &reader options
475-
| JsonUnionEncoding.InternalTag -> readInternalTag &reader options
476-
| UntaggedBit ->
477-
if not hasDistinctFieldNames then
478-
raise (JsonException(sprintf "Union %s can't be deserialized as Untagged because it has duplicate field names across unions" ty.FullName))
479-
readUntagged &reader options
480-
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
470+
let v =
471+
match reader.TokenType with
472+
| JsonTokenType.Null when isNullableUnion unionType ->
473+
(null : obj) :?> 'T
474+
| JsonTokenType.String when unwrapFieldlessTags ->
475+
let case = getCaseByTagReader &reader
476+
case.Ctor [||] :?> 'T
477+
| _ ->
478+
match baseFormat with
479+
| JsonUnionEncoding.AdjacentTag -> readAdjacentTag &reader options
480+
| JsonUnionEncoding.ExternalTag -> readExternalTag &reader options
481+
| JsonUnionEncoding.InternalTag -> readInternalTag &reader options
482+
| UntaggedBit ->
483+
if not hasDistinctFieldNames then
484+
raise (JsonException(sprintf "Union %s can't be deserialized as Untagged because it has duplicate field names across unions" unionType.FullName))
485+
readUntagged &reader options
486+
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
487+
if hasOnDeserializing then (box v :?> IJsonOnDeserializing).OnDeserializing()
488+
if hasOnDeserialized then (box v :?> IJsonOnDeserialized).OnDeserialized()
489+
v
481490

482491
override _.Write(writer, value, options) =
492+
if hasOnSerializing then (box value :?> IJsonOnSerializing).OnSerializing()
483493
let value = box value
484-
if isNull value then writer.WriteNullValue() else
485-
486-
let tag = tagReader value
487-
let case = cases[tag]
488-
if unwrapFieldlessTags && case.Fields.Length = 0 then
489-
writer.WriteStringValue(case.Name)
494+
if isNull value then
495+
writer.WriteNullValue()
490496
else
491-
match baseFormat with
492-
| JsonUnionEncoding.AdjacentTag -> writeAdjacentTag writer case value options
493-
| JsonUnionEncoding.ExternalTag -> writeExternalTag writer case value options
494-
| JsonUnionEncoding.InternalTag -> writeInternalTag writer case value options
495-
| UntaggedBit -> writeUntagged writer case value options
496-
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
497+
let tag = tagReader value
498+
let case = cases[tag]
499+
if unwrapFieldlessTags && case.Fields.Length = 0 then
500+
writer.WriteStringValue(case.Name)
501+
else
502+
match baseFormat with
503+
| JsonUnionEncoding.AdjacentTag -> writeAdjacentTag writer case value options
504+
| JsonUnionEncoding.ExternalTag -> writeExternalTag writer case value options
505+
| JsonUnionEncoding.InternalTag -> writeInternalTag writer case value options
506+
| UntaggedBit -> writeUntagged writer case value options
507+
| _ -> raise (JsonException("Invalid union encoding: " + string fsOptions.UnionEncoding))
508+
if hasOnSerialized then (box value :?> IJsonOnSerialized).OnSerialized()
497509

498510
type JsonSkippableConverter<'T>() =
499511
inherit JsonConverter<Skippable<'T>>()

0 commit comments

Comments
 (0)