1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2013-2014, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 4729 $ $Date: 2014-03-18 17:08:32 +0400 (Tue, 18 Mar 2014) $
43------------------------------------------------------------------------------
44with League.JSON.Documents.Internals;
45with League.JSON.Values.Internals;
46with Matreshka.JSON_Documents;
47
48package body League.JSON.Objects is
49
50   ------------
51   -- Adjust --
52   ------------
53
54   overriding procedure Adjust (Self : in out JSON_Object) is
55   begin
56      Matreshka.JSON_Types.Reference (Self.Data);
57   end Adjust;
58
59   --------------
60   -- Contains --
61   --------------
62
63   function Contains
64    (Self : JSON_Object'Class;
65     Key  : League.Strings.Universal_String) return Boolean is
66   begin
67      return Self.Data.Values.Contains (Key);
68   end Contains;
69
70   --------------
71   -- Finalize --
72   --------------
73
74   overriding procedure Finalize (Self : in out JSON_Object) is
75      use type Matreshka.JSON_Types.Shared_JSON_Object_Access;
76
77   begin
78      if Self.Data /= null then
79         Matreshka.JSON_Types.Dereference (Self.Data);
80      end if;
81   end Finalize;
82
83   ------------
84   -- Insert --
85   ------------
86
87   procedure Insert
88    (Self  : in out JSON_Object'Class;
89     Key   : League.Strings.Universal_String;
90     Value : League.JSON.Values.JSON_Value)
91   is
92      New_Value : constant Matreshka.JSON_Types.Shared_JSON_Value_Access
93        := League.JSON.Values.Internals.Internal (Value);
94      Old_Value : Matreshka.JSON_Types.Shared_JSON_Value_Access;
95      Position  : Matreshka.JSON_Types.Value_Maps.Cursor;
96
97   begin
98      Matreshka.JSON_Types.Mutate (Self.Data);
99      Position := Self.Data.Values.Find (Key);
100      Matreshka.JSON_Types.Reference (New_Value);
101
102      if Matreshka.JSON_Types.Value_Maps.Has_Element (Position) then
103         Old_Value := Matreshka.JSON_Types.Value_Maps.Element (Position);
104         Matreshka.JSON_Types.Dereference (Old_Value);
105         Self.Data.Values.Replace_Element (Position, New_Value);
106
107      else
108         Self.Data.Values.Insert (Key, New_Value);
109      end if;
110   end Insert;
111
112   --------------
113   -- Is_Empty --
114   --------------
115
116   function Is_Empty (Self : JSON_Object'Class) return Boolean is
117   begin
118      return Self.Data.Values.Is_Empty;
119   end Is_Empty;
120
121   ----------
122   -- Keys --
123   ----------
124
125   function Keys
126    (Self : JSON_Object'Class)
127       return League.String_Vectors.Universal_String_Vector
128   is
129      Position : Matreshka.JSON_Types.Value_Maps.Cursor
130        := Self.Data.Values.First;
131      Result   : League.String_Vectors.Universal_String_Vector;
132
133   begin
134      while Matreshka.JSON_Types.Value_Maps.Has_Element (Position) loop
135         Result.Append (Matreshka.JSON_Types.Value_Maps.Key (Position));
136         Matreshka.JSON_Types.Value_Maps.Next (Position);
137      end loop;
138
139      return Result;
140   end Keys;
141
142   ------------
143   -- Length --
144   ------------
145
146   function Length (Self : JSON_Object'Class) return Natural is
147   begin
148      return Natural (Self.Data.Values.Length);
149   end Length;
150
151   ------------
152   -- Remove --
153   ------------
154
155   procedure Remove
156    (Self : in out JSON_Object'Class;
157     Key  : League.Strings.Universal_String)
158   is
159      Position  : Matreshka.JSON_Types.Value_Maps.Cursor;
160      Old_Value : Matreshka.JSON_Types.Shared_JSON_Value_Access;
161
162   begin
163      Matreshka.JSON_Types.Mutate (Self.Data);
164      Position := Self.Data.Values.Find (Key);
165
166      if Matreshka.JSON_Types.Value_Maps.Has_Element (Position) then
167         Old_Value := Matreshka.JSON_Types.Value_Maps.Element (Position);
168         Matreshka.JSON_Types.Dereference (Old_Value);
169         Self.Data.Values.Delete (Position);
170      end if;
171   end Remove;
172
173   ----------
174   -- Take --
175   ----------
176
177   function Take
178    (Self : in out JSON_Object'Class;
179     Key  : League.Strings.Universal_String)
180       return League.JSON.Values.JSON_Value
181   is
182      Position  : Matreshka.JSON_Types.Value_Maps.Cursor;
183      Old_Value : Matreshka.JSON_Types.Shared_JSON_Value_Access;
184
185   begin
186      Matreshka.JSON_Types.Mutate (Self.Data);
187      Position := Self.Data.Values.Find (Key);
188
189      if Matreshka.JSON_Types.Value_Maps.Has_Element (Position) then
190         Old_Value := Matreshka.JSON_Types.Value_Maps.Element (Position);
191         Self.Data.Values.Delete (Position);
192
193         return League.JSON.Values.Internals.Wrap (Old_Value);
194
195      else
196         return League.JSON.Values.Empty_JSON_Value;
197      end if;
198   end Take;
199
200   ----------------------
201   -- To_JSON_Document --
202   ----------------------
203
204   function To_JSON_Document
205    (Self : JSON_Object'Class) return League.JSON.Documents.JSON_Document is
206   begin
207      Matreshka.JSON_Types.Reference (Self.Data);
208
209      return
210        League.JSON.Documents.Internals.Wrap
211         (new Matreshka.JSON_Documents.Shared_JSON_Document'
212               (Counter      => <>,
213                Array_Value  => null,
214                Object_Value => Self.Data));
215   end To_JSON_Document;
216
217   -------------------
218   -- To_JSON_Value --
219   -------------------
220
221   function To_JSON_Value
222    (Self : JSON_Object) return League.JSON.Values.JSON_Value is
223   begin
224      Matreshka.JSON_Types.Reference (Self.Data);
225
226      return
227        League.JSON.Values.Internals.Wrap
228         (new Matreshka.JSON_Types.Shared_JSON_Value'
229               (Counter => <>,
230                Value   =>
231                 (Kind         => Matreshka.JSON_Types.Object_Value,
232                  Object_Value => Self.Data)));
233   end To_JSON_Value;
234
235   -----------
236   -- Value --
237   -----------
238
239   function Value
240    (Self : JSON_Object'Class;
241     Key  : League.Strings.Universal_String)
242       return League.JSON.Values.JSON_Value
243   is
244      Position  : constant Matreshka.JSON_Types.Value_Maps.Cursor
245        := Self.Data.Values.Find (Key);
246
247   begin
248      if Matreshka.JSON_Types.Value_Maps.Has_Element (Position) then
249         return
250           League.JSON.Values.Internals.Create
251            (Matreshka.JSON_Types.Value_Maps.Element (Position));
252
253      else
254         return League.JSON.Values.Empty_JSON_Value;
255      end if;
256   end Value;
257
258end League.JSON.Objects;
259