jsonencode.tcl

   1 # Implements 'json::encode'
   2 #
   3 # (c) 2019 Steve Bennett <steveb@workware.net.au>
   4 #
   5 # See LICENCE in this directory for licensing.
   6
   7 # Encode Tcl objects as JSON
   8 # dict -> object
   9 # list -> array
  10 # numeric -> number
  11 # string -> string
  12 #
  13 # The schema provides the type information for the value.
  14 # str = string
  15 # num = numeric (or null)
  16 # bool = boolean
  17 # obj ... = object. parameters are 'name' 'subschema' where the name matches the dict.
  18 # list ... = array. parameters are 'subschema' for the elements of the list/array.
  19 # mixed ... = array of mixed types. parameters are types for each element of the list/array.
  20
  21 # Top level JSON encoder which encodes the given
  22 # value based on the schema
  23 proc json::encode {value {schema str}} {
  24         json::encode.[lindex $schema 0] $value [lrange $schema 1 end]
  25 }
  26
  27 # Encode a string
  28 proc json::encode.str {value {dummy {}}} {
  29         # Strictly we should be converting \x00 through \x1F to unicode escapes
  30         # And anything outside the BMP to a UTF-16 surrogate pair
  31         return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\"
  32 }
  33
  34 # If no type is given, also encode as a string
  35 proc json::encode. {args} {
  36         tailcall json::encode.str {*}$args
  37 }
  38
  39 # Encode a number
  40 proc json::encode.num {value {dummy {}}} {
  41         if {$value in {Inf -Inf}} {
  42                 append value inity
  43         }
  44         return $value
  45 }
  46
  47 # Encode a boolean
  48 proc json::encode.bool {value {dummy {}}} {
  49         if {$value} {
  50                 return true
  51         }
  52         return false
  53 }
  54
  55 # Encode an object (dictionary)
  56 proc json::encode.obj {obj {schema {}}} {
  57         set result "\{"
  58         set sep " "
  59         foreach k [lsort [dict keys $obj]] {
  60                 if {[dict exists $schema $k]} {
  61                         set type [dict get $schema $k]
  62                 } elseif {[dict exists $schema *]} {
  63                         set type [dict get $schema *]
  64                 } else {
  65                         set type str
  66                 }
  67                 append result $sep\"$k\":
  68
  69                 append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]]
  70                 set sep ", "
  71         }
  72         append result " \}"
  73 }
  74
  75 # Encode an array (list)
  76 proc json::encode.list {list {type str}} {
  77         set result "\["
  78         set sep " "
  79         foreach l $list {
  80                 append result $sep
  81                 append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
  82                 set sep ", "
  83         }
  84         append result " \]"
  85 }
  86
  87 # Encode a mixed-type array (list)
  88 # Must be as many types as there are elements of the list
  89 proc json::encode.mixed {list types} {
  90         set result "\["
  91         set sep " "
  92         foreach l $list type $types {
  93                 append result $sep
  94                 append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
  95                 set sep ", "
  96         }
  97         append result " \]"
  98 }
  99
 100 # vim: se ts=4: