Natools

Check-in [0ca258c8c8]
Login

Check-in [0ca258c8c8]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:time_keys: new package that provides short printable chronological keys
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0ca258c8c8e9900547fc9515f4c7c3cea5fd28f2
User & Date: nat 2015-01-14 20:55:26.008
Context
2015-01-15
22:48
time_keys-tests: almost-fully covering test suite for time keys check-in: 79433e4065 user: nat tags: trunk
2015-01-14
20:55
time_keys: new package that provides short printable chronological keys check-in: 0ca258c8c8 user: nat tags: trunk
2014-12-15
22:40
constant_indefinite_ordered_map_tests: add a fully-covering test of the new range iterator feature check-in: 98083b9906 user: nat tags: trunk
Changes
Side-by-Side Diff Ignore Whitespace Patch
Added src/natools-time_keys.adb. 





















































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar.Formatting;

package body Natools.Time_Keys is

   function Extract_Sub_Second (Key : String) return Duration;
      --  Read the end of Buffer and compute the Sub_Second part


   ------------------------------
   -- Local Helper Subprograms --
   ------------------------------

   function Extract_Sub_Second (Key : String) return Duration is
      Sub_Second : Duration := 0.0;
   begin
      for I in reverse Key'First + 7 .. Key'Last loop
         Sub_Second := (Sub_Second + Duration (Value (Key (I)))) / 32;
         Sub_Second := (Sub_Second + Duration'Small) / 2;
      end loop;

      return Sub_Second;
   end Extract_Sub_Second;



   -----------------------
   -- Publoic Interface --
   -----------------------

   function To_Key
     (Time : Ada.Calendar.Time;
      Max_Sub_Second_Digits : in Natural := 120)
     return String
   is
      Buffer : String (1 .. 7 + Max_Sub_Second_Digits);
      Last : Positive;
      N : Natural;
      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Hour : Ada.Calendar.Formatting.Hour_Number;
      Minute : Ada.Calendar.Formatting.Minute_Number;
      Second : Ada.Calendar.Formatting.Second_Number;
      Sub_Second : Ada.Calendar.Formatting.Second_Duration;
      D, Base : Duration;
      Leap_Second : Boolean;
   begin
      Ada.Calendar.Formatting.Split
        (Time,
         Year, Month, Day, Hour, Minute, Second, Sub_Second,
         Leap_Second);

      Buffer (1) := I_Image (Year / 64);
      Buffer (2) := I_Image (Year mod 64);
      Buffer (3) := I_Image (Month);
      Buffer (4) := I_Image (Day);
      Buffer (5) := I_Image (Hour);
      Buffer (6) := I_Image (Minute);

      if Leap_Second then
         pragma Assert (Second = 59);
         Buffer (7) := I_Image (60);
      else
         Buffer (7) := I_Image (Second);
      end if;

      if Sub_Second = 0.0 then
         if Second = 0 then
            if Minute = 0 then
               if Hour = 0 then
                  return Buffer (1 .. 4);
               else
                  return Buffer (1 .. 5);
               end if;
            else
               return Buffer (1 .. 6);
            end if;
         else
            return Buffer (1 .. 7);
         end if;
      end if;

      Last := 7;
      D := Sub_Second * 64;
      Base := 1.0;
      loop
         Last := Last + 1;
         Base := Base / 64.0;
         N := Natural (D);

         if Last = Buffer'Last or Base = 0.0 then
            Buffer (Last) := I_Image (N);
            exit;
         end if;

         if Duration (N) > D then
            N := N - 1;
            pragma Assert (Duration (N) <= D);
         end if;

         D := (D - Duration (N)) * 64;
         Buffer (Last) := I_Image (N);

         exit when D = 0.0;
      end loop;

      return Buffer (1 .. Last);
   end To_Key;


   function To_Time (Key : String) return Ada.Calendar.Time is
      Leap_Second : constant Boolean
        := Key'First + 6 in Key'Range and then Key (Key'First + 6) = 'x';
   begin
      return Ada.Calendar.Formatting.Time_Of
        (Year        => I_Value (Key (Key'First)) * 64
                      + I_Value (Key (Key'First + 1)),
         Month       => I_Value (Key (Key'First + 2)),
         Day         => I_Value (Key (Key'First + 3)),
         Hour        => (if Key'First + 4 in Key'Range
                         then I_Value (Key (Key'First + 4)) else 0),
         Minute      => (if Key'First + 5 in Key'Range
                         then I_Value (Key (Key'First + 5)) else 0),
         Second      => (if Key'First + 6 in Key'Range
                         then (if Leap_Second then 59
                               else I_Value (Key (Key'First + 6)))
                         else 0),
         Sub_Second  => Extract_Sub_Second (Key),
         Leap_Second => Leap_Second);
   end To_Time;

end Natools.Time_Keys;






Added src/natools-time_keys.ads.













































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Natools.Time_Keys provides a concise but printable representation of     --
-- time where lexicographical order matches chronological order.            --
-- It is based on a base-64 symbol set that preserve order, picked from URL --
-- unreserved character set.                                                --
-- It consists simply of time components in big-endian order, trimming      --
-- tailing zeros, and using two base-64 digits for the year, which gives a  --
-- 4096 year span.                                                          --
-- This means a second granularity can be achieved with 7 characters. The   --
-- most compact way of encoding such a timestamp would be counting seconds, --
-- like UNIX time. The time covered by this format is rought 2^37 seconds,  --
-- which would mean 5 bytes or 7 base-64 digits (though 6 would be enough   --
-- for a useful time range).                                                --
------------------------------------------------------------------------------

with Ada.Calendar;

package Natools.Time_Keys is

   function Is_Valid (Key : String) return Boolean;
      --  Check whether Key is a valid encoded time.
      --  WARNING: this function returns true for invalid dates,
      --  like February 30th.

   function To_Key
     (Time : Ada.Calendar.Time;
      Max_Sub_Second_Digits : in Natural := 120)
     return String
     with Post => Is_Valid (To_Key'Result);
      --  Convert a time into a key

   function To_Time (Key : String) return Ada.Calendar.Time
     with Pre => Is_Valid (Key);
      --  Convert a valid key into the original time

private

   subtype Base_64_Digit is Character with Static_Predicate
     => Base_64_Digit in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~';

   type Base_64_Value is mod 2 ** 6;

   Digit_Offset : constant := 48;  --  Character'Pos ('0')
   Upper_Offset : constant := 55;  --  Character'Pos ('A') - 10
   Lower_Offset : constant := 60;  --  Character'Pos ('a') - 37

   function Value (Digit : Base_64_Digit) return Base_64_Value
     is (Base_64_Value
           (case Digit is
            when '0' .. '9' => Character'Pos (Digit) - Digit_Offset,
            when 'A' .. 'Z' => Character'Pos (Digit) - Upper_Offset,
            when '_'        => 36,
            when 'a' .. 'z' => Character'Pos (Digit) - Lower_Offset,
            when '~'        => 63));

   function I_Value (Digit : Base_64_Digit) return Integer
     is (Integer (Value (Digit)));

   function Image (Digit : Base_64_Value) return Base_64_Digit
     is (case Digit is
         when  0 ..  9 => Character'Val (Natural (Digit) + Digit_Offset),
         when 10 .. 35 => Character'Val (Natural (Digit) + Upper_Offset),
         when    36    => '_',
         when 37 .. 62 => Character'Val (Natural (Digit) + Lower_Offset),
         when    63    => '~');

   function I_Image (Digit : Integer) return Base_64_Digit
     is (Image (Base_64_Value (Digit)));

   function Is_Valid (Key : String) return Boolean
     is (Key'Length >= 4
         and then Key (Key'First)
               in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~'
         and then Key (Key'First + 1)
               in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~'
         and then Key (Key'First + 2) in '1' .. '9' | 'A' .. 'C'
         and then Key (Key'First + 3) in '1' .. '9' | 'A' .. 'V'
         and then (Key'First + 4 not in Key'Range
            or else Key (Key'First + 4) in '0' .. '9' | 'A' .. 'N')
         and then (Key'First + 5 not in Key'Range or else Key (Key'First + 5)
               in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'w')
         and then (Key'First + 6 not in Key'Range or else Key (Key'First + 6)
               in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'x')
         and then (for all I in Key'First + 7 .. Key'Last => Key (I)
               in '0' .. '9' | 'A' .. 'Z' | '_' | 'a' .. 'z' | '~'));

end Natools.Time_Keys;