--  Copyright © 2026 Lingenic LLC. All rights reserved.
--  Licensed under the Lingenic Source-Available License v2.3.
--  Production use requires a separate license from Licensor.
--  See LICENSE.md and COPYRIGHT in the project root.
--

-------------------------------------------------------------------------------
--  Lingenic-Text — Bidi conformance test
--
--  Runs all test cases from BidiCharacterTest.txt and verifies that
--  Resolve_Levels and Reorder produce the expected results.
--
--  Test format per line (5 fields separated by ';'):
--    Field 0: hex codepoints separated by space
--    Field 1: paragraph direction (0=LTR, 1=RTL, 2=auto)
--    Field 2: expected paragraph level
--    Field 3: expected levels ('x' = X9-removed)
--    Field 4: expected reorder indices
-------------------------------------------------------------------------------

with Ada.Text_IO;
with Ada.Command_Line;
with Lingenic_Text;
with Lingenic_Text.Properties;
with Lingenic_Text.Bidi;
with Lingenic_Text.Bidi_Spec;
with Lingenic_Text.UTF8;

procedure Test_Bidi is
   use Lingenic_Text;
   use Lingenic_Text.Bidi;
   use Lingenic_Text.Bidi_Spec;

   ---------------------------------------------------------------------------
   --  Hex parsing
   ---------------------------------------------------------------------------

   function Is_Hex_Char (C : Character) return Boolean is
     (C in '0' .. '9' or C in 'A' .. 'F' or C in 'a' .. 'f');

   function Hex_Val (C : Character) return Natural is
   begin
      if C in '0' .. '9' then return Character'Pos (C) - Character'Pos ('0');
      elsif C in 'A' .. 'F' then return Character'Pos (C) - Character'Pos ('A') + 10;
      elsif C in 'a' .. 'f' then return Character'Pos (C) - Character'Pos ('a') + 10;
      else return 0;
      end if;
   end Hex_Val;

   ---------------------------------------------------------------------------
   --  UTF-8 encoding buffer
   ---------------------------------------------------------------------------

   Max_UTF8 : constant := Max_Paragraph_CPs * 4;
   type UTF8_Buffer is record
      Data : Byte_Array (1 .. Max_UTF8) := [others => 0];
      Len  : Natural := 0;
   end record;

   procedure Encode_CP (Buf : in out UTF8_Buffer; CP : Codepoint) is
      ELen : Positive := 1;
      Start_Pos : Positive;
   begin
      --  Surrogates can't be encoded in UTF-8
      if CP >= 16#D800# and then CP <= 16#DFFF# then
         return;
      end if;
      --  Need at most 4 bytes
      if Buf.Len + 4 <= Max_UTF8 then
         Start_Pos := Buf.Len + 1;
         UTF8.Encode (CP, Buf.Data, Start_Pos, ELen);
         Buf.Len := Buf.Len + ELen;
      end if;
   end Encode_CP;

   ---------------------------------------------------------------------------
   --  Test state
   ---------------------------------------------------------------------------

   Total  : Natural := 0;
   Passed : Natural := 0;
   Failed : Natural := 0;
   Max_Failures_Shown : constant := 50;

   ---------------------------------------------------------------------------
   --  Parse and run one test line
   ---------------------------------------------------------------------------

   procedure Process_Line (Line : String; Line_Num : Positive) is
      Pos : Positive := Line'First;
      Last : constant Natural := Line'Last;

      --  Skip to next semicolon and return position after it
      procedure Skip_To_Semi is
      begin
         while Pos <= Last and then Line (Pos) /= ';' loop
            Pos := Pos + 1;
         end loop;
         if Pos <= Last then Pos := Pos + 1; end if;  -- skip ';'
      end Skip_To_Semi;

      --  Skip whitespace
      procedure Skip_WS is
      begin
         while Pos <= Last and then (Line (Pos) = ' ' or Line (Pos) = ASCII.HT) loop
            Pos := Pos + 1;
         end loop;
      end Skip_WS;

      --  Parsed codepoints
      CP_List : array (1 .. Max_Paragraph_CPs) of Codepoint := [others => 0];
      Num_CPs_Parsed : Natural := 0;

      --  Expected values
      Exp_Dir : Natural := 2;
      Exp_Para_Level : Natural := 0;

      type Exp_Level_Array is array (1 .. Max_Paragraph_CPs) of Integer;
      Exp_Levels : Exp_Level_Array := [others => -1];  -- -1 = 'x' (removed)
      Num_Exp_Levels : Natural := 0;

      type Exp_Order_Array is array (1 .. Max_Paragraph_CPs) of Integer;
      Exp_Order : Exp_Order_Array := [others => -1];
      Num_Exp_Order : Natural := 0;

      --  UTF-8 encoding
      Buf : UTF8_Buffer;

      --  Results
      Levels_Out : Level_Array;
      Num_CPs_Out : Paragraph_Length;
      Para_Level_Out : Embedding_Level;
      Order_Out : Index_Array;
      Dir : Paragraph_Direction;
      Success : Boolean;

      --  Comparison
      Level_Match : Boolean := True;
      Order_Match : Boolean := True;
      Para_Level_Match : Boolean := True;
   begin
      --  Field 0: hex codepoints separated by space
      Skip_WS;
      while Pos <= Last and then Line (Pos) /= ';' loop
         if Is_Hex_Char (Line (Pos)) then
            declare
               CP : Natural := 0;
            begin
               while Pos <= Last and then Is_Hex_Char (Line (Pos)) loop
                  CP := CP * 16 + Hex_Val (Line (Pos));
                  Pos := Pos + 1;
               end loop;
               if Num_CPs_Parsed < Max_Paragraph_CPs
                 and then CP <= Codepoint'Last
               then
                  Num_CPs_Parsed := Num_CPs_Parsed + 1;
                  CP_List (Num_CPs_Parsed) := CP;
               end if;
            end;
         else
            Pos := Pos + 1;  -- skip spaces
         end if;
      end loop;
      Skip_To_Semi;

      if Num_CPs_Parsed = 0 then return; end if;

      --  Field 1: paragraph direction
      Skip_WS;
      if Pos <= Last and then Line (Pos) in '0' .. '2' then
         Exp_Dir := Character'Pos (Line (Pos)) - Character'Pos ('0');
         Pos := Pos + 1;
      end if;
      Skip_To_Semi;

      --  Field 2: expected paragraph level
      Skip_WS;
      if Pos <= Last and then Line (Pos) in '0' .. '9' then
         Exp_Para_Level := Character'Pos (Line (Pos)) - Character'Pos ('0');
         Pos := Pos + 1;
      end if;
      Skip_To_Semi;

      --  Field 3: expected levels (space-separated, 'x' for removed)
      Skip_WS;
      while Pos <= Last and then Line (Pos) /= ';' loop
         Skip_WS;
         if Pos > Last or else Line (Pos) = ';' then exit; end if;

         if Line (Pos) = 'x' then
            Num_Exp_Levels := Num_Exp_Levels + 1;
            if Num_Exp_Levels <= Max_Paragraph_CPs then
               Exp_Levels (Num_Exp_Levels) := -1;
            end if;
            Pos := Pos + 1;
         elsif Line (Pos) in '0' .. '9' then
            declare
               Val : Natural := 0;
            begin
               while Pos <= Last and then Line (Pos) in '0' .. '9' loop
                  Val := Val * 10 +
                    (Character'Pos (Line (Pos)) - Character'Pos ('0'));
                  Pos := Pos + 1;
               end loop;
               Num_Exp_Levels := Num_Exp_Levels + 1;
               if Num_Exp_Levels <= Max_Paragraph_CPs then
                  Exp_Levels (Num_Exp_Levels) := Val;
               end if;
            end;
         else
            Pos := Pos + 1;
         end if;
      end loop;
      Skip_To_Semi;

      --  Field 4: expected reorder indices (space-separated)
      Skip_WS;
      while Pos <= Last loop
         Skip_WS;
         if Pos > Last then exit; end if;

         if Line (Pos) in '0' .. '9' then
            declare
               Val : Natural := 0;
            begin
               while Pos <= Last and then Line (Pos) in '0' .. '9' loop
                  Val := Val * 10 +
                    (Character'Pos (Line (Pos)) - Character'Pos ('0'));
                  Pos := Pos + 1;
               end loop;
               Num_Exp_Order := Num_Exp_Order + 1;
               if Num_Exp_Order <= Max_Paragraph_CPs then
                  Exp_Order (Num_Exp_Order) := Val;
               end if;
            end;
         else
            Pos := Pos + 1;
         end if;
      end loop;

      --  Encode codepoints to UTF-8
      Buf.Len := 0;
      for I in 1 .. Num_CPs_Parsed loop
         Encode_CP (Buf, CP_List (I));
      end loop;

      if Buf.Len = 0 then return; end if;

      --  Determine direction
      Dir := (case Exp_Dir is
                when 0 => Dir_LTR,
                when 1 => Dir_RTL,
                when others => Dir_Auto);

      --  Run Resolve_Levels
      Resolve_Levels
        (Text       => Buf.Data (1 .. Buf.Len),
         Dir        => Dir,
         Levels     => Levels_Out,
         Num_CPs    => Num_CPs_Out,
         Para_Level => Para_Level_Out,
         Success    => Success);

      Total := Total + 1;

      if not Success then
         if Failed < Max_Failures_Shown then
            Ada.Text_IO.Put_Line
              ("FAIL line" & Positive'Image (Line_Num) &
               ": Resolve_Levels failed");
         end if;
         Failed := Failed + 1;
         return;
      end if;

      --  Check paragraph level
      if Natural (Para_Level_Out) /= Exp_Para_Level then
         Para_Level_Match := False;
      end if;

      --  Check levels (compare non-x positions)
      if Natural (Num_CPs_Out) /= Num_Exp_Levels then
         Level_Match := False;
      else
         for I in 1 .. Num_Exp_Levels loop
            if Exp_Levels (I) >= 0 then
               --  Non-x position: compare
               if Natural (Levels_Out (I)) /= Exp_Levels (I) then
                  Level_Match := False;
                  exit;
               end if;
            end if;
         end loop;
      end if;

      --  Run Reorder
      Reorder
        (Levels     => Levels_Out,
         Num_CPs    => Num_CPs_Out,
         Para_Level => Para_Level_Out,
         Order      => Order_Out,
         Success    => Success);

      if not Success then
         if Failed < Max_Failures_Shown then
            Ada.Text_IO.Put_Line
              ("FAIL line" & Positive'Image (Line_Num) &
               ": Reorder failed");
         end if;
         Failed := Failed + 1;
         return;
      end if;

      --  Check reorder: build the expected mapping
      --  The test file gives 0-based visual order indices for non-x positions
      --  We need to compare our Order output (which is 1-based logical→visual)
      --  against the expected visual order.
      --
      --  The expected reorder field lists the logical indices (0-based)
      --  in visual order, excluding x positions.
      --
      --  Our Reorder output Order(1..N) gives logical indices (1-based)
      --  for each visual position.
      --
      --  To compare: filter out x positions from our output and compare.
      if Num_Exp_Order > 0 then
         declare
            --  Build filtered order (skip x positions)
            Filtered : array (1 .. Max_Paragraph_CPs) of Integer :=
              [others => -1];
            Filtered_Len : Natural := 0;
         begin
            for I in 1 .. Num_CPs_Out loop
               declare
                  Logical_Idx : constant Natural := Order_Out (I);
               begin
                  if Logical_Idx >= 1
                    and then Logical_Idx <= Num_Exp_Levels
                    and then Exp_Levels (Logical_Idx) >= 0
                  then
                     --  Non-x position: include in filtered output
                     Filtered_Len := Filtered_Len + 1;
                     if Filtered_Len <= Max_Paragraph_CPs then
                        Filtered (Filtered_Len) := Logical_Idx - 1;
                        --  Convert to 0-based for comparison
                     end if;
                  end if;
               end;
            end loop;

            if Filtered_Len /= Num_Exp_Order then
               Order_Match := False;
            else
               for I in 1 .. Num_Exp_Order loop
                  if Filtered (I) /= Exp_Order (I) then
                     Order_Match := False;
                     exit;
                  end if;
               end loop;
            end if;
         end;
      end if;

      if Para_Level_Match and Level_Match and Order_Match then
         Passed := Passed + 1;
      else
         Failed := Failed + 1;
         if Failed <= Max_Failures_Shown then
            Ada.Text_IO.Put ("FAIL line" & Positive'Image (Line_Num) & ":");
            if not Para_Level_Match then
               Ada.Text_IO.Put (" para_level(got" &
                 Embedding_Level'Image (Para_Level_Out) &
                 " exp" & Natural'Image (Exp_Para_Level) & ")");
            end if;
            if not Level_Match then
               Ada.Text_IO.Put (" levels");
               if Natural (Num_CPs_Out) /= Num_Exp_Levels then
                  Ada.Text_IO.Put ("(count" &
                    Natural'Image (Natural (Num_CPs_Out)) &
                    " vs" & Natural'Image (Num_Exp_Levels) & ")");
               else
                  for I in 1 .. Num_Exp_Levels loop
                     if Exp_Levels (I) >= 0
                       and then Natural (Levels_Out (I)) /= Exp_Levels (I)
                     then
                        Ada.Text_IO.Put ("(pos" & Positive'Image (I) &
                          " got" & Embedding_Level'Image (Levels_Out (I)) &
                          " exp" & Integer'Image (Exp_Levels (I)) & ")");
                        exit;
                     end if;
                  end loop;
               end if;
            end if;
            if not Order_Match then
               Ada.Text_IO.Put (" order");
            end if;
            Ada.Text_IO.New_Line;
         end if;
      end if;
   end Process_Line;

   ---------------------------------------------------------------------------
   --  Main
   ---------------------------------------------------------------------------

   UCD_Dir : constant String :=
     (if Ada.Command_Line.Argument_Count >= 1
      then Ada.Command_Line.Argument (1) else "ucd");

   Test_File : constant String := UCD_Dir & "/BidiCharacterTest.txt";
   F : Ada.Text_IO.File_Type;
   Line_Num : Positive := 1;
   Success : Boolean;

begin
   --  Initialize properties
   Properties.Initialize (UCD_Dir, Success);
   if not Success then
      Ada.Text_IO.Put_Line ("ERROR: Failed to initialize Properties");
      Ada.Command_Line.Set_Exit_Status (1);
      return;
   end if;

   --  Initialize bidi
   Bidi.Initialize (UCD_Dir, Success);
   if not Success then
      Ada.Text_IO.Put_Line ("ERROR: Failed to initialize Bidi");
      Ada.Command_Line.Set_Exit_Status (1);
      return;
   end if;

   --  Open test file
   Ada.Text_IO.Open (F, Ada.Text_IO.In_File, Test_File);

   while not Ada.Text_IO.End_Of_File (F) loop
      declare
         Line : constant String := Ada.Text_IO.Get_Line (F);
      begin
         --  Skip comments and blank lines
         if Line'Length > 0
           and then Line (Line'First) /= '#'
           and then Line (Line'First) /= ASCII.LF
           and then Line (Line'First) /= ASCII.CR
         then
            --  Must have at least one semicolon to be a data line
            declare
               Has_Semi : Boolean := False;
            begin
               for I in Line'Range loop
                  if Line (I) = ';' then
                     Has_Semi := True;
                     exit;
                  end if;
               end loop;
               if Has_Semi then
                  Process_Line (Line, Line_Num);
               end if;
            end;
         end if;
      end;
      Line_Num := Line_Num + 1;
   end loop;

   Ada.Text_IO.Close (F);

   --  Summary
   Ada.Text_IO.Put_Line ("Total:" & Natural'Image (Total));
   Ada.Text_IO.Put_Line ("Passed:" & Natural'Image (Passed));
   Ada.Text_IO.Put_Line ("Failed:" & Natural'Image (Failed));
   Ada.Text_IO.New_Line;

   if Failed = 0 then
      Ada.Text_IO.Put_Line ("ALL TESTS PASSED");
   else
      Ada.Text_IO.Put_Line ("SOME TESTS FAILED");
      Ada.Command_Line.Set_Exit_Status (1);
   end if;
end Test_Bidi;