1##[
2This module implements a hookable (de)serialization for arbitrary types.
3Design goal: avoid importing modules where a custom serialization is needed;
4see strtabs.fromJsonHook,toJsonHook for an example.
5]##
6
7runnableExamples:
8  import std/[strtabs,json]
9  type Foo = ref object
10    t: bool
11    z1: int8
12  let a = (1.5'f32, (b: "b2", a: "a2"), 'x', @[Foo(t: true, z1: -3), nil], [{"name": "John"}.newStringTable])
13  let j = a.toJson
14  assert j.jsonTo(typeof(a)).toJson == j
15  assert $[NaN, Inf, -Inf, 0.0, -0.0, 1.0, 1e-2].toJson == """["nan","inf","-inf",0.0,-0.0,1.0,0.01]"""
16  assert 0.0.toJson.kind == JFloat
17  assert Inf.toJson.kind == JString
18
19import json, strutils, tables, sets, strtabs, options
20
21#[
22Future directions:
23add a way to customize serialization, for e.g.:
24* field renaming
25* allow serializing `enum` and `char` as `string` instead of `int`
26  (enum is more compact/efficient, and robust to enum renamings, but string
27  is more human readable)
28* handle cyclic references, using a cache of already visited addresses
29* implement support for serialization and de-serialization of nested variant
30  objects.
31]#
32
33import macros
34from enumutils import symbolName
35from typetraits import OrdinalEnum
36
37when not defined(nimFixedForwardGeneric):
38  # xxx remove pending csources_v1 update >= 1.2.0
39  proc to[T](node: JsonNode, t: typedesc[T]): T =
40    when T is string: node.getStr
41    elif T is bool: node.getBool
42    else: static: doAssert false, $T # support as needed (only needed during bootstrap)
43  proc isNamedTuple(T: typedesc): bool = # old implementation
44    when T isnot tuple: result = false
45    else:
46      var t: T
47      for name, _ in t.fieldPairs:
48        when name == "Field0": return compiles(t.Field0)
49        else: return true
50      return false
51else:
52  proc isNamedTuple(T: typedesc): bool {.magic: "TypeTrait".}
53
54type
55  Joptions* = object # xxx rename FromJsonOptions
56    ## Options controlling the behavior of `fromJson`.
57    allowExtraKeys*: bool
58      ## If `true` Nim's object to which the JSON is parsed is not required to
59      ## have a field for every JSON key.
60    allowMissingKeys*: bool
61      ## If `true` Nim's object to which JSON is parsed is allowed to have
62      ## fields without corresponding JSON keys.
63    # in future work: a key rename could be added
64  EnumMode* = enum
65    joptEnumOrd
66    joptEnumSymbol
67    joptEnumString
68  JsonNodeMode* = enum ## controls `toJson` for JsonNode types
69    joptJsonNodeAsRef ## returns the ref as is
70    joptJsonNodeAsCopy ## returns a deep copy of the JsonNode
71    joptJsonNodeAsObject ## treats JsonNode as a regular ref object
72  ToJsonOptions* = object
73    enumMode*: EnumMode
74    jsonNodeMode*: JsonNodeMode
75    # xxx charMode, etc
76
77proc initToJsonOptions*(): ToJsonOptions =
78  ## initializes `ToJsonOptions` with sane options.
79  ToJsonOptions(enumMode: joptEnumOrd, jsonNodeMode: joptJsonNodeAsRef)
80
81proc distinctBase(T: typedesc, recursive: static bool = true): typedesc {.magic: "TypeTrait".}
82template distinctBase[T](a: T, recursive: static bool = true): untyped = distinctBase(typeof(a), recursive)(a)
83
84macro getDiscriminants(a: typedesc): seq[string] =
85  ## return the discriminant keys
86  # candidate for std/typetraits
87  var a = a.getTypeImpl
88  doAssert a.kind == nnkBracketExpr
89  let sym = a[1]
90  let t = sym.getTypeImpl
91  let t2 = t[2]
92  doAssert t2.kind == nnkRecList
93  result = newTree(nnkBracket)
94  for ti in t2:
95    if ti.kind == nnkRecCase:
96      let key = ti[0][0]
97      let typ = ti[0][1]
98      result.add newLit key.strVal
99  if result.len > 0:
100    result = quote do:
101      @`result`
102  else:
103    result = quote do:
104      seq[string].default
105
106macro initCaseObject(T: typedesc, fun: untyped): untyped =
107  ## does the minimum to construct a valid case object, only initializing
108  ## the discriminant fields; see also `getDiscriminants`
109  # maybe candidate for std/typetraits
110  var a = T.getTypeImpl
111  doAssert a.kind == nnkBracketExpr
112  let sym = a[1]
113  let t = sym.getTypeImpl
114  var t2: NimNode
115  case t.kind
116  of nnkObjectTy: t2 = t[2]
117  of nnkRefTy: t2 = t[0].getTypeImpl[2]
118  else: doAssert false, $t.kind # xxx `nnkPtrTy` could be handled too
119  doAssert t2.kind == nnkRecList
120  result = newTree(nnkObjConstr)
121  result.add sym
122  for ti in t2:
123    if ti.kind == nnkRecCase:
124      let key = ti[0][0]
125      let typ = ti[0][1]
126      let key2 = key.strVal
127      let val = quote do:
128        `fun`(`key2`, typedesc[`typ`])
129      result.add newTree(nnkExprColonExpr, key, val)
130
131proc raiseJsonException(condStr: string, msg: string) {.noinline.} =
132  # just pick 1 exception type for simplicity; other choices would be:
133  # JsonError, JsonParser, JsonKindError
134  raise newException(ValueError, condStr & " failed: " & msg)
135
136template checkJson(cond: untyped, msg = "") =
137  if not cond:
138    raiseJsonException(astToStr(cond), msg)
139
140proc hasField[T](obj: T, field: string): bool =
141  for k, _ in fieldPairs(obj):
142    if k == field:
143      return true
144  return false
145
146macro accessField(obj: typed, name: static string): untyped =
147  newDotExpr(obj, ident(name))
148
149template fromJsonFields(newObj, oldObj, json, discKeys, opt) =
150  type T = typeof(newObj)
151  # we could customize whether to allow JNull
152  checkJson json.kind == JObject, $json.kind
153  var num, numMatched = 0
154  for key, val in fieldPairs(newObj):
155    num.inc
156    when key notin discKeys:
157      if json.hasKey key:
158        numMatched.inc
159        fromJson(val, json[key], opt)
160      elif opt.allowMissingKeys:
161        # if there are no discriminant keys the `oldObj` must always have the
162        # same keys as the new one. Otherwise we must check, because they could
163        # be set to different branches.
164        when typeof(oldObj) isnot typeof(nil):
165          if discKeys.len == 0 or hasField(oldObj, key):
166            val = accessField(oldObj, key)
167      else:
168        checkJson false, $($T, key, json)
169    else:
170      if json.hasKey key:
171        numMatched.inc
172
173  let ok =
174    if opt.allowExtraKeys and opt.allowMissingKeys:
175      true
176    elif opt.allowExtraKeys:
177      # This check is redundant because if here missing keys are not allowed,
178      # and if `num != numMatched` it will fail in the loop above but it is left
179      # for clarity.
180      assert num == numMatched
181      num == numMatched
182    elif opt.allowMissingKeys:
183      json.len == numMatched
184    else:
185      json.len == num and num == numMatched
186
187  checkJson ok, $(json.len, num, numMatched, $T, json)
188
189proc fromJson*[T](a: var T, b: JsonNode, opt = Joptions())
190
191proc discKeyMatch[T](obj: T, json: JsonNode, key: static string): bool =
192  if not json.hasKey key:
193    return true
194  let field = accessField(obj, key)
195  var jsonVal: typeof(field)
196  fromJson(jsonVal, json[key])
197  if jsonVal != field:
198    return false
199  return true
200
201macro discKeysMatchBodyGen(obj: typed, json: JsonNode,
202                           keys: static seq[string]): untyped =
203  result = newStmtList()
204  let r = ident("result")
205  for key in keys:
206    let keyLit = newLit key
207    result.add quote do:
208      `r` = `r` and discKeyMatch(`obj`, `json`, `keyLit`)
209
210proc discKeysMatch[T](obj: T, json: JsonNode, keys: static seq[string]): bool =
211  result = true
212  discKeysMatchBodyGen(obj, json, keys)
213
214proc fromJson*[T](a: var T, b: JsonNode, opt = Joptions()) =
215  ## inplace version of `jsonTo`
216  #[
217  adding "json path" leading to `b` can be added in future work.
218  ]#
219  checkJson b != nil, $($T, b)
220  when compiles(fromJsonHook(a, b)): fromJsonHook(a, b)
221  elif T is bool: a = to(b,T)
222  elif T is enum:
223    case b.kind
224    of JInt: a = T(b.getBiggestInt())
225    of JString: a = parseEnum[T](b.getStr())
226    else: checkJson false, $($T, " ", b)
227  elif T is uint|uint64: a = T(to(b, uint64))
228  elif T is Ordinal: a = cast[T](to(b, int))
229  elif T is pointer: a = cast[pointer](to(b, int))
230  elif T is distinct:
231    when nimvm:
232      # bug, potentially related to https://github.com/nim-lang/Nim/issues/12282
233      a = T(jsonTo(b, distinctBase(T)))
234    else:
235      a.distinctBase.fromJson(b)
236  elif T is string|SomeNumber: a = to(b,T)
237  elif T is cstring:
238    case b.kind
239    of JNull: a = nil
240    of JString: a = b.str
241    else: checkJson false, $($T, " ", b)
242  elif T is JsonNode: a = b
243  elif T is ref | ptr:
244    if b.kind == JNull: a = nil
245    else:
246      a = T()
247      fromJson(a[], b, opt)
248  elif T is array:
249    checkJson a.len == b.len, $(a.len, b.len, $T)
250    var i = 0
251    for ai in mitems(a):
252      fromJson(ai, b[i], opt)
253      i.inc
254  elif T is set:
255    type E = typeof(for ai in a: ai)
256    for val in b.getElems:
257      incl a, jsonTo(val, E)
258  elif T is seq:
259    a.setLen b.len
260    for i, val in b.getElems:
261      fromJson(a[i], val, opt)
262  elif T is object:
263    template fun(key, typ): untyped {.used.} =
264      if b.hasKey key:
265        jsonTo(b[key], typ)
266      elif hasField(a, key):
267        accessField(a, key)
268      else:
269        default(typ)
270    const keys = getDiscriminants(T)
271    when keys.len == 0:
272      fromJsonFields(a, nil, b, keys, opt)
273    else:
274      if discKeysMatch(a, b, keys):
275        fromJsonFields(a, nil, b, keys, opt)
276      else:
277        var newObj = initCaseObject(T, fun)
278        fromJsonFields(newObj, a, b, keys, opt)
279        a = newObj
280  elif T is tuple:
281    when isNamedTuple(T):
282      fromJsonFields(a, nil, b, seq[string].default, opt)
283    else:
284      checkJson b.kind == JArray, $(b.kind) # we could customize whether to allow JNull
285      var i = 0
286      for val in fields(a):
287        fromJson(val, b[i], opt)
288        i.inc
289      checkJson b.len == i, $(b.len, i, $T, b) # could customize
290  else:
291    # checkJson not appropriate here
292    static: doAssert false, "not yet implemented: " & $T
293
294proc jsonTo*(b: JsonNode, T: typedesc, opt = Joptions()): T =
295  ## reverse of `toJson`
296  fromJson(result, b, opt)
297
298proc toJson*[T](a: T, opt = initToJsonOptions()): JsonNode =
299  ## serializes `a` to json; uses `toJsonHook(a: T)` if it's in scope to
300  ## customize serialization, see strtabs.toJsonHook for an example.
301  ##
302  ## .. note:: With `-d:nimPreviewJsonutilsHoleyEnum`, `toJson` now can
303  ##    serialize/deserialize holey enums as regular enums (via `ord`) instead of as strings.
304  ##    It is expected that this behavior becomes the new default in upcoming versions.
305  when compiles(toJsonHook(a)): result = toJsonHook(a)
306  elif T is object | tuple:
307    when T is object or isNamedTuple(T):
308      result = newJObject()
309      for k, v in a.fieldPairs: result[k] = toJson(v, opt)
310    else:
311      result = newJArray()
312      for v in a.fields: result.add toJson(v, opt)
313  elif T is ref | ptr:
314    template impl =
315      if system.`==`(a, nil): result = newJNull()
316      else: result = toJson(a[], opt)
317    when T is JsonNode:
318      case opt.jsonNodeMode
319      of joptJsonNodeAsRef: result = a
320      of joptJsonNodeAsCopy: result = copy(a)
321      of joptJsonNodeAsObject: impl()
322    else: impl()
323  elif T is array | seq | set:
324    result = newJArray()
325    for ai in a: result.add toJson(ai, opt)
326  elif T is pointer: result = toJson(cast[int](a), opt)
327    # edge case: `a == nil` could've also led to `newJNull()`, but this results
328    # in simpler code for `toJson` and `fromJson`.
329  elif T is distinct: result = toJson(a.distinctBase, opt)
330  elif T is bool: result = %(a)
331  elif T is SomeInteger: result = %a
332  elif T is enum:
333    case opt.enumMode
334    of joptEnumOrd:
335      when T is Ordinal or defined(nimPreviewJsonutilsHoleyEnum): %(a.ord)
336      else: toJson($a, opt)
337    of joptEnumSymbol:
338      when T is OrdinalEnum:
339        toJson(symbolName(a), opt)
340      else:
341        toJson($a, opt)
342    of joptEnumString: toJson($a, opt)
343  elif T is Ordinal: result = %(a.ord)
344  elif T is cstring: (if a == nil: result = newJNull() else: result = % $a)
345  else: result = %a
346
347proc fromJsonHook*[K: string|cstring, V](t: var (Table[K, V] | OrderedTable[K, V]),
348                         jsonNode: JsonNode) =
349  ## Enables `fromJson` for `Table` and `OrderedTable` types.
350  ##
351  ## See also:
352  ## * `toJsonHook proc<#toJsonHook>`_
353  runnableExamples:
354    import std/[tables, json]
355    var foo: tuple[t: Table[string, int], ot: OrderedTable[string, int]]
356    fromJson(foo, parseJson("""
357      {"t":{"two":2,"one":1},"ot":{"one":1,"three":3}}"""))
358    assert foo.t == [("one", 1), ("two", 2)].toTable
359    assert foo.ot == [("one", 1), ("three", 3)].toOrderedTable
360
361  assert jsonNode.kind == JObject,
362          "The kind of the `jsonNode` must be `JObject`, but its actual " &
363          "type is `" & $jsonNode.kind & "`."
364  clear(t)
365  for k, v in jsonNode:
366    t[k] = jsonTo(v, V)
367
368proc toJsonHook*[K: string|cstring, V](t: (Table[K, V] | OrderedTable[K, V])): JsonNode =
369  ## Enables `toJson` for `Table` and `OrderedTable` types.
370  ##
371  ## See also:
372  ## * `fromJsonHook proc<#fromJsonHook,,JsonNode>`_
373  # pending PR #9217 use: toSeq(a) instead of `collect` in `runnableExamples`.
374  runnableExamples:
375    import std/[tables, json, sugar]
376    let foo = (
377      t: [("two", 2)].toTable,
378      ot: [("one", 1), ("three", 3)].toOrderedTable)
379    assert $toJson(foo) == """{"t":{"two":2},"ot":{"one":1,"three":3}}"""
380    # if keys are not string|cstring, you can use this:
381    let a = {10: "foo", 11: "bar"}.newOrderedTable
382    let a2 = collect: (for k,v in a: (k,v))
383    assert $toJson(a2) == """[[10,"foo"],[11,"bar"]]"""
384
385  result = newJObject()
386  for k, v in pairs(t):
387    # not sure if $k has overhead for string
388    result[(when K is string: k else: $k)] = toJson(v)
389
390proc fromJsonHook*[A](s: var SomeSet[A], jsonNode: JsonNode) =
391  ## Enables `fromJson` for `HashSet` and `OrderedSet` types.
392  ##
393  ## See also:
394  ## * `toJsonHook proc<#toJsonHook,SomeSet[A]>`_
395  runnableExamples:
396    import std/[sets, json]
397    var foo: tuple[hs: HashSet[string], os: OrderedSet[string]]
398    fromJson(foo, parseJson("""
399      {"hs": ["hash", "set"], "os": ["ordered", "set"]}"""))
400    assert foo.hs == ["hash", "set"].toHashSet
401    assert foo.os == ["ordered", "set"].toOrderedSet
402
403  assert jsonNode.kind == JArray,
404          "The kind of the `jsonNode` must be `JArray`, but its actual " &
405          "type is `" & $jsonNode.kind & "`."
406  clear(s)
407  for v in jsonNode:
408    incl(s, jsonTo(v, A))
409
410proc toJsonHook*[A](s: SomeSet[A]): JsonNode =
411  ## Enables `toJson` for `HashSet` and `OrderedSet` types.
412  ##
413  ## See also:
414  ## * `fromJsonHook proc<#fromJsonHook,SomeSet[A],JsonNode>`_
415  runnableExamples:
416    import std/[sets, json]
417    let foo = (hs: ["hash"].toHashSet, os: ["ordered", "set"].toOrderedSet)
418    assert $toJson(foo) == """{"hs":["hash"],"os":["ordered","set"]}"""
419
420  result = newJArray()
421  for k in s:
422    add(result, toJson(k))
423
424proc fromJsonHook*[T](self: var Option[T], jsonNode: JsonNode) =
425  ## Enables `fromJson` for `Option` types.
426  ##
427  ## See also:
428  ## * `toJsonHook proc<#toJsonHook,Option[T]>`_
429  runnableExamples:
430    import std/[options, json]
431    var opt: Option[string]
432    fromJsonHook(opt, parseJson("\"test\""))
433    assert get(opt) == "test"
434    fromJson(opt, parseJson("null"))
435    assert isNone(opt)
436
437  if jsonNode.kind != JNull:
438    self = some(jsonTo(jsonNode, T))
439  else:
440    self = none[T]()
441
442proc toJsonHook*[T](self: Option[T]): JsonNode =
443  ## Enables `toJson` for `Option` types.
444  ##
445  ## See also:
446  ## * `fromJsonHook proc<#fromJsonHook,Option[T],JsonNode>`_
447  runnableExamples:
448    import std/[options, json]
449    let optSome = some("test")
450    assert $toJson(optSome) == "\"test\""
451    let optNone = none[string]()
452    assert $toJson(optNone) == "null"
453
454  if isSome(self):
455    toJson(get(self))
456  else:
457    newJNull()
458
459proc fromJsonHook*(a: var StringTableRef, b: JsonNode) =
460  ## Enables `fromJson` for `StringTableRef` type.
461  ##
462  ## See also:
463  ## * `toJsonHook proc<#toJsonHook,StringTableRef>`_
464  runnableExamples:
465    import std/[strtabs, json]
466    var t = newStringTable(modeCaseSensitive)
467    let jsonStr = """{"mode": 0, "table": {"name": "John", "surname": "Doe"}}"""
468    fromJsonHook(t, parseJson(jsonStr))
469    assert t[] == newStringTable("name", "John", "surname", "Doe",
470                                 modeCaseSensitive)[]
471
472  var mode = jsonTo(b["mode"], StringTableMode)
473  a = newStringTable(mode)
474  let b2 = b["table"]
475  for k,v in b2: a[k] = jsonTo(v, string)
476
477proc toJsonHook*(a: StringTableRef): JsonNode =
478  ## Enables `toJson` for `StringTableRef` type.
479  ##
480  ## See also:
481  ## * `fromJsonHook proc<#fromJsonHook,StringTableRef,JsonNode>`_
482  runnableExamples:
483    import std/[strtabs, json]
484    let t = newStringTable("name", "John", "surname", "Doe", modeCaseSensitive)
485    let jsonStr = """{"mode": "modeCaseSensitive",
486                      "table": {"name": "John", "surname": "Doe"}}"""
487    assert toJson(t) == parseJson(jsonStr)
488
489  result = newJObject()
490  result["mode"] = toJson($a.mode)
491  let t = newJObject()
492  for k,v in a: t[k] = toJson(v)
493  result["table"] = t
494