aboutsummaryrefslogtreecommitdiff
path: root/jsonencode.tcl
blob: 107ab1ab2726a1696d401fb25f75ee8fa5d05e91 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
# Implements 'json::encode'
#
# (c) 2019 Steve Bennett <steveb@workware.net.au>
#
# See LICENCE in this directory for licensing.

# Encode Tcl objects as JSON
# dict -> object
# list -> array
# numeric -> number
# string -> string
#
# The schema provides the type information for the value.
# str = string
# num = numeric (or null)
# bool = boolean
# obj ... = object. parameters are 'name' 'subschema' where the name matches the dict.
# list ... = array. parameters are 'subschema' for the elements of the list/array.
# mixed ... = array of mixed types. parameters are types for each element of the list/array.

# Top level JSON encoder which encodes the given
# value based on the schema
proc json::encode {value {schema str}} {
	json::encode.[lindex $schema 0] $value [lrange $schema 1 end]
}

# Encode a string
proc json::encode.str {value {dummy {}}} {
	# Strictly we should be converting \x00 through \x1F to unicode escapes
	# And anything outside the BMP to a UTF-16 surrogate pair
	return \"[string map [list \\ \\\\ \" \\" \f \\f \n \\n / \\/ \b \\b \r \\r \t \\t] $value]\"
}

# If no type is given, also encode as a string
proc json::encode. {args} {
	tailcall json::encode.str {*}$args
}

# Encode a number
proc json::encode.num {value {dummy {}}} {
	if {$value in {Inf -Inf}} {
		append value inity
	}
	return $value
}

# Encode a boolean
proc json::encode.bool {value {dummy {}}} {
	if {$value} {
		return true
	}
	return false
}

# Encode an object (dictionary)
proc json::encode.obj {obj {schema {}}} {
	set result "\{"
	set sep " "
	foreach k [lsort [dict keys $obj]] {
		if {[dict exists $schema $k]} {
			set type [dict get $schema $k]
		} elseif {[dict exists $schema *]} {
			set type [dict get $schema *]
		} else {
			set type str
		}
		append result $sep\"$k\":

		append result [json::encode.[lindex $type 0] [dict get $obj $k] [lrange $type 1 end]]
		set sep ", "
	}
	append result " \}"
}

# Encode an array (list)
proc json::encode.list {list {type str}} {
	set result "\["
	set sep " "
	foreach l $list {
		append result $sep
		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
		set sep ", "
	}
	append result " \]"
}

# Encode a mixed-type array (list)
# Must be as many types as there are elements of the list
proc json::encode.mixed {list types} {
	set result "\["
	set sep " "
	foreach l $list type $types {
		append result $sep
		append result [json::encode.[lindex $type 0] $l [lrange $type 1 end]]
		set sep ", "
	}
	append result " \]"
}

# vim: se ts=4: