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;