Natools

Check-in [576830db63]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:time_io-human: new package for human-friendly I/O of time-related types
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 576830db6390a366062d868515a2399d66301a0a
User & Date: nat on 2014-08-15 17:27:36
Other Links: manifest | tags
Context
2014-08-16
17:33
time_io-tests: test suite for Time_IO subprograms, checking time interval images check-in: 830bf444c4 user: nat tags: trunk
2014-08-15
17:27
time_io-human: new package for human-friendly I/O of time-related types check-in: 576830db63 user: nat tags: trunk
2014-08-14
17:11
cron-tests: use the new Generic_Check tool check-in: 7daa408712 user: nat tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Added src/natools-time_io-human.adb version [43d8a8e01c]. 






















































































































































































































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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212

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

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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.Arithmetic;

package body Natools.Time_IO.Human is

   ---------------------
   -- Duration Images --
   ---------------------

   function Difference_Image
     (Left, Right : Ada.Calendar.Time;
      Use_Weeks : Boolean := False)
     return String
   is
      use type Ada.Calendar.Arithmetic.Day_Count;

      Days, Rounded_Days : Ada.Calendar.Arithmetic.Day_Count;
      Seconds : Duration;
      Leap_Seconds : Ada.Calendar.Arithmetic.Leap_Seconds_Count;
   begin
      if Ada.Calendar."<" (Left, Right) then
         return '-' & Difference_Image
           (Left => Right,
            Right => Left,
            Use_Weeks => Use_Weeks);
      end if;

      Ada.Calendar.Arithmetic.Difference
        (Left, Right,
         Days, Seconds, Leap_Seconds);

      Seconds := Seconds - 86400.0 + Duration (Leap_Seconds);
      if Seconds >= 0.0 then
         Days := Days + 1;
      else
         Seconds := Seconds + 86400.0;
      end if;

      if Seconds >= 43200.0 then
         Rounded_Days := Days + 1;
      else
         Rounded_Days := Days;
      end if;

      if Use_Weeks and then Rounded_Days >= 7 then
         declare
            Weeks : constant Ada.Calendar.Arithmetic.Day_Count
              := Rounded_Days / 7;
         begin
            Rounded_Days := Rounded_Days - Weeks * 7;
            if Weeks >= 10 or Rounded_Days = 0 then
               return Trim_Image
                 (Ada.Calendar.Arithmetic.Day_Count'Image (Weeks)) & 'w';
            else
               return Trim_Image
                 (Ada.Calendar.Arithmetic.Day_Count'Image (Weeks)) & 'w'
                 & Ada.Calendar.Arithmetic.Day_Count'Image (Rounded_Days)
                 & 'd';
            end if;
         end;

      elsif Rounded_Days >= 10 then
         return Trim_Image
           (Ada.Calendar.Arithmetic.Day_Count'Image (Rounded_Days)) & 'd';

      elsif Days > 0 then
         declare
            Hours : constant Natural := Natural (Seconds / 3600);
         begin
            case Hours is
               when 0 =>
                  return Trim_Image
                    (Ada.Calendar.Arithmetic.Day_Count'Image (Days)) & 'd';
               when 1 .. 23 =>
                  return Trim_Image
                    (Ada.Calendar.Arithmetic.Day_Count'Image (Days)) & 'd'
                    & Natural'Image (Hours) & 'h';
               when 24 =>
                  return Trim_Image
                    (Ada.Calendar.Arithmetic.Day_Count'Image (Days + 1)) & 'd';
               when others =>
                  raise Program_Error;
            end case;
         end;

      else
         return Image (Seconds);
      end if;
   end Difference_Image;


   function Image (Value : Duration) return String is
      function Local_Image
        (Mul_1, Div : Positive;
         Unit_1 : String;
         Mul_2 : Positive;
         Unit_2 : String)
        return String;

      function Scientific_Image (Mul : Positive; Unit : String) return String;


      function Local_Image
        (Mul_1, Div : Positive;
         Unit_1 : String;
         Mul_2 : Positive;
         Unit_2 : String)
        return String
      is
         Scaled : constant Duration := Value * Mul_1 / Div;
         Main : constant Natural := Natural (Scaled - 0.5);
         Secondary : constant Natural
           := Natural ((Scaled - Duration (Main)) * Mul_2);
      begin
         pragma Assert (Secondary <= Mul_2);

         if Secondary = Mul_2 then
            return Trim_Image (Natural'Image (Main + 1)) & Unit_1;

         elsif Secondary = 0 then
            return Trim_Image (Natural'Image (Main)) & Unit_1;

         else
            return Trim_Image (Natural'Image (Main)) & Unit_1
              & Natural'Image (Secondary) & Unit_2;
         end if;
      end Local_Image;

      function Scientific_Image (Mul : Positive; Unit : String)
        return String
      is
         Scaled : constant Duration := Value * Mul;
         I_Part : constant Natural := Natural (Scaled - 0.5);
         F_Part : constant Natural
           := Natural ((Scaled - Duration (I_Part)) * 1000);
      begin
         if F_Part = 0 then
            return Trim_Image (Natural'Image (I_Part)) & Unit;
         elsif F_Part = 1000 then
            return Trim_Image (Natural'Image (I_Part + 1)) & Unit;
         else
            return Trim_Image (Natural'Image (I_Part))
              & ('.',
               Image (F_Part / 100),
               Image ((F_Part / 10) mod 10),
               Image (F_Part mod 10))
              & Unit;
         end if;
      end Scientific_Image;
   begin
      if Value < 0.0 then
         return '-' & Image (-Value);

      elsif Value = 0.0 then
         return "0s";

      elsif Value >= 86400.0 - 1800.0 then
         return Local_Image (1, 86400, "d", 24, "h");

      elsif Value >= 36000.0 then
         return Trim_Image (Positive'Image (Positive (Value / 3600))) & 'h';

      elsif Value >= 3600.0 - 30.0 then
         return Local_Image (1, 3600, "h", 60, "m");

      elsif Value >= 600.0 then
         return Trim_Image (Positive'Image (Positive (Value / 60))) & " min";

      elsif Value >= 60.0 - 0.5 then
         return Local_Image (1, 60, " min", 60, "s");

      elsif Value >= 10.0 then
         return Trim_Image (Positive'Image (Positive (Value))) & 's';

      elsif Value >= 1.0 then
         return Scientific_Image (1, " s");

      elsif Value >= 0.01 then
         return Trim_Image (Positive'Image (Positive (Value * 1000))) & " ms";

      elsif Value >= 0.001 then
         return Scientific_Image (1_000, " ms");

      elsif Value >= 0.000_01 then
         return Trim_Image
           (Positive'Image (Positive (Value * 1_000_000))) & " us";

      elsif Value >= 0.000_001 then
         return Scientific_Image (1_000_000, " us");

      else
         return Scientific_Image (1_000_000_000, " ns");
      end if;
   end Image;

end Natools.Time_IO.Human;









Added src/natools-time_io-human.ads version [74852e7111].












































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

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

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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_IO.Human provides human-friendly images of time-related     --
-- types, and format-guessing parsing of human input into time-related      --
-- types.                                                                   --
------------------------------------------------------------------------------

with Ada.Calendar;

package Natools.Time_IO.Human is

   function Difference_Image
     (Left, Right : Ada.Calendar.Time;
      Use_Weeks : Boolean := False)
     return String;
      --  Return an image of the time interval from Right to Left, i.e.
      --  the amount of time represented by Left-Right if it would fit
      --  in Duration type.
      --  Use_Weeks controls whether intervals longer than 7 days are
      --  represented as a number of weeks or of days, i.e. "51d" or "7w 2d".

   function Image (Value : Duration) return String;
      --  Return an image of the given time interval

end Natools.Time_IO.Human;








Added src/natools-time_io.ads version [4802e14da5].















































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

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

------------------------------------------------------------------------------
-- Copyright (c) 2014, 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_IO is a minimal parent for children packages which provide  --
-- subprograms to serialize and deserialize times to and from various       --
-- String representations.                                                  --
------------------------------------------------------------------------------

package Natools.Time_IO is
   pragma Pure;

private

   subtype Digit_Character is Character range '0' .. '9';

   subtype Digit_Number is Integer range 0 .. 9;

   function Image (N : Digit_Number) return Digit_Character
     is (Character'Val (N + Character'Pos (Digit_Character'First)));

   function Value (C : Digit_Character) return Digit_Number
     is (Character'Pos (C) - Character'Pos (Digit_Character'First));

   function Trim_Image (Raw_Image : String) return String
     is (if Raw_Image'Length > 0 and then Raw_Image (Raw_Image'First) = ' '
         then Raw_Image (Raw_Image'First + 1 .. Raw_Image'Last)
         else Raw_Image);

end Natools.Time_IO;













This page was generated in about
0.004s by
Fossil 2.23 [47362306a7] 2023-11-01 18:56:47