------------------------------------------------------------------------------
--                     XML/Ada - An XML suite for Ada95                     --
--                                                                          --
--                     Copyright (C) 2016, Nicolas Boulenguez               --
--                     Copyright (C) 2016-2017, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

pragma Ada_2012;

with Ada.Command_Line;
with Ada.Containers.Indefinite_Vectors;
with Ada.Containers.Vectors;
with Ada.Strings.Bounded;
with Ada.Strings.Fixed;
with Ada.Strings.Maps.Constants;
with Ada.Text_IO;

with Translators.Alias;
with Translators.Block;

procedure Convert is

   use Ada.Text_IO;
   use type Translators.A_Translation;
   package ASB is new Ada.Strings.Bounded.Generic_Bounded_Length (256);

   --  Must be compiled with gnata and called with three paths.
   pragma Assert (Ada.Command_Line.Argument_Count = 3);
   Path_To_Blocks_Txt       : String renames Ada.Command_Line.Argument (1);
   Path_To_Name_Aliases_Txt : String renames Ada.Command_Line.Argument (2);
   Path_To_Unicode_Data_Txt : String renames Ada.Command_Line.Argument (3);

   Output_Dir : constant String := "generated/";

   type A_Code is range 0 .. 16#10FFFF# + 1;

   function Value (Hexadecimal_Digits : String) return A_Code;
   --  The given string must only contain hexadecimal_digits.

   function Image (Code : A_Code) return String;
   --  16#4_hexadecimal_digits# if Code <= 16#FFFF#,
   --  else add the required digits count.

   package Code_IO is new Integer_IO (A_Code);
   --  Default base is set to 16.

   package Translation_Vectors is new Ada.Containers.Indefinite_Vectors
     (Positive, Translators.A_Translation);

   type A_Point is record
      Code  : A_Code;
      Names : Translation_Vectors.Vector;
   end record;

   package Point_Vectors is new Ada.Containers.Vectors (Positive, A_Point);

   procedure Parse_Block_Line (Line : String);
   procedure Process_Block (Start_Code : A_Code;
                            End_Code   : A_Code;
                            Block_Name : String)
     with Pre => Start_Code <= End_Code;
   procedure Output_Ada_Package (Block_Name : String;
                                 Points     : Point_Vectors.Vector);
   procedure Put_Maybe_Split (File             : File_Type;
                              Before_Semicolon : String;
                              After_Semicolon  : String);
   procedure Put_Unused_Exception (Replaced    : String;
                                   Replacement : String);

   type A_Name_File is record
      File : File_Type;
      Code : A_Code;
      Name : ASB.Bounded_String;
   end record;

   procedure Next (Name_File : in out A_Name_File);

   ----------------------------------------------------------------------

   function Image (Code : A_Code) return String is
      Tmp : String (1 .. 3 + 32 / 4 + 1);
      I   : Integer := Tmp'Last - 1;
   begin
      Code_IO.Put (Tmp, Code, Base => 16);
      while Tmp (I) /= '#' loop
         I := I - 1;
      end loop;
      return Tmp (I - 2 .. I) & (Tmp'Last .. I + 4 => '0')
        & Tmp (I + 1 .. Tmp'Last);
   end Image;

   procedure Next (Name_File : in out A_Name_File) is
   begin
      while not End_Of_File (Name_File.File) loop
         declare
            Line : constant String := Get_Line (Name_File.File);
         begin
            if Line'Length /= 0 and then Line (Line'First) /= '#' then
               declare
                  I : constant Natural := Ada.Strings.Fixed.Index (Line, ";");
                  J : constant Natural := Ada.Strings.Fixed.Index (Line, ";",
                                                                   I + 1);
                  pragma Assert (I in 2 .. J - 2);
               begin
                  Name_File.Code := Value (Line (Line'First .. I - 1));
                  ASB.Set_Bounded_String (Name_File.Name,
                                          Line (I + 1 .. J - 1));
                  exit;
               end;
            end if;
         end;
      end loop;
   end Next;

   procedure Parse_Block_Line (Line : String) is
      First_Dot : Integer;
      Semicolon : Integer;
      I         : Integer := Line'First;
   begin
      if I <= Line'Last and then Line (I) /= '#' then
         while Line (I) in '0' .. '9' | 'A' .. 'F' loop
            I := I + 1;
         end loop;
         First_Dot := I;
         pragma Assert (Line'First + 4 <= First_Dot
                          and Line (First_Dot .. First_Dot + 1) = "..");
         I := I + 2;
         while Line (I) in  '0' .. '9' | 'A' .. 'F' loop
            I := I + 1;
         end loop;
         Semicolon := I;
         pragma Assert (First_Dot + 5 < Semicolon
                          and Line (Semicolon .. Semicolon + 1) = "; ");
         Process_Block
           (Start_Code => Value (Line (Line'First .. First_Dot - 1)),
            End_Code   => Value (Line (First_Dot + 2 .. Semicolon - 1)),
            Block_Name => Line (Semicolon + 2 .. Line'Last));
      end if;
   end Parse_Block_Line;

   procedure Put_Maybe_Split (File             : File_Type;
                              Before_Semicolon : String;
                              After_Semicolon  : String) is
      S : constant String := "   " & Before_Semicolon
        & (Before_Semicolon'Length + 1 .. 39 => ' ') & " :";
   begin
      if S'Length + 1 + After_Semicolon'Length <= 79 then
         Put_Line (File, S & ' ' & After_Semicolon);
      else
         Put_Line (File, S);
         Put_Line (File, "      " & After_Semicolon);
      end if;
   end Put_Maybe_Split;

   procedure Put_Unused_Exception (Replaced    : String;
                                   Replacement : String) is
   begin
      Put_Line
        ("Unused exception: " & Replaced & " -> " & Replacement);
   end Put_Unused_Exception;

   function Value (Hexadecimal_Digits : String) return A_Code is
   begin
      return A_Code'Value ("16#" & Hexadecimal_Digits & '#');
   end Value;

   ----------------------------------------------------------------------

   --  Now it is convenient to share some variable among the last procedures.

   Name_Aliases     : A_Name_File;
   Unicode_Data     : A_Name_File;
   Alias_Translator : Translators.Alias.An_Alias_Translator;
   Block_Translator : Translators.Block.A_Block_Translator;
   Unicode_Version  : ASB.Bounded_String;

   procedure Output_Ada_Package (Block_Name : String;
                                 Points     : Point_Vectors.Vector) is
      Pkg  : constant String := Block_Translator.Translated
        (Block_Translator.New_Translation (Block_Name));
      File :  File_Type;
   begin
      --  On VMS, Filename lengths are limited to 39.39 characters.
      pragma Assert (14 + Pkg'Length <= 39, "file name too long: " & Pkg);
      Create (File, Out_File,
              Output_Dir & "unicode-names-" & Ada.Strings.Fixed.Translate
                (Pkg, Ada.Strings.Maps.Constants.Lower_Case_Map) & ".ads");
      Put_Line (File,
                "--  This file is built automatically from data found on the");
      Put_Line (File, "--  unicode web site (http://www.unicode.org)");
      Put (File, "--  in version ");
      Put (File, ASB.To_String (Unicode_Version));
      Put (File, '.');
      New_Line (File);
      Put (File, "package Unicode.Names.");
      Put (File, Pkg);
      Put (File, " is");
      New_Line (File);
      Put_Line (File, "   pragma Preelaborate;");
      Put_Line (File, "   pragma Style_Checks (Off);");
      New_Line (File);
      for Point of Points loop
         if not Point.Names.Is_Empty then
            if Translators.Is_Exception (Point.Names.Element (1)) then
               Put (File, "   --  Real Unicode name is ");
               Put (File, Translators.Original (Point.Names.Element (1)));
               New_Line (File);
            end if;
            Put_Maybe_Split
              (File, Alias_Translator.Translated (Point.Names.Element (1)),
               "constant Unicode_Char := " & Image (Point.Code) & ";");
            for A in 2 .. Integer (Point.Names.Length) loop
               if Translators.Is_Exception (Point.Names.Element (A)) then
                  Put (File, "   --  Real Unicode name is ");
                  Put (File, Translators.Original (Point.Names.Element (A)));
                  New_Line (File);
               end if;
               Put_Maybe_Split
                 (File,
                  Alias_Translator.Translated (Point.Names.Element (A)),
                  "Unicode_Char renames "
                    & Alias_Translator.Translated (Point.Names.Element (1))
                    & ';');
            end loop;
         end if;
      end loop;
      Put (File, "end Unicode.Names.");
      Put (File, Pkg);
      Put (File, ";");
      New_Line (File);
      Close (File);
   end Output_Ada_Package;

   procedure Process_Block (Start_Code : A_Code;
                            End_Code   : A_Code;
                            Block_Name : String) is
      Points : Point_Vectors.Vector;
   begin
      while (not End_Of_File (Unicode_Data.File))
        and then Unicode_Data.Code < Start_Code loop
         Put ("Code without block: ");
         Code_IO.Put (Unicode_Data.Code);
         New_Line;
         Next (Unicode_Data);
      end loop;
      while (not End_Of_File (Unicode_Data.File))
        and then Unicode_Data.Code <= End_Code loop
         declare
            Point : A_Point;
            Name  : constant Translators.A_Translation
              := Alias_Translator.New_Translation
              (ASB.To_String (Unicode_Data.Name));
         begin
            Point.Code := Unicode_Data.Code;
            if Alias_Translator.Translated (Name) /= "" then
               Point.Names.Append (Name);
            end if;
            while (not End_Of_File (Name_Aliases.File))
              and then Name_Aliases.Code = Point.Code loop
               Point.Names.Append (Alias_Translator.New_Translation
                                     (ASB.To_String (Name_Aliases.Name)));
               Next (Name_Aliases);
            end loop;
            if Point.Names.Is_Empty then
               Put ("Unnamed code: ");
               Code_IO.Put (Point.Code);
               New_Line;
            else
               Points.Append (Point);
            end if;
         end;
         Next (Unicode_Data);
      end loop;
      if Points.Is_Empty then
         Put ("Empty block: ");
         Put (Block_Name);
         New_Line;
      else
         Output_Ada_Package (Block_Name, Points);
      end if;
   end Process_Block;

   Blocks : File_Type;
begin
   Code_IO.Default_Base := 16;

   Alias_Translator.Set_Exceptions;
   Block_Translator.Set_Exceptions;

   Open (Blocks, In_File, Path_To_Blocks_Txt);
   declare
      Line : constant String := Get_Line (Blocks);
      pragma Assert (Line (Line'First .. Line'First + 8) = "# Blocks-"
           and then Line (Line'Last - 3 .. Line'Last) = ".txt",
           "Unable to parse unicode version in " & Name (Blocks));
   begin
      ASB.Set_Bounded_String (Unicode_Version,
                              Line (Line'First + 9 .. Line'Last - 4));
   end;

   Open (Name_Aliases.File, In_File, Path_To_Name_Aliases_Txt);
   Next (Name_Aliases);

   Open (Unicode_Data.File, In_File, Path_To_Unicode_Data_Txt);
   Next (Unicode_Data);

   while not End_Of_File (Blocks) loop
      Parse_Block_Line (Get_Line (Blocks));
   end loop;

   Close (Blocks);

   if not End_Of_File (Unicode_Data.File) then
      Put (Path_To_Unicode_Data_Txt);
      Put (" only parsed until code ");
      Code_IO.Put (Unicode_Data.Code);
      New_Line;
   end if;
   Close (Unicode_Data.File);

   if not End_Of_File (Name_Aliases.File) then
      Put (Path_To_Name_Aliases_Txt);
      Put (" only parsed until code ");
      Code_IO.Put (Name_Aliases.Code);
      New_Line;
   end if;
   Close (Name_Aliases.File);

   Alias_Translator.Iterate_On_Unused_Exceptions (Put_Unused_Exception'Access);

   Block_Translator.Iterate_On_Unused_Exceptions (Put_Unused_Exception'Access);
end Convert;
