awa_2.4.0_59135a52/dynamo/src/gen-artifacts-yaml.adb

-----------------------------------------------------------------------
--  gen-artifacts-yaml -- Query artifact for Code Generator
--  Copyright (C) 2018, 2019, 2021, 2022 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Exceptions;
with Ada.Text_IO;

with Util.Strings;
with Util.Beans.Objects;

with Text;
with Yaml.Source.File;
with Yaml.Parser;

with Gen.Model.Enums;
with Gen.Model.Tables;
with Gen.Model.Mappings;

with Util.Log.Loggers;
with Util.Stacks;

use Yaml;

package body Gen.Artifacts.Yaml is

   use Ada.Strings.Unbounded;
   use Gen.Model;
   use Gen.Model.Tables;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Artifacts.Yaml");

   type State_Type is (IN_ROOT,
                       IN_TYPE,
                       IN_TABLE,
                       IN_COLUMNS,
                       IN_ONE_TO_MANY,
                       IN_ENUM,
                       IN_ENUM_VALUES,
                       IN_KEYS,
                       IN_COLUMN,
                       IN_ASSOCIATION,
                       IN_KEY,
                       IN_GENERATOR,
                       IN_UNKNOWN);

   type Node_Info is record
      State    : State_Type := IN_UNKNOWN;
      Name     : Text.Reference;
      Tag      : Text.Reference;
      Has_Name : Boolean := False;
      Enum     : Gen.Model.Enums.Enum_Definition_Access;
      Table    : Gen.Model.Tables.Table_Definition_Access;
      Col      : Gen.Model.Tables.Column_Definition_Access;
      Assoc    : Gen.Model.Tables.Association_Definition_Access;
   end record;

   type Node_Info_Access is access all Node_Info;

   package Node_Stack is new Util.Stacks (Element_Type        => Node_Info,
                                          Element_Type_Access => Node_Info_Access);
   --  Read the UML/XMI model file.
   procedure Read_Model (Handler       : in out Artifact;
                         File          : in String;
                         Model         : in out Gen.Model.Packages.Model_Definition;
                         Context       : in out Generator'Class) is
      pragma Unreferenced (Handler);

      procedure Process_Mapping (Model : in out Gen.Model.Packages.Model_Definition;
                                 Stack : in out Node_Stack.Stack;
                                 File  : in String;
                                 Loc   : in Mark);

      procedure Read_Scalar (Node    : in Node_Info_Access;
                             Name    : in String;
                             Value   : in String;
                             Loc     : in Mark);

      procedure Read_Scalar (Node    : in Node_Info_Access;
                             Name    : in String;
                             Value   : in String;
                             Loc     : in Mark) is

         use type Gen.Model.Enums.Enum_Definition_Access;

         function Location return String is
           (File & ":" & Util.Strings.Image (Loc.Line) & ":"
            & Util.Strings.Image (Loc.Column));

         New_Value : Gen.Model.Enums.Value_Definition_Access;
      begin
         case Node.State is
         when IN_TYPE =>
            if Name = "type" then
               if Value = "enum" then
                  Node.Enum := Gen.Model.Enums.Create_Enum (Node.Tag);
                  Node.Enum.Set_Location (Location);
                  Node.State := IN_ENUM;
                  Model.Register_Enum (Node.Enum);
               else
                  Node.Table := Gen.Model.Tables.Create_Table (Node.Tag);
                  Node.Table.Set_Location (Location);
                  Node.State := IN_TABLE;
                  Model.Register_Table (Node.Table);
               end if;
            end if;

         when IN_TABLE =>
            if Node.Table = null then
               return;
            end if;

            Log.Debug ("Set table {0} attribute {1}={2}", Node.Table.Name, Name, Value);
            if Name = "table" then
               Node.Table.Table_Name := To_UString (Value);
            elsif Name = "description" or else Name = "comment" then
               Node.Table.Set_Comment (Value);
            elsif Name = "hasList" then
               Node.Table.Has_List := Value in "true" | "yes";
            end if;

         when IN_COLUMN | IN_KEY | IN_ASSOCIATION =>
            if Node.Col = null then
               return;
            end if;

            Log.Debug ("Set table column {0} attribute {1}={2}", Node.Col.Name, Name, Value);
            if Name = "type" then
               Node.Col.Set_Type (Value);
            elsif Name = "length" then
               Node.Col.Set_Sql_Length (Value, Context);
            elsif Name = "column" then
               Node.Col.Sql_Name := To_UString (Value);
            elsif Name = "unique" then
               Node.Col.Unique := Value in "true" | "yes";
            elsif Name = "nullable" or else Name = "optional" then
               Node.Col.Not_Null := Value in "false" | "no";
            elsif Name = "not-null" or else Name = "required" then
               Node.Col.Not_Null := Value in "true" | "yes";
            elsif Name = "description" or else Name = "comment" then
               Node.Col.Set_Comment (Value);
            elsif Name = "version" then
               Node.Col.Is_Version := Value in "true" | "yes";
            elsif Name = "readonly" then
               Node.Col.Is_Updated := Value in "false" | "no";
            elsif Name = "auditable" then
               Node.Col.Is_Auditable := Value in "true" | "yes";
            elsif Name = "useForeignKey" and then Node.Assoc /= null then
               Node.Assoc.Use_Foreign_Key_Type := Value in "true" | "yes";
            end if;

         when IN_GENERATOR =>
            if Node.Col = null then
               return;
            end if;
            if Name = "strategy" then
               Node.Col.Generator := Util.Beans.Objects.To_Object (Value);
            end if;

         when IN_ENUM_VALUES =>
            if Node.Enum = null then
               return;
            end if;
            Node.Enum.Add_Value (Name, New_Value);
            New_Value.Set_Location (Location);
            New_Value.Number := Natural'Value (Value);

         when others =>
            Log.Error ("Scalar {0}: {1} not handled", Name, Value);
         end case;
      end Read_Scalar;

      procedure Process_Mapping (Model    : in out Gen.Model.Packages.Model_Definition;
                                 Stack    : in out Node_Stack.Stack;
                                 File     : in String;
                                 Loc      : in Mark) is
         pragma Unreferenced (Model);

         function Location return String is
           (File & ":" & Util.Strings.Image (Loc.Line) & ":"
            & Util.Strings.Image (Loc.Column));

         Node     : Node_Info_Access;
         New_Node : Node_Info_Access;
      begin
         Node := Node_Stack.Current (Stack);
         if Node.Has_Name then
            Node.Has_Name := False;
            case Node.State is
            when IN_ROOT =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Tag := Node.Name;
               New_Node.State := IN_TYPE;

            when IN_TABLE =>
               if Node.Name = "fields" or else Node.Name = "properties" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_COLUMNS;

               elsif Node.Name = "id" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_KEYS;

               elsif Node.Name = "oneToMany" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_ONE_TO_MANY;

               else
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_TABLE;
               end if;

            when IN_COLUMNS =>
               Node.Table.Add_Column (Node.Name, Node.Col);
               Node.Col.Set_Location (Location);
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_COLUMN;

            when IN_ONE_TO_MANY =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_ASSOCIATION;
               Node.Table.Add_Association (Node.Name, New_Node.Assoc);
               New_Node.Assoc.Set_Location (Location);
               New_Node.Col := New_Node.Assoc.all'Access;

            when IN_KEYS =>
               Node.Table.Add_Column (Node.Name, Node.Col);
               Node.Col.Set_Location (Location);
               Node.Col.Is_Key := True;
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.Table := Node.Table;
               New_Node.State := IN_KEY;

            when IN_KEY =>
               if Node.Name = "generator" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.Col := Node.Col;
                  New_Node.State := IN_GENERATOR;
               end if;

            when IN_ENUM =>
               if Node.Name = "values" then
                  Node_Stack.Push (Stack);
                  New_Node := Node_Stack.Current (Stack);
                  New_Node.Table := Node.Table;
                  New_Node.State := IN_ENUM_VALUES;
               end if;

            when others =>
               Node_Stack.Push (Stack);
               New_Node := Node_Stack.Current (Stack);
               New_Node.State := IN_UNKNOWN;

            end case;
         else
            Node_Stack.Push (Stack);

         end if;
      end Process_Mapping;

      Input : Source.Pointer;
      P     : Parser.Instance;
      Cur   : Event;
      Stack : Node_Stack.Stack;
      Node  : Node_Info_Access;
      Loc   : Mark;
   begin
      Log.Info ("Reading YAML file {0}", File);

      Input := Source.File.As_Source (File);
      P.Set_Input (Input);
      loop
         Cur := P.Next;
         exit when Cur.Kind = Stream_End;
         case Cur.Kind is
            when Stream_Start | Document_Start =>
               Node_Stack.Push (Stack);
               Node := Node_Stack.Current (Stack);
               Node.State := IN_ROOT;

            when Stream_End | Document_End =>
               Node_Stack.Pop (Stack);

            when Alias =>
               null;

            when Scalar =>
               Node := Node_Stack.Current (Stack);
               if Node.Has_Name then
                  Read_Scalar (Node, To_String (Node.Name), To_String (Cur.Content),
                               P.Current_Lexer_Token_Start);
                  Node.Has_Name := False;
               else
                  Node.Name := Cur.Content;
                  Node.Has_Name := True;
               end if;

            when Sequence_Start =>
               Node_Stack.Push (Stack);

            when Sequence_End =>
               Node_Stack.Pop (Stack);

            when Mapping_Start =>
               Process_Mapping (Model, Stack, File, P.Current_Lexer_Token_Start);

            when Mapping_End =>
               Node_Stack.Pop (Stack);

            when Annotation_Start =>
               null;

            when Annotation_End =>
               null;

         end case;
      end loop;

   exception
      when E : others =>
         Loc := P.Current_Lexer_Token_Start;
         Context.Error ("{0}: {1}", Util.Strings.Image (Loc.Line) & ":"
                        & Util.Strings.Image (Loc.Column) & ": ",
                        Ada.Exceptions.Exception_Message (E));
   end Read_Model;

   --  ------------------------------
   --  Save the model in a YAML file.
   --  ------------------------------
   procedure Save_Model (Handler : in Artifact;
                         Path    : in String;
                         Model   : in out Gen.Model.Packages.Model_Definition'Class;
                         Context : in out Generator'Class) is
      pragma Unreferenced (Handler, Context);

      procedure Write_Description (Comment : in Util.Beans.Objects.Object;
                                   Indent  : in Ada.Text_IO.Count);
      procedure Write_Field (Item  : in Gen.Model.Definition'Class;
                             Name  : in String);
      procedure Write_Column (Col : in Gen.Model.Tables.Column_Definition'Class);
      procedure Write_Association (Col : in Gen.Model.Tables.Association_Definition'Class);

      procedure Process_Table (Table : in out Gen.Model.Tables.Table_Definition);
      procedure Process_Enum (Enum : in out Gen.Model.Enums.Enum_Definition);

      File : Ada.Text_IO.File_Type;

      --  Write a description field taking into account multi-lines.
      procedure Write_Description (Comment : in Util.Beans.Objects.Object;
                                   Indent  : in Ada.Text_IO.Count) is
         use type Ada.Text_IO.Count;

         Content     : constant String := Util.Beans.Objects.To_String (Comment);
         Pos, Start  : Positive := Content'First;
      begin
         Ada.Text_IO.Set_Col (File, Indent);
         Ada.Text_IO.Put (File, "description: ");
         if Util.Strings.Index (Content, ASCII.LF) > 0
           or else Util.Strings.Index (Content, ASCII.CR) > 0
         then
            Start := Content'First;
            Pos   := Content'First;
            Ada.Text_IO.Put_Line (File, "|");
            while Pos <= Content'Last loop
               if Content (Pos) in ASCII.CR | ASCII.LF then
                  Ada.Text_IO.Set_Col (File, Indent + 2);
                  Ada.Text_IO.Put_Line (File, Content (Start .. Pos - 1));
                  Start := Pos + 1;
               end if;
               Pos := Pos + 1;
            end loop;
            if Start < Pos then
               Ada.Text_IO.Set_Col (File, Indent + 2);
               Ada.Text_IO.Put_Line (File, Content (Start .. Pos - 1));
            end if;
         else
            Ada.Text_IO.Put (File, Content);
         end if;
         Ada.Text_IO.New_Line (File);
      end Write_Description;

      procedure Write_Field (Item  : in Gen.Model.Definition'Class;
                             Name  : in String) is
         Value : constant Util.Beans.Objects.Object := Item.Get_Value (Name);
      begin
         Ada.Text_IO.Put_Line (File, Util.Beans.Objects.To_String (Value));
      end Write_Field;

      procedure Write_Column (Col : in Gen.Model.Tables.Column_Definition'Class) is
         use type Gen.Model.Mappings.Mapping_Definition_Access;

         Col_Type : Gen.Model.Mappings.Mapping_Definition_Access;
      begin
         Col_Type := Col.Get_Type_Mapping;
         Ada.Text_IO.Put (File, "    ");
         Ada.Text_IO.Put (File, Col.Get_Name);
         Ada.Text_IO.Put_Line (File, ":");
         Ada.Text_IO.Put (File, "      type: ");
         if Col_Type /= null then
            Ada.Text_IO.Put (File, Col_Type.Get_Type_Name);
         end if;
         Ada.Text_IO.New_Line (File);
         if Col.Is_Variable_Length then
            Ada.Text_IO.Put (File, "      length:");
            Ada.Text_IO.Put_Line (File, Positive'Image (Col.Sql_Length));
         end if;
         Ada.Text_IO.Put (File, "      column: ");
         Write_Field (Col, "sqlName");
         if Col_Type /= null and then Col_Type.Nullable then
            Ada.Text_IO.Put_Line (File, "      nullable: true");
         end if;
         Ada.Text_IO.Put (File, "      not-null: ");
         Ada.Text_IO.Put_Line (File, (if Col.Not_Null then "true" else "false"));
         if Col.Is_Version then
            Ada.Text_IO.Put_Line (File, "      version: true");
         end if;
         if not Col.Is_Updated then
            Ada.Text_IO.Put_Line (File, "      readonly: true");
         end if;
         if Col.Is_Auditable then
            Ada.Text_IO.Put_Line (File, "      auditable: true");
         end if;
         Ada.Text_IO.Put (File, "      unique: ");
         Ada.Text_IO.Put_Line (File, (if Col.Unique then "true" else "false"));
         Write_Description (Col.Get_Comment, 7);
      end Write_Column;

      procedure Write_Association (Col : in Gen.Model.Tables.Association_Definition'Class) is
         use type Gen.Model.Mappings.Mapping_Definition_Access;

         Col_Type : Gen.Model.Mappings.Mapping_Definition_Access;
      begin
         Col_Type := Col.Get_Type_Mapping;
         Ada.Text_IO.Put (File, "    ");
         Ada.Text_IO.Put (File, Col.Get_Name);
         Ada.Text_IO.Put_Line (File, ":");
         Ada.Text_IO.Put (File, "      type: ");
         if Col_Type /= null then
            Ada.Text_IO.Put (File, Col_Type.Get_Type_Name);
         end if;
         Ada.Text_IO.New_Line (File);
         if Col.Is_Variable_Length then
            Ada.Text_IO.Put (File, "      length:");
            Ada.Text_IO.Put_Line (File, Positive'Image (Col.Sql_Length));
         end if;
         Ada.Text_IO.Put (File, "      column: ");
         Write_Field (Col, "sqlName");
         if Col_Type /= null and then Col_Type.Nullable then
            Ada.Text_IO.Put_Line (File, "      nullable: true");
         end if;
         Ada.Text_IO.Put (File, "      not-null: ");
         Ada.Text_IO.Put_Line (File, (if Col.Not_Null then "true" else "false"));
         if not Col.Is_Updated then
            Ada.Text_IO.Put_Line (File, "      readonly: true");
         end if;
         if Col.Is_Auditable then
            Ada.Text_IO.Put_Line (File, "      auditable: true");
         end if;
         if Col.Use_Foreign_Key_Type then
            Ada.Text_IO.Put_Line (File, "      useForeignKey: true");
         end if;
         Ada.Text_IO.Put (File, "      unique: ");
         Ada.Text_IO.Put_Line (File, (if Col.Unique then "true" else "false"));
         Write_Description (Col.Get_Comment, 7);
      end Write_Association;

      procedure Process_Table (Table : in out Gen.Model.Tables.Table_Definition) is
      begin
         Ada.Text_IO.Put (File, Table.Get_Name);
         Ada.Text_IO.Put_Line (File, ":");
         Ada.Text_IO.Put_Line (File, "  type: entity");
         Ada.Text_IO.Put (File, "  table: ");
         Write_Field (Table, "sqlName");
         Write_Description (Table.Get_Comment, 3);
         Ada.Text_IO.Put (File, "  hasList: ");
         Ada.Text_IO.Put_Line (File, (if Table.Has_List then "true" else "false"));
         Ada.Text_IO.Put (File, "  indexes: ");
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, "  id: ");
         Ada.Text_IO.New_Line (File);

         for Col of Table.Members loop
            if Col.Is_Key then
               Write_Column (Col.all);
            end if;
         end loop;

         Ada.Text_IO.Put (File, "  fields: ");
         Ada.Text_IO.New_Line (File);

         for Col of Table.Members loop
            if not Col.Is_Key and then
              not (Col.all in Gen.Model.Tables.Association_Definition'Class)
            then
               Write_Column (Col.all);
            end if;
         end loop;

         if Table.Has_Associations then
            Ada.Text_IO.Put_Line (File, "  oneToMany:");
            for Col of Table.Members loop
               if Col.all in Gen.Model.Tables.Association_Definition'Class then
                  Write_Association (Gen.Model.Tables.Association_Definition'Class (Col.all));
               end if;
            end loop;
         end if;
      end Process_Table;

      procedure Process_Enum (Enum : in out Gen.Model.Enums.Enum_Definition) is
      begin
         Ada.Text_IO.Put (File, Enum.Get_Name);
         Ada.Text_IO.Put_Line (File, ":");
         Ada.Text_IO.Put_Line (File, "  type: enum");
         Ada.Text_IO.Put (File, "  values: ");
         Ada.Text_IO.New_Line (File);

         for Value of Enum.Values loop
            Ada.Text_IO.Put (File, "    ");
            Ada.Text_IO.Put (File, Value.Get_Name);
            Ada.Text_IO.Put (File, ":");
            Ada.Text_IO.Put_Line (File, Natural'Image (Value.Number));
         end loop;
      end Process_Enum;

   begin
      Ada.Text_IO.Create (File, Ada.Text_IO.Out_File, Path);
      Model.Iterate_Enums (Process_Enum'Access);
      Model.Iterate_Tables (Process_Table'Access);
      Ada.Text_IO.Close (File);
   end Save_Model;

   --  ------------------------------
   --  Prepare the generation of the package:
   --  o identify the column types which are used
   --  o build a list of package for the with clauses.
   --  ------------------------------
   overriding
   procedure Prepare (Handler : in out Artifact;
                      Model   : in out Gen.Model.Packages.Model_Definition'Class;
                      Project : in out Gen.Model.Projects.Project_Definition'Class;
                      Context : in out Generator'Class) is
      pragma Unreferenced (Project);
   begin
      Log.Debug ("Saving the model in YAML");

      Handler.Save_Model (Path    => "model.yaml",
                          Model   => Model,
                          Context => Context);
   end Prepare;

end Gen.Artifacts.Yaml;