1. -- 
  2. -- Copyright (c) 2012 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 Ada.Streams;                       use Ada.Streams; 
  10. with Objects;                           use Objects; 
  11. with Values;                            use Values; 
  12.  
  13. private with Ada.Containers.Indefinite_Ordered_Maps; 
  14. private with Ada.Strings.Less_Case_Insensitive; 
  15.  
  16. package Associations is 
  17.  
  18.     -- An Association is an ordered map of strings to Value objects. Names are 
  19.     -- case insensitive. Associations do not subclass the Value class to avoid 
  20.     -- the possibility of nesting. 
  21.     type Association is new Object with private; 
  22.     type A_Association is access all Association'Class; 
  23.  
  24.     -- Creates a new empty association. 
  25.     function Create_Association return A_Association; 
  26.     pragma Postcondition( Create_Association'Result /= null ); 
  27.  
  28.     -- Returns the named value in the association as a boolean. An exception is 
  29.     -- raised if the value is not found or if it can't be converted to a 
  30.     -- boolean. 
  31.     function As_Boolean( this : not null access Association'Class; 
  32.                          name : String ) return Boolean; 
  33.     pragma Precondition( name'Length > 0 ); 
  34.  
  35.     -- Returns the named value in the association as an integer. An exception is 
  36.     -- raised if the value is not found or if it can't be converted to an 
  37.     -- integer. 
  38.     function As_Integer( this : not null access Association'Class; 
  39.                          name : String ) return Integer; 
  40.     pragma Precondition( name'Length > 0 ); 
  41.  
  42.     -- Returns the named value in the association as a string. An exception is 
  43.     -- raised if the value is not found or if it can't be converted to a string. 
  44.     function As_String( this : not null access Association'Class; 
  45.                         name : String ) return String; 
  46.     pragma Precondition( name'Length > 0 ); 
  47.  
  48.     -- Returns a copy of the named value in the association. Null will be 
  49.     -- returned if the value is not found. 
  50.     function Get_Value( this : not null access Association'Class; 
  51.                         name : String ) return A_Value; 
  52.  
  53.     -- Returns True if 'name' is defined with a value in the association. 
  54.     function Is_Defined( this : not null access Association'Class; 
  55.                          name : String ) return Boolean; 
  56.  
  57.     -- Iterates through the name/value pairs in the association. The iteration 
  58.     -- will be in alphabetical order of names. 
  59.     procedure Iterate( this    : not null access Association'Class; 
  60.                        examine : not null access procedure( name  : String; 
  61.                                                             value : A_Value ) ); 
  62.  
  63.     -- Returns the number of name/value pairs in the assocation. 
  64.     function Length( this : not null access Association'Class ) return Natural; 
  65.  
  66.     -- Reads an Association from a stream. This should not be called directly. 
  67.     function Object_Input( stream : access Root_Stream_Type'Class ) return Association; 
  68.  
  69.     -- Removes the named value from the association. 
  70.     procedure Remove( this : not null access Association'Class; name : String ); 
  71.     pragma Precondition( name'Length > 0 ); 
  72.  
  73.     -- Sets a boolean value in the association by name if it isn't defined. 
  74.     procedure Set_Default( this : not null access Association'Class; 
  75.                            name : String; 
  76.                            val  : Boolean ); 
  77.     pragma Precondition( name'Length > 0 ); 
  78.  
  79.     -- Sets an integer value in the association by name if it isn't defined. 
  80.     procedure Set_Default( this : not null access Association'Class; 
  81.                            name : String; 
  82.                            val  : Integer ); 
  83.     pragma Precondition( name'Length > 0 ); 
  84.  
  85.     -- Sets a string value in the association by name if it isn't defined. 
  86.     procedure Set_Default( this : not null access Association'Class; 
  87.                            name : String; 
  88.                            val  : String ); 
  89.     pragma Precondition( name'Length > 0 ); 
  90.  
  91.     -- Sets a value in the association by name if it isn't defined, consuming 
  92.     -- 'val'. 
  93.     procedure Set_Default( this : not null access Association'Class; 
  94.                            name : String; 
  95.                            val  : in out A_Value ); 
  96.     pragma Precondition( name'Length > 0 ); 
  97.  
  98.     -- Sets a boolean value in the association by name. 
  99.     procedure Set_Value( this : not null access Association'Class; 
  100.                          name : String; 
  101.                          val  : Boolean ); 
  102.     pragma Precondition( name'Length > 0 ); 
  103.  
  104.     -- Sets an integer value in the association by name. 
  105.     procedure Set_Value( this : not null access Association'Class; 
  106.                          name : String; 
  107.                          val  : Integer ); 
  108.     pragma Precondition( name'Length > 0 ); 
  109.  
  110.     -- Sets a string value in the association by name. 
  111.     procedure Set_Value( this : not null access Association'Class; 
  112.                          name : String; 
  113.                          val  : String ); 
  114.     pragma Precondition( name'Length > 0 ); 
  115.  
  116.     -- Sets a value in the association by name, consuming 'val'. 
  117.     procedure Set_Value( this : not null access Association'Class; 
  118.                          name : String; 
  119.                          val  : in out A_Value ); 
  120.     pragma Precondition( name'Length > 0 ); 
  121.     pragma Precondition( val /= null ); 
  122.     pragma Postcondition( val = null ); 
  123.  
  124.     -- Returns a deep copy of the assocation or null of 'src' is null. 
  125.     function Copy( src : A_Association ) return A_Association; 
  126.     pragma Postcondition( Copy'Result /= src or else src = null ); 
  127.  
  128.     -- Deletes the association. 
  129.     procedure Delete( this : in out A_Association ); 
  130.     pragma Postcondition( this = null ); 
  131.  
  132. private 
  133.  
  134.     package Value_Maps is new 
  135.         Ada.Containers.Indefinite_Ordered_Maps( String, A_Value, 
  136.                                                 Ada.Strings.Less_Case_Insensitive, 
  137.                                                 "=" ); 
  138.     use Value_Maps; 
  139.  
  140.     type Association is new Object with 
  141.         record 
  142.             pairs : Value_Maps.Map; 
  143.         end record; 
  144.  
  145.     procedure Adjust( this : access Association ); 
  146.  
  147.     procedure Delete( this : in out Association ); 
  148.  
  149.     -- Object_Input is in the public part of the package. 
  150.     for Association'Input use Object_Input; 
  151.  
  152.     procedure Object_Read( stream : access Root_Stream_Type'Class; 
  153.                            obj    : out Association ); 
  154.     for Association'Read use Object_Read; 
  155.  
  156.     procedure Object_Write( stream : access Root_Stream_Type'Class; 
  157.                             obj    : Association ); 
  158.     for Association'Write use Object_Write; 
  159.  
  160.     -- Returns a string representation of the Association for debugging purposes. 
  161.     -- The string is of the form: {[name:'value'[,name:'value']*]} where the []* 
  162.     -- characters denote multiple possible repetitions of name/value pairs. 
  163.     function To_String( this : access Association ) return String; 
  164.  
  165.     function A_Association_Input( stream : access Root_Stream_Type'Class ) return A_Association; 
  166.     for A_Association'Input use A_Association_Input; 
  167.  
  168.     procedure A_Association_Output( stream : access Root_Stream_Type'Class; 
  169.                                     obj    : A_Association ); 
  170.     for A_Association'Output use A_Association_Output; 
  171.  
  172.     procedure A_Association_Read( stream : access Root_Stream_Type'Class; 
  173.                                   obj    : out A_Association ); 
  174.     for A_Association'Read use A_Association_Read; 
  175.  
  176.     procedure A_Association_Write( stream : access Root_Stream_Type'Class; 
  177.                                    obj    : A_Association ); 
  178.     for A_Association'Write use A_Association_Write; 
  179.  
  180. end Associations;