Natools

natools-s_expressions-templates-dates.adb at [6a2a4d94a0]
Login

File src/natools-s_expressions-templates-dates.adb artifact ef7fabb3a6 part of check-in 6a2a4d94a0


------------------------------------------------------------------------------
-- 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 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;

   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);


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

   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.Year =>
            Integers.Render (Output, Arguments, Value.Year);
      end case;
   end Execute;


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



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

   function Split
     (Value : Ada.Calendar.Time;
      Time_Zone : Ada.Calendar.Time_Zones.Time_Offset)
     return Split_Time
   is
      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 (Value),
         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;