ADDED src/natools-time_io-human.adb
Index: src/natools-time_io-human.adb
==================================================================
--- src/natools-time_io-human.adb
+++ src/natools-time_io-human.adb
@@ -0,0 +1,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
Index: src/natools-time_io-human.ads
==================================================================
--- src/natools-time_io-human.ads
+++ src/natools-time_io-human.ads
@@ -0,0 +1,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
Index: src/natools-time_io.ads
==================================================================
--- src/natools-time_io.ads
+++ src/natools-time_io.ads
@@ -0,0 +1,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;