with Wordcount_Maps;     use Wordcount_Maps;

with Ada.Text_IO;              use Ada.Text_IO;
with Ada.Integer_Text_IO;      use Ada.Integer_Text_IO;
with Ada.Command_Line;         use Ada.Command_Line;
with Ada.Strings.Maps;         use Ada.Strings.Maps;
with Ada.Strings.Fixed;        use Ada.Strings.Fixed;
with Ada.Strings.Less_Case_Insensitive;
with Ada.Characters.Handling;  use Ada.Characters.Handling;
with Ada.Containers.Generic_Constrained_Array_Sort;
with Ada.Containers;           use Ada.Containers;

procedure Wordcount is

   subtype Map_Cursor is Wordcount_Maps.Cursor;

   M : Map;

   procedure Insert (Word : in String) is

      procedure Increment_Count
        (K : in     String;
         N : in out Natural) is

         pragma Warnings (Off, K);
      begin
         N := N + 1;
      end Increment_Count;

      C : Map_Cursor;
      B : Boolean;

   begin -- Insert

      Insert (M, Word, 0, C, B);

      Update_Element (C, Increment_Count'Access);

   end Insert;

   File : File_Type;

   Word_Chars : constant Character_Set :=
     To_Set (Character_Ranges'(('a', 'z'), ('A', 'Z')));

   Line : String (1 .. 2000);

   Line_First : Positive;
   Line_Last : Natural;

   Word_First : Positive;
   Word_Last : Natural;

   procedure Print (C : in Map_Cursor) is
      procedure Print (K : String; N : Natural) is
      begin
         Put (To_Lower (K));
         Put (' ');
         Put (N, Width => 0);
         New_Line;
      end Print;
   begin
      Query_Element (C, Print'Access);
   end Print;

begin -- Wordcount

   if Argument_Count = 0 then
      Put_Line (Command_Name & " <file>");
      return;
   end if;

   if Argument_Count > 1 then
      Put_Line ("too many command-line arguments");
      return;
   end if;

   begin
      Open (File, In_File, Name => Argument (1));
   exception
      when Name_Error =>
         Put_Line ("unable to open file");
         return;
   end;

   while not End_Of_File (File) loop

      Get_Line (File, Line, Line_Last);
      pragma Assert (Line_Last < Line'Last);

      Line_First := Line'First;

      loop

         Find_Token
           (Source => Line (Line_First .. Line_Last),
            Set    => Word_Chars,
            Test   => Ada.Strings.Inside,
            First  => Word_First,
            Last   => Word_Last);

         exit when Word_Last = 0;

         Insert (Word => Line (Word_First .. Word_Last));

         Line_First := Word_Last + 1;

      end loop;

   end loop;

   declare
      function Less (L, R : Map_Cursor) return Boolean is
         Result : Boolean;

         procedure Query_L (LK : String; LN : Natural) is
            procedure Query_R (RK : String; RN : Natural) is
            begin
               if LN > RN then
                  Result := True;
               elsif LN < RN then
                  Result := False;
               else
                  Result := Ada.Strings.Less_Case_Insensitive (LK, RK);
               end if;
            end Query_R;
         begin
            Query_Element (R, Query_R'Access);
         end;
      begin
         Query_Element (L, Query_L'Access);
         return Result;
      end Less;

      subtype Index_Subtype is Count_Type range 1 .. Length (M);

      type Cursor_Array is
        array (Index_Subtype) of Map_Cursor;

      procedure Sort is
         new Generic_Constrained_Array_Sort
           (Index_Subtype,
            Map_Cursor,
            Cursor_Array,
            Less);

      V : Cursor_Array;
      I : Count_Type := 1;

      procedure Append_To_V (C : Map_Cursor) is
      begin
         V (I) := C;
         I := I + 1;
      end Append_To_V;
   begin
      Iterate (M, Append_To_V'Access);
      Sort (V);

      for I in 1 .. Count_Type'Min (10, V'Last) loop
         Print (V (I));
      end loop;
   end;

end Wordcount;

