1# json_write.tcl --
2#
3#	Commands for the generation of JSON (Java Script Object Notation).
4#
5# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net>
6#
7# See the file "license.terms" for information on usage and redistribution
8# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9#
10# RCS: @(#) $Id: json_write.tcl,v 1.1 2009/11/25 04:41:01 andreas_kupries Exp $
11
12# ### ### ### ######### ######### #########
13## Requisites
14
15package require Tcl 8.5
16
17namespace eval ::json::write {
18    namespace export \
19	string array object indented aligned
20
21    namespace ensemble create
22}
23
24# ### ### ### ######### ######### #########
25## API.
26
27proc ::json::write::indented {{bool {}}} {
28    variable indented
29
30    if {[llength [info level]] > 2} {
31	return -code error {wrong # args: should be "json::write indented ?bool?"}
32    } elseif {[llength [info level 0]] == 2} {
33	if {![::string is boolean -strict $bool]} {
34	    return -code error "Expected boolean, got \"$bool\""
35	}
36	set indented $bool
37	if {!$indented} {
38	    variable aligned 0
39	}
40    }
41
42    return $indented
43}
44
45proc ::json::write::aligned {{bool {}}} {
46    variable aligned
47
48    if {[llength [info level]] > 2} {
49	return -code error {wrong # args: should be "json::write aligned ?bool?"}
50    } elseif {[llength [info level 0]] == 2} {
51	if {![::string is boolean -strict $bool]} {
52	    return -code error "Expected boolean, got \"$bool\""
53	}
54	set aligned $bool
55	if {$aligned} {
56	    variable indented 1
57	}
58    }
59
60    return $aligned
61}
62
63proc ::json::write::string {s} {
64    variable quotes
65    return "\"[::string map $quotes $s]\""
66}
67
68proc ::json::write::array {args} {
69    # always compact form.
70    return "\[[join $args ,]\]"
71}
72
73proc ::json::write::object {args} {
74    # The dict in args maps string keys to json-formatted data. I.e.
75    # we have to quote the keys, but not the values, as the latter are
76    # already in the proper format.
77
78    variable aligned
79    variable indented
80
81    if {[llength $args] %2 == 1} {
82	return -code error {wrong # args, expected an even number of arguments}
83    }
84
85    set dict {}
86    foreach {k v} $args {
87	lappend dict [string $k] $v
88    }
89
90    if {$aligned} {
91	set max [MaxKeyLength $dict]
92    }
93
94    if {$indented} {
95	set content {}
96	foreach {k v} $dict {
97	    if {$aligned} {
98		set k [AlignLeft $max $k]
99	    }
100	    if {[::string match *\n* $v]} {
101		# multi-line value
102		lappend content "    $k : [Indent $v {    } 1]"
103	    } else {
104		# single line value.
105		lappend content "    $k : $v"
106	    }
107	}
108	if {[llength $content]} {
109	    return "\{\n[join $content ,\n]\n\}"
110	} else {
111	    return "\{\}"
112	}
113    } else {
114	# ultra compact form.
115	set tmp {}
116	foreach {k v} $dict {
117	    lappend tmp "$k:$v"
118	}
119	return "\{[join $tmp ,]\}"
120    }
121}
122
123# ### ### ### ######### ######### #########
124## Internals.
125
126proc ::json::write::Indent {text prefix skip} {
127    set pfx ""
128    set result {}
129    foreach line [split $text \n] {
130	if {!$skip} { set pfx $prefix } else { incr skip -1 }
131	lappend result ${pfx}$line
132    }
133    return [join $result \n]
134}
135
136proc ::json::write::MaxKeyLength {dict} {
137    # Find the max length of the keys in the dictionary.
138
139    set lengths 0 ; # This will be the max if the dict is empty, and
140		    # prevents the mathfunc from throwing errors for
141		    # that case.
142
143    foreach str [dict keys $dict] {
144	lappend lengths [::string length $str]
145    }
146
147    return [tcl::mathfunc::max {*}$lengths]
148}
149
150proc ::json::write::AlignLeft {fieldlen str} {
151    return [format %-${fieldlen}s $str]
152    #return $str[::string repeat { } [expr {$fieldlen - [::string length $str]}]]
153}
154
155# ### ### ### ######### ######### #########
156
157namespace eval ::json::write {
158    # Configuration of the layout to write.
159
160    # indented = boolean. objects are indented.
161    # aligned  = boolean. object keys are aligned vertically.
162
163    # aligned  => indented.
164
165    # Combinations of the format specific entries
166    # I A |
167    # - - + ---------------------
168    # 0 0 | Ultracompact (no whitespace, single line)
169    # 1 0 | Indented
170    # 0 1 | Not possible, per the implications above.
171    # 1 1 | Indented + vertically aligned keys
172    # - - + ---------------------
173
174    variable indented 1
175    variable aligned  1
176
177    variable quotes \
178	[list "\"" "\\\"" / \\/ \\ \\\\ \b \\b \f \\f \n \\n \r \\r \t \\t]
179}
180
181# ### ### ### ######### ######### #########
182## Ready
183
184package provide json::write 1
185return
186