ulid.adb

with Ada.Calendar.Formatting;

package body ULID is

  --  Crockford's Base32 (5 bits per symbol):
  crockford : constant String (1 .. 32) := "0123456789ABCDEFGHJKMNPQRSTVWXYZ";

  function Decode (Text : String) return ULID_Number is
    index : Integer;
    reverse_crockford : array (Character) of Integer;
    single_digit : Integer;
    invalid : constant := -1;
    result : ULID_Number := 0;
  begin
    case Text'Length is

      when 26 =>
        reverse_crockford := (others => invalid);
        for i in crockford'Range loop
          reverse_crockford (crockford (i)) := i - 1;
        end loop;
        for c of Text loop
          single_digit := reverse_crockford (c);
          if single_digit = invalid then
            raise Invalid_Text
              with "Error in Crockford's Base32 representation";
          end if;
          result := result * 32 + ULID_Number (single_digit);
        end loop;

      when 36 =>
        index := Text'First;
        for hexa_digit in 1 .. 16 loop
          single_digit :=
            Integer'Value ("16#" & Text (index .. index + 1) & '#');
          index := index + 2;
          if index <= Text'Last and then Text (index) = '-' then
            if index not in  8 + Text'First | 13 + Text'First |
                            18 + Text'First | 23 + Text'First
            then
              raise Invalid_Text
                with "Misplaced dash in 8-4-4-4-12 representation";
            end if;
            index := index + 1;
          end if;
          result := result * 256 + ULID_Number (single_digit);
        end loop;

      when 38 =>
        if Text (Text'First) = '{' and then Text (Text'Last) = '}' then
          return Decode (Text (Text'First + 1 .. Text'Last - 1));
        else
          raise Invalid_Text
            with "Expecting bracketed 8-4-4-4-12 format for 38 characters";
        end if;

      when others =>
        raise Invalid_Text with "Invalid UILD / UUID text representation";
    end case;

    return result;
  end Decode;

  function Encode (Code : ULID_Number) return String is
    result : String (1 .. 26);
    --  ^ The first 10 characters contain a time information (50 bits,
    --    of them 48 are used); the 16 other characters represent a random
    --    number (80 bits).
    x : ULID_Number := Code;
  begin
    for c of reverse result loop
      c := crockford (1 + Integer (x and 31));
      x := x / 32;
    end loop;
    return result;
  end Encode;

  function Encode_as_8_4_4_4_12 (Code : in ULID_Number) return String is
    result : String (1 .. 36);
    index  : Integer := result'Last;
    base   : constant := 16;
    hexa   : constant String (1 .. base) := "0123456789abcdef";
    work   : ULID_Number := Code;
    b      : Integer;
  begin
    for i in reverse 1 .. 16 loop
      b                  := Integer (work and 255);
      work               := work / 256;
      result (index - 1) := hexa (b  /  base + 1);
      result (index)     := hexa (b mod base + 1);
      index              := index - 2;
      --  Insert dashes
      if i = 5 or else i = 7 or else i = 9 or else i = 11 then
        result (index) := '-';
        index          := index - 1;
      end if;
    end loop;
    return result;
  end Encode_as_8_4_4_4_12;

  procedure Reset (Generator : Random_Generator) is
  begin
    Random_Numbers.Reset (Random_Numbers.Generator (Generator));
  end Reset;

  procedure Reset (Generator : Random_Generator; Seed : Integer) is
  begin
    Random_Numbers.Reset (Random_Numbers.Generator (Generator), Seed);
  end Reset;

  function Generate_Time_Part
    (Leap_Second : Boolean;
     Offset      : Ada.Calendar.Time_Zones.Time_Offset)
  return ULID_Number
  is
    use Ada.Calendar;
    unix_epoch : constant Time :=
      Ada.Calendar.Formatting.Time_Of
        (1970, 1, 1, 0.0, Leap_Second, Offset);
    milliseconds_clock : constant ULID_Number :=
      ULID_Number (1000.0 * (Clock - unix_epoch));
  begin
    return milliseconds_clock * 2 ** 80;
  end Generate_Time_Part;

  function
    Generate_Random_Part (Generator : Random_Generator) return ULID_Number
  is
  begin
    return ULID_Number
      (Random_Numbers.Random
        (Random_Numbers.Generator (Generator)));
  end Generate_Random_Part;

  function Generate
    (Generator   : Random_Generator;
     Leap_Second : Boolean := False;
     Offset      : Ada.Calendar.Time_Zones.Time_Offset := 0)
  return ULID_Number
  is
  (Generate_Time_Part (Leap_Second, Offset) +
   Generate_Random_Part (Generator));

  function Generate_Monotonic
    (Previous    : ULID_Number;
     Generator   : Random_Generator;
     Leap_Second : Boolean := False;
     Offset      : Ada.Calendar.Time_Zones.Time_Offset := 0)
  return ULID_Number
  is
    --  Mask for erasing the random part:
    mask : constant :=  (2 ** 128 - 1) - (2 ** 80 - 1);
    old_time_part : constant ULID_Number := Previous and mask;
    new_time_part : constant ULID_Number :=
      Generate_Time_Part (Leap_Second, Offset);
  begin
    if new_time_part > old_time_part then
      return new_time_part + Generate_Random_Part (Generator);
    else
      --  New time is not new enough: we increment previous value.
      return Previous + 1;
    end if;
  end Generate_Monotonic;

  function Network_Byte_Order (Code : ULID_Number) return Byte_Array is
    result : Byte_Array;
    rest : ULID_Number := Code;
  begin
    for i in reverse result'Range loop
      result (i) := Byte (rest and 255);
      rest := rest / 256;
    end loop;
    return result;
  end Network_Byte_Order;

end ULID;