Natools

natools-s_expressions-templates-dates.adb at [a76936f058]
Login

File src/natools-s_expressions-templates-dates.adb artifact d0583f55af part of check-in a76936f058


------------------------------------------------------------------------------
-- Copyright (c) 2014-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 Natools.S_Expressions.Interpreter_Loop;
with Natools.S_Expressions.Templates.Generic_Discrete_Render;
with Natools.S_Expressions.Templates.Integers;
with Natools.Static_Maps.S_Expressions.Templates.Dates;
with Natools.Time_IO.RFC_3339;

package body Natools.S_Expressions.Templates.Dates is

   package Commands renames Natools.Static_Maps.S_Expressions.Templates.Dates;

   procedure Render_Day_Of_Week
     is new Natools.S_Expressions.Templates.Generic_Discrete_Render
     (Ada.Calendar.Formatting.Day_Name,
      Ada.Calendar.Formatting.Day_Name'Image,
      Ada.Calendar.Formatting."=");

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom);

   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class);

   function Two_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 10),
          2 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 99;

   function Four_Digit_Image (Value : Integer) return Atom
     is ((1 => Character'Pos ('0') + Octet (Value / 1000),
          2 => Character'Pos ('0') + Octet ((Value / 100) mod 10),
          3 => Character'Pos ('0') + Octet ((Value / 10) mod 10),
          4 => Character'Pos ('0') + Octet (Value mod 10)))
     with Pre => Value in 0 .. 9999;

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset;

   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class);


   procedure Interpreter is new Interpreter_Loop
     (Ada.Streams.Root_Stream_Type'Class, Split_Time, Execute, Append);


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

   function Parse_Time_Offset
     (Image : in String;
      Date : in Ada.Calendar.Time)
     return Ada.Calendar.Time_Zones.Time_Offset
   is
      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset;

      function Value (C : Character)
        return Ada.Calendar.Time_Zones.Time_Offset is
      begin
         if C in '0' .. '9' then
            return Ada.Calendar.Time_Zones.Time_Offset
                    (Character'Pos (C) - Character'Pos ('0'));
         else
            raise Constraint_Error with "Unknown time offset format";
         end if;
      end Value;
   begin
      if Image = "system" then
         return Ada.Calendar.Time_Zones.UTC_Time_Offset (Date);
      end if;

      Abbreviation :
      begin
         return Ada.Calendar.Time_Zones.Time_Offset
           (Static_Maps.S_Expressions.Templates.Dates.To_Time_Offset (Image));
      exception
         when Constraint_Error => null;
      end Abbreviation;

      Numeric :
      declare
         use type Ada.Calendar.Time_Zones.Time_Offset;
         First : Integer := Image'First;
         Length : Natural := Image'Length;
         V : Ada.Calendar.Time_Zones.Time_Offset;
         Negative : Boolean := False;
      begin
         if First in Image'Range and then Image (First) in '-' | '+' then
            Negative := Image (First) = '-';
            First := First + 1;
            Length := Length - 1;
         end if;

         case Length is
            when 1 =>
               V := Value (Image (First)) * 60;

            when 2 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60;

            when 4 =>
               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 2)) * 10
                  + Value (Image (First + 3));

            when 5 =>
               if Image (First + 2) in '0' .. '9' then
                  raise Constraint_Error with "Unknown time offset format";
               end if;

               V := Value (Image (First)) * 600
                  + Value (Image (First + 1)) * 60
                  + Value (Image (First + 3)) * 10
                  + Value (Image (First + 4));

            when others =>
               raise Constraint_Error with "Unknown time offset format";
         end case;

         if Negative then
            return -V;
         else
            return V;
         end if;
      end Numeric;
   end Parse_Time_Offset;


   procedure Render_Triplet
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Part_1, Part_2, Part_3 : in Atom;
      Template : in out Lockable.Descriptor'Class) is
   begin
      Output.Write (Part_1);

      if Template.Current_Event = Events.Add_Atom then
         declare
            Separator : constant Atom := Template.Current_Atom;
            Event : Events.Event;
         begin
            Template.Next (Event);

            Output.Write (Separator);
            Output.Write (Part_2);

            if Event = Events.Add_Atom then
               Output.Write (Template.Current_Atom);
            else
               Output.Write (Separator);
            end if;
         end;
      else
         Output.Write (Part_2);
      end if;

      Output.Write (Part_3);
   end Render_Triplet;



   ----------------------------
   -- Interpreter Components --
   ----------------------------

   procedure Append
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Data : in Atom)
   is
      pragma Unreferenced (Value);
   begin
      Output.Write (Data);
   end Append;


   procedure Execute
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Value : in Split_Time;
      Name : in Atom;
      Arguments : in out Lockable.Descriptor'Class)
   is
      Format : Integers.Format;
   begin
      case Commands.Main (To_String (Name)) is
         when Commands.Error =>
            null;

         when Commands.Big_Endian_Date =>
            Render_Triplet
              (Output,
               Four_Digit_Image (Value.Year),
               Two_Digit_Image (Value.Month),
               Two_Digit_Image (Value.Day),
               Arguments);

         when Commands.Big_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Hour),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Second),
               Arguments);

         when Commands.Day =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Day_Of_Week =>
            Render_Day_Of_Week (Output, Arguments, Value.Day_Of_Week);

         when Commands.Hour =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Little_Endian_Date =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Day),
               Two_Digit_Image (Value.Month),
               Four_Digit_Image (Value.Year),
               Arguments);

         when Commands.Little_Endian_Time =>
            Render_Triplet
              (Output,
               Two_Digit_Image (Value.Second),
               Two_Digit_Image (Value.Minute),
               Two_Digit_Image (Value.Hour),
               Arguments);

         when Commands.Minute =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Month =>
            Format.Set_Image (0, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Day =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Day);

         when Commands.Padded_Hour =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Hour);

         when Commands.Padded_Minute =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Minute);

         when Commands.Padded_Month =>
            Format.Set_Image (0, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Month);

         when Commands.Padded_Second =>
            Format.Set_Image (-1, Null_Atom);
            Format.Set_Minimum_Width (2);
            Format.Set_Left_Padding ((1 => Character'Pos ('0')));
            Format.Set_Align (Integers.Right_Aligned);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.RFC_3339 =>
            Output.Write (To_Atom
              (Time_IO.RFC_3339.Image (Value.Source, Value.Time_Zone)));

         when Commands.Second =>
            Format.Set_Image (-1, Null_Atom);
            Integers.Render (Output, Format, Arguments, Value.Second);

         when Commands.With_Offset =>
            if Arguments.Current_Event = Events.Add_Atom then
               declare
                  use type Ada.Calendar.Time_Zones.Time_Offset;
                  New_Offset : Ada.Calendar.Time_Zones.Time_Offset;
               begin
                  begin
                     New_Offset := Parse_Time_Offset
                       (S_Expressions.To_String (Arguments.Current_Atom),
                        Value.Source);
                  exception
                     when Constraint_Error => return;
                  end;

                  Arguments.Next;

                  if New_Offset = Value.Time_Zone then
                     Interpreter (Arguments, Output, Value);
                  else
                     Render (Output, Arguments, Value.Source, New_Offset);
                  end if;
               end;
            end if;

         when Commands.Year =>
            Integers.Render (Output, Arguments, Value.Year);
      end case;
   end Execute;



   ----------------------
   -- Public Interface --
   ----------------------

   function Split
     (Value : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset)
     return Split_Time
   is
      use type Ada.Calendar.Time_Zones.Time_Offset;
      Zone_Offset : constant Ada.Calendar.Time_Zones.Time_Offset
        := Time_Zone - Ada.Calendar.Time_Zones.UTC_Time_Offset (Value);

      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;
   begin
      Ada.Calendar.Formatting.Split
        (Value,
         Year, Month, Day,
         Hour, Minute, Second,
         Sub_Second,
         Time_Zone);

      return Split_Time'
        (Source => Value,
         Time_Zone => Time_Zone,
         Year => Year,
         Month => Month,
         Day => Day,
         Day_Of_Week => Ada.Calendar.Formatting.Day_Of_Week
           (Ada.Calendar."+" (Value, 60 * Duration (Zone_Offset))),
         Hour => Hour,
         Minute => Minute,
         Second => Second,
         Sub_Second => Sub_Second);
   end Split;


   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time) is
   begin
      Render
        (Output,
         Template,
         Value,
         Ada.Calendar.Time_Zones.UTC_Time_Offset (Value));
   end Render;


   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset) is
   begin
      Render (Output, Template, Split (Value, Time_Zone));
   end Render;


   procedure Render
     (Output : in out Ada.Streams.Root_Stream_Type'Class;
      Template : in out Lockable.Descriptor'Class;
      Value : in Split_Time) is
   begin
      Interpreter (Template, Output, Value);
   end Render;

end Natools.S_Expressions.Templates.Dates;