with sql_exceptions;
with sql_standard;

package body sql_char_pkg is
   
   use sql_standard. character_set;
   null_value_error : exception renames sql_exceptions. null_value_error;
   
   procedure assign 
      (left : out sql_char; 
       right : sql_char) 
   is
   begin 
      if right. is_null then
         left. is_null := true;
      else
         left. is_null := false;
         if left. length >= right. unpadded_length then
            left. unpadded_length := right. unpadded_length;
            left. text := 
               right. text (1 .. right. unpadded_length) 
               & sql_char_not_null'(right. unpadded_length + 1 
                                    .. left. length 
                                       => ' ');
         else
            left. text (1 .. left. length) := right. text (1 .. left. length);
            declare
               unpadded_length_ctr : natural := left. length;
            begin 
               for i in reverse 1 .. left. length loop
                  exit when right. text (i) /= ' ';
                  unpadded_length_ctr := unpadded_length_ctr - 1;
               end loop;
               left. unpadded_length := unpadded_length_ctr;
            end;
         end if;
      end if;
   end assign;
   
   
   function with_null_base 
      (value : sql_char_not_null) 
      return sql_char 
   is
      
      unpadded_length_ctr : natural := value'length;
      subtype intermed is 
         sql_char_not_null (1 .. value'length);
       
    
   begin 
      for i in value'first .. value'last loop
         exit when value (i) /= ' ';
         unpadded_length_ctr := unpadded_length_ctr - 1;
      end loop;
      return 
         (length => value'length, is_null => false, 
          unpadded_length => unpadded_length_ctr, 
          text => intermed (value));
   end with_null_base;
   
   
   function without_null_base (value : sql_char) return sql_char_not_null is
   begin 
      if value. is_null then
         raise null_value_error;
      else
         return value. text;
      end if;
   end without_null_base;
   
   
   function without_null_unpadded_base 
      (value : sql_char) 
      return sql_char_not_null 
   is
   begin 
      if value. is_null then
         raise null_value_error;
      else
         return (value. text (1 .. value. unpadded_length));
      end if;
   end without_null_unpadded_base;
   
   
   function null_sql_char return sql_char is
      
      null_holder : sql_char (1);
    
   begin 
      return (null_holder);
   end null_sql_char;
   
   function to_string 
      (value : sql_char_not_null) 
      return string 
   is separate;
   
   function to_string (value : sql_char) return string is
   begin 
      if value. is_null then
         raise null_value_error;
      else
         return (to_string (value. text));
      end if;
   end to_string;
   
   
   function to_unpadded_string 
      (value : sql_char_not_null) 
      return string 
   is
   begin 
      return 
         (to_string (without_null_unpadded_base (with_null_base (value))));
   end to_unpadded_string;
   
   
   function to_unpadded_string 
      (value : sql_char) 
      return string 
   is
   begin 
      if value. is_null then
         raise null_value_error;
      else
         return (to_string (value. text (1 .. value. unpadded_length)));
      end if;
   end to_unpadded_string;
   
   function to_sql_char_not_null (value : string) return sql_char_not_null is separate;
   
   function to_sql_char 
      (value : string) 
      return sql_char 
   is
      
      unpadded_length_ctr : natural := value'length;
      subtype intermed is 
         sql_char_not_null (1 .. value'length);
       
    
   begin 
      for i in reverse value'first .. value'last loop
         exit when value (i) /= ' ';
         unpadded_length_ctr := unpadded_length_ctr - 1;
      end loop;
      return 
         (length => value'length, is_null => false, 
          unpadded_length => unpadded_length_ctr, 
          text => intermed (to_sql_char_not_null (value)));
   end to_sql_char;
   
   
   function unpadded_length 
      (value : sql_char) 
      return sql_unpadded_length 
   is
   begin 
      if value. is_null then
         raise null_value_error;
      else
         return value. unpadded_length;
      end if;
   end;
   
   
   function substring 
      (value : sql_char; 
       start, length : sql_char_length) 
      return sql_char 
   is
   begin 
      if value. is_null then
         return null_sql_char;
      elsif (start + length - 1) > value. length then
         raise constraint_error;
      else
         return with_null_base (value. text (start .. start + length - 1));
      end if;
   end substring;
   
   
   function "&" (left, right : sql_char) return sql_char is
   begin 
      if left. is_null or else right. is_null then
         return null_sql_char;
      else
         return 
            with_null_base 
               (without_null_base (left) & without_null_base (right));
      end if;
   end "&";
   
   
   function equals 
      (left, right : sql_char) 
      return boolean_with_unknown 
   is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            = right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end equals;
   
   
   function not_equals 
      (left, right : sql_char) 
      return boolean_with_unknown 
   is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            /= right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end not_equals;
   
   
   function ">" (left, right : sql_char) return boolean_with_unknown is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            > right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end ">";
   
   
   function ">=" 
      (left, right : sql_char) 
      return boolean_with_unknown 
   is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            >= right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end ">=";
   
   
   function "<" (left, right : sql_char) return boolean_with_unknown is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            < right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end "<";
   
   
   function "<=" (left, right : sql_char) return boolean_with_unknown is
   begin 
      if left. is_null or else right. is_null then
         return unknown;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            <= right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end "<=";
   
   
   function is_null 
      (value : sql_char) 
      return boolean 
   is
   begin 
      return value. is_null;
   end is_null;
   
   
   function not_null 
      (value : sql_char) 
      return boolean 
   is
   begin 
      return value. is_null;
   end not_null;
   
   
   function "=" 
      (left, right : sql_char) 
      return boolean 
   is
   begin 
      if left. is_null or else right. is_null then
         return false;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            = right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end "=";
   
   
   function "<" 
      (left, right : sql_char) 
      return boolean 
   is
   begin 
      if left. is_null or else right. is_null then
         return false;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            < right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end "<";
   
   
   function ">" 
      (left, right : sql_char) 
      return boolean 
   is
   begin 
      if left. is_null or else right. is_null then
         return false;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            > right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end ">";
   
   
   function "<=" (left, right : sql_char) return boolean is
   begin 
      if left. is_null or else right. is_null then
         return false;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            <= right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end "<=";
   
   
   function ">=" (left, right : sql_char) return boolean is
   begin 
      if left. is_null or else right. is_null then
         return false;
      else
         if 
            left. text (1 .. left. unpadded_length) 
            <= right. text (1 .. right. unpadded_length) 
         then
            return true;
         else
            return false;
         end if;
      end if;
   end ">=";
   
   
   package body sql_char_ops is
      
      
      function with_null (value : without_null_type) return with_null_type is
      begin 
         return with_null_base (sql_char_not_null (value));
      end with_null;
      
      
      function without_null 
         (value : with_null_type) 
         return without_null_type 
      is
      begin 
         return 
            without_null_type 
               (sql_char_not_null'(without_null_base (value)));
      end without_null;
      
      
      function without_null_unpadded 
         (value : with_null_type) 
         return without_null_type 
      is
      begin 
         return 
            without_null_type 
               (sql_char_not_null'(without_null_unpadded_base (value)));
      end without_null_unpadded;
      
    
   end sql_char_ops;
   
 
end sql_char_pkg;