1# peg_to_json.tcl --
2#
3#	Conversion from PEG to 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: pt_peg_to_json.tcl,v 1.1 2010/03/26 05:07:24 andreas_kupries Exp $
11
12# This package takes the canonical serialization of a parsing
13# expression grammar and produces text in JSON format, Java Script
14# data transfer format.
15
16# ### ### ### ######### ######### #########
17## Requisites
18
19package require Tcl 8.5
20package require pt::peg      ; # Verification that the
21					       # input is proper.
22package require json::write
23
24# ### ### ### ######### ######### #########
25##
26
27namespace eval ::pt::peg::to::json {
28    namespace export \
29	reset configure convert
30
31    namespace ensemble create
32}
33
34# ### ### ### ######### ######### #########
35## API.
36
37proc ::pt::peg::to::json::reset {} {
38    variable indented 0
39    variable aligned  0
40    variable name     a_pe_grammar
41    variable file     unknown
42    variable user     unknown
43    return
44}
45
46proc ::pt::peg::to::json::configure {args} {
47    variable indented
48    variable aligned
49    variable name
50    variable file
51    variable user
52
53    if {[llength $args] == 0} {
54	return [list \
55		    -file     $file \
56		    -name     $name \
57		    -user     $user \
58		    -indented $indented \
59		    -aligned  $aligned]
60    } elseif {[llength $args] == 1} {
61	lassign $args option
62	set variable [string range $option 1 end]
63	if {[info exists $variable]} {
64	    return [set $variable]
65	} else {
66	    return -code error "Expected one of -aligned, or -indented, got \"$option\""
67	}
68    } elseif {[llength $args] % 2 == 0} {
69	foreach {option value} $args {
70	    set variable [string range $option 1 end]
71	    if {![info exists $variable]} {
72		return -code error "Expected one of -aligned, or -indented, got \"$option\""
73	    }
74	}
75	foreach {option value} $args {
76	    set variable [string range $option 1 end]
77	    switch -exact -- $variable {
78		indented - aligned {
79		    if {![::string is boolean -strict $value]} {
80			return -code error "Expected boolean, got \"$value\""
81		    }
82		}
83		name -
84		file -
85		user { }
86	    }
87	    set $variable $value
88	}
89    } else {
90	return -code error {wrong#args, expected option value ...}
91    }
92}
93
94proc ::pt::peg::to::json::convert {serial} {
95    variable indented
96    variable aligned
97
98    ::pt::peg verify-as-canonical $serial
99
100    json::write indented $indented
101    json::write aligned  $aligned
102
103    # Unpack the serialization, known as canonical
104    array set peg $serial
105    array set peg $peg(pt::grammar::peg)
106    unset     peg(pt::grammar::peg)
107
108    # Assemble the rules object
109    set rules {}
110    foreach {symbol def} $peg(rules) {
111	lassign $def _ is _ mode
112	lappend rules $symbol \
113	    [json::write object \
114		 is   [json::write string $is] \
115		 mode [json::write string $mode]]
116    }
117
118    # Assemble the final result
119    return [json::write object pt::grammar::peg \
120		[json::write object \
121		     rules [json::write object {*}$rules] \
122		     start [json::write string $peg(start)]]]
123
124    # ### ### ### ######### ######### #########
125}
126
127# ### ### ### ######### ######### #########
128## Configuration
129
130namespace eval ::pt::peg::to::json {
131
132    # Combinations of the format specific entries
133    # I A |
134    # - - + ---------------------
135    # 0 0 | Ultracompact (no whitespace, single line)
136    # 1 0 | Indented
137    # 0 1 | Not possible, per the implications above.
138    # 1 1 | Indented + Tabular aligned keys
139    # - - + ---------------------
140
141    variable indented 0
142    variable aligned  0
143}
144
145# ### ### ### ######### ######### #########
146## Ready
147
148package provide pt::peg::to::json 1
149return
150