1. -- 
  2. -- Copyright (c) 2012-2013 Kevin Wellwood 
  3. -- All rights reserved. 
  4. -- 
  5. -- This source code is distributed under the Modified BSD License. For terms and 
  6. -- conditions, see license.txt. 
  7. -- 
  8.  
  9. with Values.Lists;                      use Values.Lists; 
  10.  
  11. private with Ada.Containers.Indefinite_Ordered_Maps; 
  12.  
  13. package Values.Associations is 
  14.  
  15.     type Assoc_Value is new Value with private; 
  16.     type Assoc_Ptr is new Value_Ptr with private; 
  17.  
  18.     -- Constructor 
  19.     function Create_Assoc return Assoc_Ptr; 
  20.  
  21.     overriding 
  22.     function Clone( this : access Assoc_Value ) return Value_Ptr'Class; 
  23.  
  24.     overriding 
  25.     function Compare( this : Assoc_Value; other : Value'Class ) return Integer; 
  26.  
  27.     overriding 
  28.     function Get_Type( this : Assoc_Value ) return Value_Type; 
  29.  
  30.     overriding 
  31.     function Image( this : Assoc_Value ) return String; 
  32.  
  33.     -- Access and modify the internal value 
  34.  
  35.     -- Returns the corresponding value for the key named 'field', or a Null 
  36.     -- value if the key is not defined. 
  37.     function Get( this : Assoc_Value; field : String ) return Value_Ptr; 
  38.  
  39.     -- Returns True if there are no keys defined in the association. 
  40.     function Is_Empty( this : Assoc_Value ) return Boolean; 
  41.  
  42.     -- Iterates across each key/value pair in the association, calling 'examine' 
  43.     -- once for each pair. The order of the iteration is not defined. 
  44.     procedure Iterate( this    : Assoc_Value; 
  45.                        examine : not null access procedure( key   : String; 
  46.                                                             value : Value_Ptr ) ); 
  47.  
  48.     -- Returns a list of the keys in the association as a list of string values. 
  49.     -- The order of the keys is not defined. 
  50.     function Get_Keys( this : Assoc_Value ) return List_Ptr; 
  51.  
  52.     -- Returns the number of keys in the association. 
  53.     function Size( this : Assoc_Value ) return Natural; 
  54.  
  55.     -- Sets or updates the key named 'field' in the association. If 'val' is a 
  56.     -- null pointer or a Null value then the key will be removed from the 
  57.     -- association. 
  58.     procedure Set( this  : in out Assoc_Value; 
  59.                    field : String; 
  60.                    val   : Value_Ptr'Class ); 
  61.  
  62.     ---------------------------------------------------------------------------- 
  63.  
  64.     -- Casts a Value_Ptr down to an Assoc_Value. Returns Nul on failure. 
  65.     function As_Assoc( ptr : Value_Ptr'Class ) return Assoc_Ptr; 
  66.  
  67.     -- Casts an Assoc_Value up to a Value_Ptr. 
  68.     function As_Value( this : Assoc_Ptr ) return Value_Ptr; 
  69.  
  70.     -- Returns an access to the Assoc_Value, or null if no target. 
  71.     function Get( this : Assoc_Ptr ) return access Assoc_Value'Class; 
  72.  
  73.     Nul : constant Assoc_Ptr; 
  74.  
  75. private 
  76.  
  77.     package Value_Maps is new Ada.Containers.Indefinite_Ordered_Maps( String, Value_Ptr, "<", "=" ); 
  78.  
  79.     type Assoc_Value is new Value with 
  80.         record 
  81.             val : Value_Maps.Map; 
  82.         end record; 
  83.     type A_Naked_Assoc is access all Assoc_Value'Class; 
  84.  
  85.     overriding 
  86.     procedure Delete( this : in out Assoc_Value ); 
  87.  
  88.     overriding 
  89.     function Value_Input( stream : access Root_Stream_Type'Class ) return Assoc_Value; 
  90.     for Assoc_Value'Input use Value_Input; 
  91.  
  92.     overriding 
  93.     procedure Value_Read( stream : access Root_Stream_Type'Class; this : out Assoc_Value ); 
  94.     for Assoc_Value'Read use Value_Read; 
  95.  
  96.     procedure Value_Write( stream : access Root_Stream_Type'Class; this : Assoc_Value ); 
  97.     for Assoc_Value'Write use Value_Write; 
  98.  
  99.  
  100.     -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
  101.  
  102.     type Assoc_Ptr is new Value_Ptr with null record; 
  103.  
  104.     Nul : constant Assoc_Ptr := (Value_Ptr with others => <>); 
  105.  
  106. end Values.Associations;