vss_24.0.0_b4d0be7c/tools/json_schema/json_schema.ads

  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
--
--  Copyright (C) 2022-2023, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

--  JSON Schema types for Draft 4 - Draft 6 JSON Schema specification

with Ada.Containers.Vectors;

with VSS.Strings;
with VSS.String_Vectors;
with VSS.JSON;
with VSS.JSON.Streams;

package JSON_Schema is
   pragma Preelaborate;

   type Schema is tagged;
   --  Core schema meta-schema

   type Schema_Access is access all Schema;

   package Definitions is
      package Schema_Vectors is new Ada.Containers.Vectors
        (Positive, Schema_Access);

      type Schema_Array is new Schema_Vectors.Vector with null record;
      --  Min_Items = 1 ???

      type Non_Negative_Integer is new Integer range 0 .. Integer'Last;

      type Non_Negative_Integer_Default_0 is new Non_Negative_Integer
        with Default_Value => 0;

      type Simple_Types is
        (An_Array,
         A_Boolean,
         An_Integer,
         A_Null,
         A_Number,
         An_Object,
         A_String);

      type String_Array is new VSS.String_Vectors.Virtual_String_Vector
        with null record;
      --  uniqueItems = True
   end Definitions;

   type String_Or_Schema (Is_String : Boolean := False) is record
      case Is_String is
         when True =>
            String : VSS.Strings.Virtual_String;
         when False =>
            Schema  : JSON_Schema.Schema_Access;
      end case;
   end record;

   type Property is record
      Name   : VSS.Strings.Virtual_String;
      Schema : Schema_Access;
   end record;

   package Property_Vectors is new Ada.Containers.Vectors (Positive, Property);

   package Simple_Type_Vectors is new Ada.Containers.Vectors
     (Positive, Definitions.Simple_Types, Definitions."=");

   package JSON_Event_Vectors is new Ada.Containers.Vectors
     (Positive, VSS.JSON.Streams.JSON_Stream_Element, VSS.JSON.Streams."=");

   type JSON_Value is new JSON_Event_Vectors.Vector with null record;
   --  Any JSON values.

   type JSON_Value_Array is new JSON_Event_Vectors.Vector with null record;
   --  Array of JSON values.

   subtype URI is VSS.Strings.Virtual_String;
   --  An absolute URI (starting with a scheme)

   subtype URI_Reference is VSS.Strings.Virtual_String;
   --  A relative path, fragment, or any other style of URI Reference
   --  (per RFC 3986) is allowable

   type Schema is tagged limited record
      Id                 : URI_Reference;  --  $id (id in Draft 4)
      Schema             : URI;  --  $schema
      Ref                : URI_Reference; --  $ref
      Comment            : VSS.Strings.Virtual_String;  --  $comment (since 7)
      Title              : VSS.Strings.Virtual_String;
      Description        : VSS.Strings.Virtual_String;
      Default            : JSON_Value;
      Read_Only          : Boolean := False;  --  since Draft 7
      Write_Only         : Boolean := False;  --  since Draft 7
      Examples           : JSON_Value_Array;  --  since Draft 6
      Multiple_Of        : VSS.JSON.JSON_Number;
      Maximum            : VSS.JSON.JSON_Number;
      Exclusive_Maximum  : VSS.JSON.JSON_Number;
      Minimum            : VSS.JSON.JSON_Number;
      Exclusive_Minimum  : VSS.JSON.JSON_Number;
      Max_Length         : Definitions.Non_Negative_Integer :=
                            Definitions.Non_Negative_Integer'Last;
      Min_Length         : Definitions.Non_Negative_Integer_Default_0;
      Pattern            : VSS.Strings.Virtual_String;  --  regexp?
      Additional_Items   : Schema_Access;
      Items              : Definitions.Schema_Array;  --  if a single Schema?
      Max_Items          : Definitions.Non_Negative_Integer :=
                            Definitions.Non_Negative_Integer'Last;
      Min_Items          : Definitions.Non_Negative_Integer_Default_0 := 0;
      Unique_Items       : Boolean := False;
      Contains           : Schema_Access;  --  since Draft 6
      Max_Properties     : Definitions.Non_Negative_Integer :=
                            Definitions.Non_Negative_Integer'Last;
      Min_Properties     : Definitions.Non_Negative_Integer_Default_0 := 0;
      Required           : Definitions.String_Array;

      Additional_Properties : Schema_Access;

      Properties         : Property_Vectors.Vector;
      Pattern_Properties : Property_Vectors.Vector;
      --  propertyNames": { "format": "regex" }

      Dependencies       : String_Or_Schema;
      Property_Names     : Schema_Access;  --  since Draft 6
      Const              : JSON_Event_Vectors.Vector;  --  since Draft 6
      Enum               : Definitions.String_Array;  --  May by not a strings?
      Kind               : Simple_Type_Vectors.Vector;  -- "type"
      Format             : VSS.Strings.Virtual_String;
      Content_Media_Type : VSS.Strings.Virtual_String;  --  since Draft 7
      Content_Encoding   : VSS.Strings.Virtual_String;  --  since Draft 7
      If_Schema          : Schema_Access;  --  since Draft 7
      Then_Schema        : Schema_Access;  --  since Draft 7
      Else_Schema        : Schema_Access;  --  since Draft 7
      All_Of             : Definitions.Schema_Array;
      Any_Of             : Definitions.Schema_Array;
      One_Of             : Definitions.Schema_Array;
      Negate             : Schema_Access;
   end record;
   --  Default: `{}` or `True`

   function Is_True (Self : Schema'Class) return Boolean;
   --  Check if given schema is "True". Than means it equals to `{}` JSON.

   function Is_False (Self : Schema'Class) return Boolean;
   --  Check if given schema is "False". Than means it equals to `not {}` JSON.
end JSON_Schema;