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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210 | with Ada.Containers.Ordered_Maps;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Text_IO.Unbounded_IO; use Ada.Text_IO.Unbounded_IO;
with GNATCOLL.JSON; use GNATCOLL.JSON;
with Prettier_Ada.Documents;
with Prettier_Ada.Documents.Json;
with Langkit_Support.Diagnostics; use Langkit_Support.Diagnostics;
with Langkit_Support.Generic_API.Analysis;
use Langkit_Support.Generic_API.Analysis;
with Langkit_Support.Generic_API.Unparsing;
use Langkit_Support.Generic_API.Unparsing;
with Libfoolang.Generic_API; use Libfoolang.Generic_API;
procedure Commands is
Context : constant Lk_Context := Create_Context (Self_Id);
procedure Check (Filename : String; Buffer : String := "var i: Int = 0;");
procedure Reset_Ids (Value : JSON_Value);
-- Ids in prettier are generated with a process-wide counter. To avoid
-- interference between tests, we use this procedure to renumber Ids for a
-- given document.
-----------
-- Check --
-----------
procedure Check (Filename : String; Buffer : String := "var i: Int = 0;") is
Unit : constant Lk_Unit := Context.Get_From_Buffer
(Filename => "foo.txt", Buffer => Buffer);
Config : Unparsing_Configuration;
Doc : Prettier_Ada.Documents.Document_Type;
JSON : JSON_Value;
JSON_Text : Unbounded_String;
begin
Put_Line ("== " & Filename & " ==");
New_Line;
if Unit.Has_Diagnostics then
for D of Unit.Diagnostics loop
Put_Line (Unit.Format_GNU_Diagnostic (D));
end loop;
raise Program_Error;
end if;
declare
Diagnostics : Diagnostics_Vectors.Vector;
begin
Config := Load_Unparsing_Config (Self_Id, Filename, Diagnostics);
if Config = No_Unparsing_Configuration then
Print (Diagnostics);
raise Program_Error;
end if;
end;
Doc := Unparse_To_Prettier (Unit.Root, Config);
JSON_Text := Prettier_Ada.Documents.Json.Serialize (Doc);
-- Remove "id" fields from the JSON representation, for output stability
JSON := GNATCOLL.JSON.Read (JSON_Text);
Reset_Ids (JSON);
JSON_Text := JSON.Write (Compact => False);
Put_Line (JSON_Text);
New_Line;
end Check;
---------------
-- Reset_Ids --
---------------
procedure Reset_Ids (Value : JSON_Value) is
package Id_Maps is new Ada.Containers.Ordered_Maps
(Key_Type => Integer, Element_Type => Integer);
Id_Map : Id_Maps.Map;
procedure Process (Name : String; Value : JSON_Value);
procedure Renumber (Object : JSON_Value; Name : String);
procedure Recurse (Value : JSON_Value);
-------------
-- Process --
-------------
procedure Process (Name : String; Value : JSON_Value) is
pragma Unreferenced (Name);
begin
Recurse (Value);
end Process;
--------------
-- Renumber --
--------------
procedure Renumber (Object : JSON_Value; Name : String) is
begin
if Object.Has_Field (Name) then
declare
Old_Id : constant Integer := Object.Get (Name);
New_Id : Integer;
begin
if Old_Id = 0 then
Object.Unset_Field (Name);
else
if Id_Map.Contains (Old_Id) then
New_Id := Id_Map.Element (Old_Id);
else
New_Id := Integer (Id_Map.Length) + 1;
Id_Map.Insert (Old_Id, New_Id);
end if;
Object.Set_Field (Name, New_Id);
end if;
end;
end if;
end Renumber;
-------------
-- Recurse --
-------------
procedure Recurse (Value : JSON_Value) is
begin
case Value.Kind is
when JSON_Object_Type =>
Renumber (Value, "id");
Renumber (Value, "ifBreakGroupId");
Value.Map_JSON_Object (Process'Access);
when JSON_Array_Type =>
for V of JSON_Array'(Value.Get) loop
Recurse (V);
end loop;
when others =>
return;
end case;
end Recurse;
begin
Recurse (Value);
end Reset_Ids;
begin
Check ("cmd_align.json");
Check ("cmd_align2.json");
Check ("cmd_breakparent.json");
Check ("cmd_dedent.json");
Check ("cmd_dedenttoroot.json");
Check ("cmd_emptytablesep.json", "var v1: T = 0; var v2: T = 1;");
Check ("cmd_fill.json");
Check
("cmd_no_flush_line_breaks.json",
"var v: T =" & ASCII.LF & ASCII.LF & "0;");
Check
("cmd_flush_line_breaks.json",
"var v: T =" & ASCII.LF & ASCII.LF & "0;");
Check ("cmd_group.json");
Check ("cmd_group_id.json", "var v1: T = 0; var v2: T = 1;");
Check ("cmd_group_id2.json", "var v1: T = 0; var v2: T = 1;");
Check ("cmd_group_id3.json", "");
Check ("cmd_hardline.json");
Check ("cmd_hardlinewithoutbreakparent.json");
Check ("cmd_ifbreak.json");
Check ("cmd_ifempty.json", "def f(): Int {i;}");
Check ("cmd_ifempty.json", "def f(i: Int): Int {i;}");
Check ("cmd_ifkind.json", "var i: Int = 2+2;");
Check ("cmd_ifkind.json", "var i: Int = 2+j;");
Check ("cmd_ifkind2.json", "var i: Int = 2+j;");
Check ("cmd_ifkind3.json", "var i: Int = 2+j;");
Check ("cmd_ifkind4.json", "var v:Int=f(1);");
Check ("cmd_ifkind5.json", "var v:Int=f(1);");
Check ("cmd_ifkind6.json", "null var v1:T=1; var v2:T=2;");
Check ("cmd_indent.json");
Check ("cmd_line.json");
Check ("cmd_list.json");
Check ("cmd_literalline.json");
Check ("cmd_markasroot.json");
Check ("cmd_innerroot.json");
Check ("cmd_continuationlineindent.json");
Check ("cmd_recurse.json");
Check
("cmd_recurse_in_field.json",
"var v:Int=f(a=1);");
Check
("cmd_recurse_field.json",
"var i: Int = 0;" & ASCII.LF
& "def f(i: Int): Int {i;}");
Check
("cmd_recurse_flatten.json",
"var i: Int = AAAAAAAAAAAAAAAAAA"
& "(XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
& ".YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY"
& ".ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ)"
& ".DDDDDDDDDDDDDDDD"
& ".EEEEEEEEEEEEEEEE"
& ".FFFFFFFFFFFFFFFF"
& ".GGGGGGGGGGGGGGGG;");
Check ("cmd_softline.json");
Check ("cmd_trim.json");
Check ("cmd_whitespace_3.json");
Check ("cmd_whitespace_default.json");
Put_Line ("Done.");
end Commands;
|