with Debug_Tools;
with Misc_String_Utilities;
package body Fields is

    Is_Done : exception;

    function Is_Null (This_Iterator : in Iterator) return Boolean is
    begin
        return (This_Iterator.The_Fields.all = "");
    end Is_Null;

    procedure Advance_Field_In (This_Iterator : in out Iterator) is
    begin  
        This_Iterator.Characters_In_Current_Field := 0;
        This_Iterator.Current_Field_Number :=
           This_Iterator.Current_Field_Number + 1;
        if (This_Iterator.Trailing_Separator_Position >
            This_Iterator.The_Fields'Last) then
            This_Iterator.Done := True;
        end if;
        loop  
            exit when (This_Iterator.Done);
            This_Iterator.Trailing_Separator_Position :=
               This_Iterator.Trailing_Separator_Position + 1;
            exit when (This_Iterator.Trailing_Separator_Position >
                       This_Iterator.The_Fields'Last);
            exit when (Is_Separator
                          (This_Iterator.The_Fields
                              (This_Iterator.Trailing_Separator_Position)));
            This_Iterator.Characters_In_Current_Field :=
               This_Iterator.Characters_In_Current_Field + 1;
        end loop;
    end Advance_Field_In;

    procedure Set_State (This_Iterator : in out Iterator) is
    begin
        if (not Is_Null (This_Iterator)) then
            This_Iterator.Trailing_Separator_Position :=
               This_Iterator.The_Fields'First - 1;
            This_Iterator.Characters_In_Current_Field := 0;
            This_Iterator.Current_Field_Number := 0;
            This_Iterator.Done := False;
            Advance_Field_In (This_Iterator);
        end if;
    end Set_State;

    function Create (From_String : in String) return Iterator is
        --
        New_Iterator : Iterator;
        --
        The_String : constant String (1 .. From_String'Length) := From_String;
        --
    begin
        New_Iterator.The_Fields := new String'(The_String);
        Set_State (New_Iterator);
        return (New_Iterator);  
    end Create;

    procedure Assert_Is_Initialized (This_Iterator : in Iterator) is
    begin
        if (This_Iterator.The_Fields = null) then
            raise Not_Initialized;
        end if;
    end Assert_Is_Initialized;

    function Done (This_Iterator : in Iterator) return Boolean is
    begin
        Assert_Is_Initialized (This_Iterator);
        return (This_Iterator.Done);
    end Done;

    procedure Reset (This_Iterator : in out Iterator) is
    begin
        Assert_Is_Initialized (This_Iterator);
        Set_State (This_Iterator);  
    end Reset;

    procedure Assert_Not_Done (This_Iterator : in Iterator) is
    begin
        if (Done (This_Iterator)) then
            raise Is_Done;
        end if;
    end Assert_Not_Done;

    function Current_Field_Start (This_Iterator : in Iterator) return Natural is
    begin
        return (This_Iterator.Trailing_Separator_Position -
                This_Iterator.Characters_In_Current_Field);
    end Current_Field_Start;

    function Current_Field_End (This_Iterator : in Iterator) return Natural is
    begin
        return (This_Iterator.Trailing_Separator_Position - 1);
    end Current_Field_End;

    function Current (This_Iterator : in Iterator) return Field is
    begin
        Assert_Not_Done (This_Iterator);
        declare
            The_Current_Field_Raw : constant String :=
               This_Iterator.The_Fields (Current_Field_Start (This_Iterator) ..
                                            Current_Field_End (This_Iterator));
            The_Current_Field_Normalized :
               constant String (1 .. The_Current_Field_Raw'Length) :=
               The_Current_Field_Raw;
        begin
            return (The_Current_Field_Normalized);
        end;
        --
    exception
        when Is_Done =>
            raise No_Current_Field;
    end Current;

    procedure Assert_Field_Valid (This_Field : in Field) is
    begin
        for Index in This_Field'Range loop
            if (Is_Separator (This_Field (Index))) then
                raise Parse_Failure;
            end if;
        end loop;
    end Assert_Field_Valid;

    procedure Modify (This_Iterator : in out Iterator; New_Field : in Field) is
        --
        Original_Position : constant Positive := Position (This_Iterator);
        --
    begin
        Assert_Not_Done (This_Iterator);
        Assert_Field_Valid (New_Field);
        declare
            New_Fields : constant String :=
               Misc_String_Utilities.Replace
                  (From_Here => Current_Field_Start (This_Iterator),
                   To_Here => Current_Field_End (This_Iterator),
                   With_Substring => New_Field,
                   In_String => This_Iterator.The_Fields.all);
        begin
            This_Iterator.The_Fields.all := New_Fields;
        end;
        Set (This_Iterator, Original_Position);
        --
    exception
        when Is_Done =>
            raise No_Current_Field;
    end Modify;

    procedure Next (This_Iterator : in out Iterator) is
    begin
        Assert_Not_Done (This_Iterator);
        Advance_Field_In (This_Iterator);
        --
    exception
        when Is_Done =>
            raise No_Next_Field;
    end Next;

    function Position (In_Iterator : in Iterator) return Field_Number is
    begin
        Assert_Not_Done (In_Iterator);
        return (In_Iterator.Current_Field_Number);
    end Position;

    procedure Set (This_Iterator : in out Iterator;
                   To_Field : in Field_Number) is
    begin
        Reset (This_Iterator);
        for Counter in 1 .. (To_Field - 1) loop
            Next (This_Iterator);
        end loop;
        --
    exception
        when No_Next_Field =>
            raise Out_Of_Range;
    end Set;

    function Field_At
                (This_Position : in Field_Number; In_Iterator : in Iterator)
                return Field is
        --
        The_Iterator : Iterator := In_Iterator;
        --
        Original_Position : Positive := Position (In_Iterator);
        --
    begin
        Set (The_Iterator, This_Position);
        declare
            The_Field : constant String := Current (The_Iterator);
        begin
            Set (The_Iterator, Original_Position);
            return (The_Field);
        end;
    end Field_At;

    function Is_Empty (This_Iterator : in Iterator) return Boolean is
    begin
        Assert_Is_Initialized (This_Iterator);
        return (Is_Null (This_Iterator));
    end Is_Empty;

    function Fields_In (This_Iterator : in Iterator) return Natural is
        --
        The_Iterator : Iterator := This_Iterator;
        --
        Original_Position : Positive := Position (The_Iterator);
        --
    begin  
        Assert_Is_Initialized (The_Iterator);
        Reset (The_Iterator);
        for Counter in 0 .. Integer'Last loop
            if (Done (The_Iterator)) then
                return (Counter);
            end if;
            Next (The_Iterator);
        end loop;
    end Fields_In;

-- ***** REGISTRATION OF TYPE IMAGES

    function Fields_Image (These_Fields : in Iterator;
                           Level : in Natural;
                           Prefix : in String;
                           Expand_Pointers : in Boolean) return String is
    begin
        if (These_Fields.The_Fields = null) then
            return ("<NOT INITIALIZED>");
        else
            return ("""" & These_Fields.The_Fields.all & """" &
                    Ascii.Lf & Prefix & "  CURRENT FIELD NUMBER => " &
                    Natural'Image (These_Fields.Current_Field_Number) &
                    Ascii.Lf & Prefix & "  CHARACTERS IN CURRENT FIELD => " &
                    Natural'Image (These_Fields.Characters_In_Current_Field) &
                    Ascii.Lf & Prefix & "  TRAILING SEPARATOR POSITION => " &
                    Natural'Image (These_Fields.Trailing_Separator_Position) &
                    Ascii.Lf & Prefix & "  DONE => " &
                    Boolean'Image (These_Fields.Done));
        end if;
    end Fields_Image;

    procedure Register_Fields is
       new Debug_Tools.Register (Iterator, Fields_Image);

begin
    Register_Fields;
end Fields;