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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295 | -- part of AdaYaml, (c) 2017 Felix Krause
-- released under the terms of the MIT license, see the file "copying.txt"
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Vectors;
with Yaml.Dom.Node;
with Yaml.Dom.Mapping_Data;
with Yaml.Dom.Sequence_Data;
with Yaml.Parser.Stream;
package body Yaml.Dom.Loading is
use type Ada.Containers.Count_Type;
package Anchor_Maps is new Ada.Containers.Indefinite_Hashed_Maps
(Text.Reference, Node_Pointer, Text.Hash, Text."=");
procedure Raw_Append (Container : in out Sequence_Data.Instance;
New_Item : not null access Node.Instance)
with Import, Convention => Ada,
Link_Name => "AdaYaml__Sequence_Data__Raw_Append";
procedure Raw_Insert (Container : in out Mapping_Data.Instance;
Key, Value : not null access Node.Instance)
with Import, Convention => Ada,
Link_Name => "AdaYaml__Mapping_Data__Raw_Insert";
function For_Document (Document : not null access Document_Instance)
return Sequence_Data.Instance with Import,
Convention => Ada, Link_Name => "AdaYaml__Sequence_Data__For_Document";
function For_Document (Document : not null access Document_Instance)
return Mapping_Data.Instance with Import,
Convention => Ada, Link_Name => "AdaYaml__Mapping_Data__For_Document";
type Level_Type is record
Cur, Key : access Node.Instance;
end record;
package Level_Vectors is new Ada.Containers.Vectors (Positive, Level_Type);
package body Stream_Loading is
procedure Read_Document_Content
(Target : not null access Document_Instance;
Input : in out Stream.Instance) is
Anchors : Anchor_Maps.Map;
function Start_Node (E : Event; Is_Finished : out Boolean)
return Node_Pointer is
begin
case E.Kind is
when Scalar =>
Is_Finished := True;
return Ret : constant Node_Pointer :=
new Node.Instance'(Kind => Scalar,
Tag => E.Scalar_Properties.Tag,
Scalar_Style => E.Scalar_Style,
Content => E.Content) do
if E.Scalar_Properties.Anchor.Length /= 0 then
Anchors.Include (E.Scalar_Properties.Anchor, Ret);
end if;
end return;
when Sequence_Start =>
Is_Finished := False;
return Ret : constant Node_Pointer :=
new Node.Instance'(Kind => Sequence,
Tag => E.Collection_Properties.Tag,
Sequence_Style => E.Collection_Style,
Items => For_Document (Target)) do
if E.Collection_Properties.Anchor.Length /= 0 then
Anchors.Include (E.Collection_Properties.Anchor, Ret);
end if;
end return;
when Mapping_Start =>
Is_Finished := False;
return Ret : constant Node_Pointer :=
new Node.Instance'(Kind => Mapping,
Tag => E.Collection_Properties.Tag,
Mapping_Style => E.Collection_Style,
Pairs => For_Document (Target)) do
if E.Collection_Properties.Anchor.Length /= 0 then
Anchors.Include (E.Collection_Properties.Anchor, Ret);
end if;
end return;
when Alias =>
declare
Pos : constant Anchor_Maps.Cursor :=
Anchors.Find (E.Target);
begin
if Anchor_Maps.Has_Element (Pos) then
Is_Finished := True;
return Anchor_Maps.Element (Pos);
else
raise Composer_Error with "Unresolvable alias: " &
E.Target.Value.Data.all;
end if;
end;
when Annotation_Start =>
raise Composer_Error with
"Annotations not implemented for DOM";
when others =>
raise Stream_Error with "Cannot start a node from event: " &
E.Kind'Img;
end case;
end Start_Node;
Is_Finished : Boolean;
Level : Level_Type := (others => null);
Context : Level_Vectors.Vector;
begin
Level.Cur := Start_Node (Stream.Next (Input), Is_Finished);
loop
if Is_Finished then
exit when Context.Length = 0;
declare
Parent : Level_Type := Context.Last_Element;
begin
case Parent.Cur.Kind is
when Sequence =>
Raw_Append (Parent.Cur.Items, Level.Cur);
when Mapping =>
if Parent.Key = null then
Parent.Key := Level.Cur.all'Unchecked_Access;
else
begin
Raw_Insert (Parent.Cur.Pairs, Parent.Key,
Level.Cur);
exception
when Constraint_Error =>
raise Composer_Error with
"Duplicate key in mapping";
end;
Parent.Key := null;
end if;
when Scalar =>
raise Program_Error with
"Internal error: scalar node in DOM context";
end case;
Level := Parent;
Context.Delete_Last;
end;
end if;
declare
E : constant Event := Stream.Next (Input);
begin
case E.Kind is
when Scalar | Sequence_Start | Mapping_Start | Alias |
Annotation_Start =>
Context.Append (Level);
Level := (Cur => Start_Node (E, Is_Finished), Key => null);
when Mapping_End =>
if Level.Cur.Kind /= Mapping then
raise Composer_Error with
"Unexpected mapping end (expected sequence end)";
end if;
if Level.Key /= null then
raise Composer_Error with
"Missing value for key in mapping";
end if;
Is_Finished := True;
when Sequence_End =>
if Level.Cur.Kind /= Sequence then
raise Composer_Error with
"Unexpected sequence end (expected mapping end)";
end if;
Is_Finished := True;
when Annotation_End =>
-- TODO
raise Composer_Error with
"Unexpected annotation end";
when Stream_Start | Document_Start | Document_End |
Stream_End =>
raise Composer_Error with
"Unexpected event inside document: " & E.Kind'Img;
end case;
end;
end loop;
Target.Root_Node := Level.Cur.all'Unchecked_Access;
end Read_Document_Content;
function Load_One (Input : in out Stream.Instance;
Pool : Text.Pool.Reference :=
Text.Pool.With_Capacity (Text.Pool.Default_Size))
return Document_Reference is
Head : Event := Stream.Next (Input);
begin
if Head.Kind /= Stream_Start then
raise Stream_Error with "Unexpected event (expected stream start): " &
Head.Kind'Img;
end if;
Head := Stream.Next (Input);
if Head.Kind /= Document_Start then
raise Stream_Error with
"Unexpected event (expected document start): " & Head.Kind'Img;
end if;
return Ret : constant Document_Reference :=
(Ada.Finalization.Controlled with
Data => new Document_Instance'(Refcount_Base with
Root_Node => null, Pool => Pool,
Implicit_Start => Head.Implicit_Start, Implicit_End => <>)) do
Read_Document_Content (Ret.Data, Input);
Head := Stream.Next (Input);
if Head.Kind /= Document_End then
raise Stream_Error with
"Unexpected event (expected document end): " & Head.Kind'Img;
end if;
Ret.Data.Implicit_End := Head.Implicit_End;
Head := Stream.Next (Input);
case Head.Kind is
when Stream_End => null;
when Document_Start =>
raise Composer_Error with "Unexpected second document in stream";
when others =>
raise Stream_Error with
"Unexpected event (expected stream end): " & Head.Kind'Img;
end case;
end return;
end Load_One;
function Load_All (Input : in out Stream.Instance;
Pool : Text.Pool.Reference :=
Text.Pool.With_Capacity (Text.Pool.Default_Size))
return Vectors.Vector is
Head : Event := Stream.Next (Input);
begin
if Head.Kind /= Stream_Start then
raise Stream_Error with "Unexpected event (expected stream start): " &
Head.Kind'Img;
end if;
Head := Stream.Next (Input);
if Head.Kind /= Document_Start then
raise Stream_Error with
"Unexpected event (expected document start): " & Head.Kind'Img;
end if;
return Ret : Vectors.Vector do
loop
declare
Doc : constant Document_Reference :=
(Document_Reference'(Ada.Finalization.Controlled with
Data => new Document_Instance'(Refcount_Base with
Root_Node => null, Pool => Pool,
Implicit_Start => Head.Implicit_Start,
Implicit_End => <>)));
begin
Read_Document_Content (Doc.Data, Input);
Head := Stream.Next (Input);
if Head.Kind /= Document_End then
raise Stream_Error with
"Unexpected event (expected document end): " & Head.Kind'Img;
end if;
Doc.Data.Implicit_End := Head.Implicit_End;
Ret.Append (Doc);
end;
Head := Stream.Next (Input);
exit when Head.Kind /= Document_Start;
end loop;
if Head.Kind /= Stream_End then
raise Stream_Error with
"Unexpected event (expected stream end): " & Head.Kind'Img;
end if;
end return;
end Load_All;
end Stream_Loading;
package Parser_Loading is new Stream_Loading (Parser.Stream);
function From_Source (Input : Source.Pointer) return Document_Reference is
P : Yaml.Parser.Instance;
begin
P.Set_Input (Input);
return Parser_Loading.Load_One (P, P.Pool);
end From_Source;
function From_Source (Input : Source.Pointer)
return Vectors.Vector is
P : Yaml.Parser.Instance;
begin
P.Set_Input (Input);
return Parser_Loading.Load_All (P, P.Pool);
end From_Source;
function From_String (Input : String) return Document_Reference is
P : Yaml.Parser.Instance;
begin
P.Set_Input (Input);
return Parser_Loading.Load_One (P, P.Pool);
end From_String;
function From_String (Input : String) return Vectors.Vector is
P : Yaml.Parser.Instance;
begin
P.Set_Input (Input);
return Parser_Loading.Load_All (P, P.Pool);
end From_String;
end Yaml.Dom.Loading;
|