with System;  use type System.Address;
with Ada.Strings.Less_Case_Insensitive;  use Ada.Strings;

package body Libraries is

   use Book_Sets, Title_Sets, Author_Sets;

   function Compare_Books (L, R : Book_Constant_Access) return Boolean is
   begin
      return L.all'Address < R.all'Address;
   end;

   function "<" (L, R : Books.Name_Type) return Boolean is
   begin
      if Less_Case_Insensitive (L.Last, R.Last) then
         return True;

      elsif Less_Case_Insensitive (R.Last, L.Last) then
         return False;

      else
         return Less_Case_Insensitive (L.First, R.First);

      end if;
   end "<";

   function Compare_Titles (L, R : Book_Sets.Cursor) return Boolean is
      LB : Book_Type renames Element (L).all;
      RB : Book_Type renames Element (R).all;

      LT : constant String := Title (LB);
      RT : constant String := Title (RB);
   begin
      if Less_Case_Insensitive (LT, RT) then
         return True;

      elsif Less_Case_Insensitive (RT, LT) then
         return False;

      else
         return Author (LB) < Author (RB);

      end if;
   end Compare_Titles;


   function Compare_Authors (L, R : Book_Sets.Cursor) return Boolean is
      LB : Book_Type renames Element (L).all;
      RB : Book_Type renames Element (R).all;

      LN : constant Name_Type := Author (LB);
      RN : constant Name_Type := Author (RB);
   begin
      if LN < RN then
         return True;

      elsif RN < LN then
         return False;

      else
         return Less_Case_Insensitive (Title (LB), Title (RB));

      end if;
   end Compare_Authors;


   procedure Add
     (Library : in out Library_Type;
      Book    : not null access constant Book_Type) is

      Book_Cursor : Book_Sets.Cursor;
      Inserted    : Boolean;
   begin
      Insert
        (Library.Book_Set,
         Book_Constant_Access (Book),
         Book_Cursor,
         Inserted);

      if Inserted then
         Insert (Library.Title_Set, Book_Cursor);
         Insert (Library.Author_Set, Book_Cursor);
      end if;
   end Add;


   procedure Remove
     (Library : in out Library_Type;
      Book    : not null access constant Book_Type) is

      Book_Cursor : Book_Sets.Cursor :=
        Find (Library.Book_Set, Book_Constant_Access (Book));
   begin
      if Has_Element (Book_Cursor) then
         Delete (Library.Title_Set, Book_Cursor);
         Delete (Library.Author_Set, Book_Cursor);
         Delete (Library.Book_Set, Book_Cursor);
      end if;
   end Remove;


   type Title_Key (I, J, K : Positive) is record
     Title  : String (1 .. I);
     Author : Name_Type (J, K);
   end record;

   function New_Key (Title : String; Author : Name_Type) return Title_Key is
      Key : Title_Key (Title'Length, Author.First_Length, Author.Last_Length);
   begin
      Key.Title := Title;
      Key.Author := Author;
      return Key;
   end;

   function Key (Book_Cursor : Book_Sets.Cursor) return Title_Key is
      B : Book_Type renames Element (Book_Cursor).all;
   begin
      return New_Key (Title (B), Author (B));
   end;

   function "<" (K : Title_Key;
                 C : Book_Sets.Cursor) return Boolean is

      B : Book_Type renames Element (C).all;
      T : constant String := Title (B);
   begin
      if Less_Case_Insensitive (K.Title, T) then
         return True;

      elsif Less_Case_Insensitive (T, K.Title) then
         return False;

      else
         return K.Author < Author (B);

      end if;
   end "<";


   function ">" (K : Title_Key;
                 C : Book_Sets.Cursor) return Boolean is

      B : Book_Type renames Element (C).all;
      T : constant String := Title (B);
   begin
      if Less_Case_Insensitive (T, K.Title) then
         return True;

      elsif Less_Case_Insensitive (K.Title, T) then
         return False;

      else
         return Author (B) < K.Author;

      end if;
   end ">";

   package Title_Keys is
      new Title_Sets.Generic_Keys (Title_Key, Key);

   procedure Remove
     (Library : in out Library_Type;
      Title   : in     String;
      Author  : in     Name_Type) is

      Key : constant Title_Key := New_Key (Title, Author);

      Title_Cursor : Title_Sets.Cursor :=
        Title_Keys.Find (Library.Title_Set, Key);
   begin
      if Has_Element (Title_Cursor) then
         declare
            Book_Cursor : Book_Sets.Cursor := Element (Title_Cursor);
         begin
            Delete (Library.Author_Set, Book_Cursor);
            Delete (Library.Title_Set, Title_Cursor);
            Delete (Library.Book_Set, Book_Cursor);
         end;
      end if;
   end Remove;



   procedure Books_By_Title
     (Library : in Library_Type;
      Process : not null access procedure (Book : Book_Type)) is

      S : Title_Sets.Set renames Library.Title_Set;

      procedure Process_Titles (C : Title_Sets.Cursor) is
         Book_Cursor : constant Book_Sets.Cursor := Element (C);
         Book : Book_Type renames Element (Book_Cursor).all;
      begin
         Process (Book);
      end;
   begin
      Iterate (S, Process_Titles'Access);
   end;


   procedure Books_By_Author
     (Library : in Library_Type;
      Process : not null access procedure (Book : in Book_Type)) is

      S : Author_Sets.Set renames Library.Author_Set;

      procedure Process_Authors (C : Author_Sets.Cursor) is
         Book_Cursor : constant Book_Sets.Cursor := Element (C);
         Book : Book_Type renames Element (Book_Cursor).all;
      begin
         Process (Book);
      end;
   begin
      Iterate (S, Process_Authors'Access);
   end;



   function Author (Book_Cursor : Book_Sets.Cursor) return Name_Type is
      Book : Book_Type renames Element (Book_Cursor).all;
   begin
      return Author (Book);
   end;

   function "<"
     (Author      : Name_Type;
      Book_Cursor : Book_Sets.Cursor) return Boolean is

      Book        : Book_Type renames Element (Book_Cursor).all;
      Book_Author : constant Name_Type := Books.Author (Book);
   begin
      if Author < Book_Author then
         return True;

      elsif Book_Author < Author then
         return False;

      else
         return True;  --subtle

      end if;
   end "<";

   function ">"
     (Author      : Name_Type;
      Book_Cursor : Book_Sets.Cursor) return Boolean is

      Book        : Book_Type renames Element (Book_Cursor).all;
      Book_Author : constant Name_Type := Books.Author (Book);
   begin
      if Book_Author < Author then
         return True;

      elsif Author < Book_Author then
         return False;

      else
         return False;  --subtle

      end if;
   end ">";

   package Author_Maps is
      new Author_Sets.Generic_Keys (Name_Type, Author);

   procedure Books_By_Author
     (Library : in Library_Type;
      Author  : in Name_Type;
      Process : not null access procedure (Book : in Book_Type)) is

      S : Author_Sets.Set renames Library.Author_Set;
      C : Author_Sets.Cursor := Author_Maps.Ceiling (S, Author);
   begin
      while Has_Element (C) loop
         declare
            Book_Cursor : constant Book_Sets.Cursor := Element (C);
            Book : Book_Type renames Element (Book_Cursor).all;
         begin
            exit when Author < Books.Author (Book);
            Process (Book);
         end;
         Next (C);
      end loop;
   end Books_By_Author;

end Libraries;





