From 36b0cbf19bd44c94bbe5aa67730347290f20628c Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Tue, 9 Nov 2021 17:05:44 +1300 Subject: Refactored packages --- src/csv.adb | 111 ----------- src/csv.ads | 62 ------ src/datatypes.ads | 93 --------- src/deck_convert.adb | 57 ++---- src/deck_convert_gui.adb | 64 ++---- src/deck_convert_gui.ads | 3 + src/deck_io.adb | 508 ----------------------------------------------- src/deck_io.ads | 100 ---------- src/deckdata-csv.adb | 109 ++++++++++ src/deckdata-csv.ads | 44 ++++ src/deckdata-fmd.adb | 212 ++++++++++++++++++++ src/deckdata-fmd.ads | 89 +++++++++ src/deckdata-io.adb | 493 +++++++++++++++++++++++++++++++++++++++++++++ src/deckdata-io.ads | 92 +++++++++ src/deckdata-process.adb | 54 +++++ src/deckdata-process.ads | 15 ++ src/deckdata.ads | 107 ++++++++++ src/fmd.adb | 214 -------------------- src/fmd.ads | 106 ---------- 19 files changed, 1245 insertions(+), 1288 deletions(-) delete mode 100644 src/csv.adb delete mode 100644 src/csv.ads delete mode 100644 src/datatypes.ads delete mode 100644 src/deck_io.adb delete mode 100644 src/deck_io.ads create mode 100644 src/deckdata-csv.adb create mode 100644 src/deckdata-csv.ads create mode 100644 src/deckdata-fmd.adb create mode 100644 src/deckdata-fmd.ads create mode 100644 src/deckdata-io.adb create mode 100644 src/deckdata-io.ads create mode 100644 src/deckdata-process.adb create mode 100644 src/deckdata-process.ads create mode 100644 src/deckdata.ads delete mode 100644 src/fmd.adb delete mode 100644 src/fmd.ads (limited to 'src') diff --git a/src/csv.adb b/src/csv.adb deleted file mode 100644 index 656f99f..0000000 --- a/src/csv.adb +++ /dev/null @@ -1,111 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Characters.Latin_1, - Ada.Strings.Fixed, - Ada.Strings.Maps, - Ada.Text_IO, - Datatypes; - -use - - Ada.Text_IO; - - -package body CSV is - - - package Latin renames Ada.Characters.Latin_1; - package Strfix renames Ada.Strings.Fixed; - package Strmap renames Ada.Strings.Maps; - - - - - procedure Put_Cell - (File_Handle : in Ada.Text_IO.File_Type; - Data : in String) is - begin - Put_Cell (File_Handle, +Data); - end Put_Cell; - - - procedure Put_Cell - (File_Handle : in Ada.Text_IO.File_Type; - Data : in Ada.Strings.Unbounded.Unbounded_String) - is - Processed : SU.Unbounded_String := Data; - Position : Natural; - begin - -- Deal with any lurking linefeed characters - loop - Position := SU.Index (Processed, Strmap.To_Set (Latin.LF)); - exit when Position = 0; - SU.Replace_Element (Processed, Position, ' '); - end loop; - - -- Escape any quizzical quotation characters - Position := SU.Index (Processed, Strmap.To_Set (Quote_Char)); - while Position /= 0 loop - SU.Insert (Processed, Position, Strfix."*" (1, Escape_Char)); - Position := Position + 2; -- skip over the \" we already know about - exit when Position > SU.Length (Processed); - Position := SU.Index (Processed, Strmap.To_Set (Quote_Char), Position); - end loop; - - -- Surround any suspicious separator characters - if SU.Index (Processed, Strmap.To_Set (Separator_Char)) /= 0 then - SU.Insert (Processed, 1, Strfix."*" (1, Quote_Char)); - SU.Append (Processed, Quote_Char); - end if; - - Put (File_Handle, -Processed); - end Put_Cell; - - - procedure Put_Header - (File_Handle : in Ada.Text_IO.File_Type; - Titles : in Datatypes.Field_ID_Vector) is - begin - for Position in Datatypes.Field_Ordinal range - Titles.First_Index .. Datatypes.Field_Ordinal'Pred (Titles.Last_Index) - loop - Put_Cell (File_Handle, SU.Unbounded_String (Titles.Element (Position))); - Put (File_Handle, Separator_Char); - end loop; - Put_Cell (File_Handle, SU.Unbounded_String (Titles.Last_Element)); - New_Line (File_Handle); - end Put_Header; - - - procedure Put_Row - (File_Handle : in Ada.Text_IO.File_Type; - Cells : in Datatypes.Field_Vector; - Quantity : in Positive) - is - use type Datatypes.Field_Ordinal; - Counter : Positive := 1; - Position : Datatypes.Field_Ordinal := Cells.First_Index; - begin - while Counter < Quantity loop - if Position <= Cells.Last_Index then - Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); - end if; - Put (File_Handle, Separator_Char); - Position := Datatypes.Field_Ordinal'Succ (Position); - Counter := Counter + 1; - end loop; - if Position <= Cells.Last_Index then - Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); - end if; - New_Line (File_Handle); - end Put_Row; - - -end CSV; - - diff --git a/src/csv.ads b/src/csv.ads deleted file mode 100644 index c2df2e9..0000000 --- a/src/csv.ads +++ /dev/null @@ -1,62 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Containers.Vectors, - Ada.Strings.Unbounded, - Ada.Text_IO, - Datatypes; - - -generic - - Separator_Char : Character := ','; - Quote_Char : Character := '"'; - Escape_Char : Character := '\'; - -package CSV is - - - procedure Put_Cell - (File_Handle : in Ada.Text_IO.File_Type; - Data : in String); - - procedure Put_Cell - (File_Handle : in Ada.Text_IO.File_Type; - Data : in Ada.Strings.Unbounded.Unbounded_String); - - - procedure Put_Header - (File_Handle : in Ada.Text_IO.File_Type; - Titles : in Datatypes.Field_ID_Vector); - - - procedure Put_Row - (File_Handle : in Ada.Text_IO.File_Type; - Cells : in Datatypes.Field_Vector; - Quantity : in Positive); - - -private - - - package SU renames Ada.Strings.Unbounded; - - - function "+" - (S : in String) - return SU.Unbounded_String - renames SU.To_Unbounded_String; - - function "-" - (US : in SU.Unbounded_String) - return String - renames SU.To_String; - - -end CSV; - - diff --git a/src/datatypes.ads b/src/datatypes.ads deleted file mode 100644 index 5ad2f75..0000000 --- a/src/datatypes.ads +++ /dev/null @@ -1,93 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Containers.Vectors, - Ada.Containers.Ordered_Maps, - Ada.Strings.Unbounded; - - -package Datatypes is - - - package SU renames Ada.Strings.Unbounded; - - - - - type Field_Ordinal is new Positive; - type Field_ID is new SU.Unbounded_String; - - package Field_ID_Vectors is new Ada.Containers.Vectors - (Index_Type => Field_Ordinal, - Element_Type => Field_ID); - - subtype Field_ID_Vector is Field_ID_Vectors.Vector; - - - type Template is record - Question : Field_ID_Vectors.Vector; - Answer : Field_ID_Vectors.Vector; - end record; - - package Template_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Template); - - subtype Template_Vector is Template_Vectors.Vector; - - - type Model_ID is new SU.Unbounded_String; - - type Model is record - Fields : Field_ID_Vectors.Vector; - Templates : Template_Vectors.Vector; - end record; - - package Model_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Model_ID, - Element_Type => Model); - - subtype Model_Map is Model_Maps.Map; - - - type Field is new SU.Unbounded_String; - - package Field_Vectors is new Ada.Containers.Vectors - (Index_Type => Field_Ordinal, - Element_Type => Field); - - subtype Field_Vector is Field_Vectors.Vector; - - - type Note is record - Model : Model_ID; - Fields : Field_Vectors.Vector; - end record; - - package Note_Vectors is new Ada.Containers.Vectors - (Index_Type => Positive, - Element_Type => Note); - - subtype Note_Vector is Note_Vectors.Vector; - - - type Media_Name is new SU.Unbounded_String; - type Media_ID is new SU.Unbounded_String; - - package Media_Maps is new Ada.Containers.Ordered_Maps - (Key_Type => Media_Name, - Element_Type => Media_ID); - - type Media_Collection is record - Filename : SU.Unbounded_String; - Map : Media_Maps.Map; - end record; - - -end Datatypes; - - diff --git a/src/deck_convert.adb b/src/deck_convert.adb index 665fa5e..9eed9c7 100644 --- a/src/deck_convert.adb +++ b/src/deck_convert.adb @@ -14,13 +14,13 @@ with Ada.Directories, Ada.Strings.Unbounded, Ada.Text_IO, - Datatypes, - Deck_IO; + Deckdata.IO, + Deckdata.Process; use Ada.Text_IO, - Datatypes; + Deckdata; procedure Deck_Convert is @@ -50,39 +50,6 @@ procedure Deck_Convert is renames SU.To_String; - procedure Strip_Formatting - (Notes : in out Note_Vector) - is - procedure Strip - (Text : in out Note; - Item : in String) - is - Position : Natural; - begin - for F of Text.Fields loop - loop - Position := SU.Index - (Source => SU.Unbounded_String (F), - Pattern => Item, - Going => Ada.Strings.Forward, - Mapping => Charhand.To_Lower'Access); - exit when Position = 0; - SU.Delete (SU.Unbounded_String (F), Position, Position + Item'Length - 1); - end loop; - end loop; - end Strip; - - Formatting : array (Positive range <>) of SU.Unbounded_String := - (+"", +"", +"", +"", +"", +"", +"", +"", - +"", +"", +"", +"", +"", +"", - +"", +"", +"", +"", +"", +""); - begin - for N of Notes loop - for S of Formatting loop - Strip (N, -S); - end loop; - end loop; - end Strip_Formatting; Config : GCom.Command_Line_Configuration; @@ -105,7 +72,7 @@ procedure Deck_Convert is Output_Name : SU.Unbounded_String; - Deck : Deck_IO.Deck_Handle; + Deck : Deckdata.IO.Deck_Handle; Models : Model_Map; Notes : Note_Vector; Media : Media_Collection; @@ -226,22 +193,22 @@ begin if Verbose then Put (Standard_Error, "Opening input deck database..."); end if; - Deck_IO.Open_Database (-Input_Name, Deck); + Deckdata.IO.Open_Database (-Input_Name, Deck); if Verbose then Put_Line (Standard_Error, " Done"); Put (Standard_Error, "Querying models..."); end if; - Deck_IO.Query_Models (Deck, Models); + Deckdata.IO.Query_Models (Deck, Models); if Verbose then Put_Line (Standard_Error, " Done"); Put (Standard_Error, "Querying notes..."); end if; - Deck_IO.Query_Notes (Deck, Notes); + Deckdata.IO.Query_Notes (Deck, Notes); if Verbose then Put_Line (Standard_Error, " Done"); Put (Standard_Error, "Closing database..."); end if; - Deck_IO.Close_Database (Deck); + Deckdata.IO.Close_Database (Deck); if Verbose then Put_Line (Standard_Error, " Done"); New_Line (Standard_Error); @@ -251,7 +218,7 @@ begin if Verbose then Put (Standard_Error, "Stripping formatting from deck notes..."); end if; - Strip_Formatting (Notes); + Deckdata.Process.Strip_Formatting (Notes); if Verbose then Put_Line (Standard_Error, " Done"); New_Line (Standard_Error); @@ -266,7 +233,7 @@ begin if Verbose then Put (Standard_Error, "Writing output to CSV..."); end if; - Deck_IO.Write_CSV (Contain_Dir, Simple_Name, Models, Notes, Overwrite); + Deckdata.IO.Write_CSV (Contain_Dir, Simple_Name, Models, Notes, Overwrite); if Verbose then Put_Line (Standard_Error, " Done"); end if; @@ -274,12 +241,12 @@ begin if Verbose then Put (Standard_Error, "Reading media..."); end if; - Deck_IO.Read_Media_Collection (-Input_Name, Media); + Deckdata.IO.Read_Media_Collection (-Input_Name, Media); if Verbose then Put_Line (Standard_Error, " Done"); Put (Standard_Error, "Writing output to Fresh Memory Dictionary..."); end if; - Deck_IO.Write_FMD (Contain_Dir, Simple_Name, Models, Notes, Media, Overwrite); + Deckdata.IO.Write_FMD (Contain_Dir, Simple_Name, Models, Notes, Media, Overwrite); if Verbose then Put_Line (Standard_Error, " Done"); end if; diff --git a/src/deck_convert_gui.adb b/src/deck_convert_gui.adb index 0c352ed..65bc21d 100644 --- a/src/deck_convert_gui.adb +++ b/src/deck_convert_gui.adb @@ -1,5 +1,8 @@ +-- This source is licensed under the Sunset License v1.0 + + with Ada.Characters.Handling, @@ -7,8 +10,8 @@ with Ada.Exceptions, Ada.Strings.Unbounded, Ada.Text_IO, - Datatypes, - Deck_IO, + Deckdata.IO, + Deckdata.Process, FLTK.Dialogs, FLTK.Widgets.Boxes, FLTK.Widgets.Buttons.Enter, @@ -21,7 +24,7 @@ with use Ada.Text_IO, - Datatypes; + Deckdata; package body Deck_Convert_GUI is @@ -158,43 +161,6 @@ package body Deck_Convert_GUI is - procedure Strip_Formatting - (Notes : in out Note_Vector) - is - procedure Strip - (Text : in out Note; - Item : in String) - is - Position : Natural; - begin - for F of Text.Fields loop - loop - Position := SU.Index - (Source => SU.Unbounded_String (F), - Pattern => Item, - Going => Ada.Strings.Forward, - Mapping => Charhand.To_Lower'Access); - exit when Position = 0; - SU.Delete (SU.Unbounded_String (F), Position, Position + Item'Length - 1); - end loop; - end loop; - end Strip; - - Formatting : array (Positive range <>) of SU.Unbounded_String := - (+"", +"", +"", +"", +"", +"", +"", +"", - +"", +"", +"", +"", +"", +"", - +"", +"", +"", +"", +"", +""); - begin - for N of Notes loop - for S of Formatting loop - Strip (N, -S); - end loop; - end loop; - end Strip_Formatting; - - - - task body Worker is use type FLTK.Widgets.Buttons.State; use type SU.Unbounded_String; @@ -206,7 +172,7 @@ package body Deck_Convert_GUI is Overwrite : Boolean; Strip_Form : Boolean; - Deck : Deck_IO.Deck_Handle; + Deck : Deckdata.IO.Deck_Handle; Models : Model_Map; Notes : Note_Vector; Media : Media_Collection; @@ -258,28 +224,28 @@ package body Deck_Convert_GUI is Status_Box.Set_Label_Color (Status_Black); Status_Box.Set_Label ("MESSAGE: Opening input deck database..."); Status_Box.Redraw_Label; - Deck_IO.Open_Database (-Input_Name, Deck); + Deckdata.IO.Open_Database (-Input_Name, Deck); My_Progress.Set_Value (15.0); My_Progress.Redraw; Status_Box.Set_Label ("MESSAGE: Querying models..."); Status_Box.Redraw_Label; - Deck_IO.Query_Models (Deck, Models); + Deckdata.IO.Query_Models (Deck, Models); My_Progress.Set_Value (30.0); My_Progress.Redraw; Status_Box.Set_Label ("MESSAGE: Querying notes..."); Status_Box.Redraw_Label; - Deck_IO.Query_Notes (Deck, Notes); + Deckdata.IO.Query_Notes (Deck, Notes); My_Progress.Set_Value (45.0); My_Progress.Redraw; Status_Box.Set_Label ("MESSAGE: Closing database..."); Status_Box.Redraw_Label; - Deck_IO.Close_Database (Deck); + Deckdata.IO.Close_Database (Deck); My_Progress.Set_Value (60.0); My_Progress.Redraw; if Strip_Form then Status_Box.Set_Label ("MESSAGE: Stripping formatting from notes..."); Status_Box.Redraw_Label; - Strip_Formatting (Notes); + Deckdata.Process.Strip_Formatting (Notes); My_Progress.Set_Value (70.0); My_Progress.Redraw; end if; @@ -290,7 +256,7 @@ package body Deck_Convert_GUI is if Deck_Format = "csv" then Status_Box.Set_Label ("MESSAGE: Writing output to csv..."); Status_Box.Redraw_Label; - Deck_IO.Write_CSV (Contain_Dir, Simple_Name, Models, Notes, Overwrite); + Deckdata.IO.Write_CSV (Contain_Dir, Simple_Name, Models, Notes, Overwrite); My_Progress.Set_Value (100.0); My_Progress.Redraw; Status_Box.Set_Label ("STATUS: Complete success!"); @@ -299,12 +265,12 @@ package body Deck_Convert_GUI is elsif Deck_Format = "fmd" then Status_Box.Set_Label ("MESSAGE: Reading media..."); Status_Box.Redraw_Label; - Deck_IO.Read_Media_Collection (-Input_Name, Media); + Deckdata.IO.Read_Media_Collection (-Input_Name, Media); My_Progress.Set_Value (85.0); My_Progress.Redraw; Status_Box.Set_Label ("MESSAGE: Writing output to fmd..."); Status_Box.Redraw_Label; - Deck_IO.Write_FMD + Deckdata.IO.Write_FMD (Contain_Dir, Simple_Name, Models, Notes, Media, Overwrite); My_Progress.Set_Value (100.0); My_Progress.Redraw; diff --git a/src/deck_convert_gui.ads b/src/deck_convert_gui.ads index 3273060..be118d5 100644 --- a/src/deck_convert_gui.ads +++ b/src/deck_convert_gui.ads @@ -1,5 +1,8 @@ +-- This source is licensed under the Sunset License v1.0 + + package Deck_Convert_GUI is procedure Show; diff --git a/src/deck_io.adb b/src/deck_io.adb deleted file mode 100644 index 3b48a10..0000000 --- a/src/deck_io.adb +++ /dev/null @@ -1,508 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Characters.Latin_1, - Ada.Directories, - Ada.Strings.Fixed, - Ada.Strings.Maps, - Ada.Text_IO, - CSV, - Datatypes, - FMD, - GNAT.Regpat, - GNATCOLL.JSON, - UnZip; - -use - - Datatypes; - - -package body Deck_IO is - - - package Latin renames Ada.Characters.Latin_1; - package FD renames Ada.Directories; - package Strfix renames Ada.Strings.Fixed; - package Strmap renames Ada.Strings.Maps; - package TIO renames Ada.Text_IO; - package Pat renames GNAT.Regpat; - package JS renames GNATCOLL.JSON; - - - function "+" - (S : in String) - return SU.Unbounded_String - renames SU.To_Unbounded_String; - - function "-" - (US : in SU.Unbounded_String) - return String - renames SU.To_String; - - - function To_Unbounded_String - (Item : in Field_ID) - return SU.Unbounded_String is - begin - return SU.Unbounded_String (Item); - end To_Unbounded_String; - - function To_Unbounded_String - (Item : in Datatypes.Field) - return SU.Unbounded_String is - begin - return SU.Unbounded_String (Item); - end To_Unbounded_String; - - - - - procedure Finalize - (This : in out Deck_Handle) is - begin - if This.Opened then - FD.Delete_File (-This.Tempfile); - end if; - end Finalize; - - - - - function Generate_Temp_Name - return String - is - Handle : TIO.File_Type; - Filename : SU.Unbounded_String; - begin - TIO.Create (File => Handle); - Filename := +TIO.Name (Handle); - TIO.Close (Handle); - return -Filename; - end Generate_Temp_Name; - - - - - function Matches - (Models : in Model_Map; - Notes : in Note_Vector) - return Boolean - is - use type Ada.Containers.Count_Type; - begin - for Note of Notes loop - if not Models.Contains (Note.Model) or else - Note.Fields.Length > Models.Element (Note.Model).Fields.Length - then - return False; - end if; - end loop; - return True; - end Matches; - - - - - procedure Read_Media_Collection - (Filename : in String; - Media : out Media_Collection) - is - Temp : String := Generate_Temp_Name; - - Input_Handle : TIO.File_Type; - Raw_Data : SU.Unbounded_String; - JSON_Data : JS.JSON_Value; - - procedure Map_Iteration - (Name : in JS.UTF8_String; - Value : in JS.JSON_Value) - is - Val : SU.Unbounded_String := JS.Get (Value); - begin - Media.Map.Insert (Media_Name (Val), Media_ID (+Name)); - end Map_Iteration; - begin - UnZip.Extract (Filename, "media", Temp); - - TIO.Open (Input_Handle, TIO.In_File, Temp); - while not TIO.End_Of_File (Input_Handle) loop - SU.Append (Raw_Data, TIO.Get_Line (Input_Handle) & Latin.LF); - end loop; - TIO.Close (Input_Handle); - FD.Delete_File (Temp); - - JSON_Data := JS.Read (-Raw_Data); - JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access); - Media.Filename := +Filename; - end Read_Media_Collection; - - - - - procedure Open_Database - (Filename : in String; - Deck : in out Deck_Handle) - is - Temp : String := Generate_Temp_Name; - begin - UnZip.Extract (Filename, "collection.anki2", Temp); - Deck.SQL_Handle.Open (Temp); - Deck.Opened := True; - Deck.Tempfile := +Temp; - end Open_Database; - - - function Is_Open - (Deck : in Deck_Handle) - return Boolean is - begin - return Deck.Opened; - end Is_Open; - - - procedure Close_Database - (Deck : in out Deck_Handle) is - begin - if Deck.Opened = False then - return; - end if; - Deck.SQL_Handle.Close; - Deck.Opened := False; - FD.Delete_File (-Deck.Tempfile); - Deck.Tempfile := +""; - end Close_Database; - - - - - procedure Extract_Field_IDs - (Value : in JS.JSON_Array; - FIDs : out Field_ID_Vector) - is - Index : Positive; - Item : JS.JSON_Value; - Ordinal : Integer; - begin - Index := JS.Array_First (Value); - while JS.Array_Has_Element (Value, Index) loop - Item := JS.Array_Element (Value, Index); - Ordinal := JS.Get (Item, "ord") + 1; - if Ordinal > Integer (FIDs.Length) then - FIDs.Set_Length (Ada.Containers.Count_Type (Ordinal)); - end if; - declare - Name : String := JS.Get (Item, "name"); - begin - FIDs.Replace_Element (Field_Ordinal (Ordinal), Field_ID (+Name)); - end; - Index := Index + 1; - end loop; - end Extract_Field_IDs; - - - procedure Regex_Fields - (Raw_Data : in JS.UTF8_String; - FIDs : out Field_ID_Vector) - is - use type Pat.Match_Location; - Matches : Pat.Match_Array (0 .. 1); - Regexp : Pat.Pattern_Matcher := - -- My god I hate regular expressions, they're such unreadable nonsense - Pat.Compile ("{{(?:(?:\w|\s)+:)?((?:\w|\s)+)}}", Pat.Single_Line); - Marker : Positive := Raw_Data'First; - begin - loop - Pat.Match (Regexp, Raw_Data, Matches, Marker); - exit when Matches (1) = Pat.No_Match; - declare - Item : String := Raw_Data (Matches (1).First .. Matches (1).Last); - begin - if Item /= "FrontSide" then - FIDs.Append (Field_ID (+Item)); - end if; - end; - Marker := Matches (0).Last + 1; - end loop; - end Regex_Fields; - - - procedure Extract_Templates - (Value : in JS.JSON_Array; - TMPLs : out Template_Vector) - is - Index : Positive; - Item : JS.JSON_Value; - Current_Tmpl : Template; - begin - Index := JS.Array_First (Value); - while JS.Array_Has_Element (Value, Index) loop - Item := JS.Array_Element (Value, Index); - Regex_Fields (JS.Get (Item, "qfmt"), Current_Tmpl.Question); - Regex_Fields (JS.Get (Item, "afmt"), Current_Tmpl.Answer); - TMPLs.Append (Current_Tmpl); - Current_Tmpl.Question.Clear; - Current_Tmpl.Answer.Clear; - Index := Index + 1; - end loop; - end Extract_Templates; - - - procedure Extract_Model - (Name : in JS.UTF8_String; - Value : in JS.JSON_Value; - Models : in out Model_Map) - is - Current_Model : Model; - begin - Extract_Field_IDs (JS.Get (Value, "flds"), Current_Model.Fields); - Extract_Templates (JS.Get (Value, "tmpls"), Current_Model.Templates); - Models.Insert (Model_ID (+Name), Current_Model); - end Extract_Model; - - - procedure Query_Models - (Deck : in out Deck_Handle; - Models : out Model_Map) - is - Statement : SQLite3.SQLite3_Statement; - Raw_Data : SU.Unbounded_String; - JSON_Data : JS.JSON_Value; - - procedure JSON_Callback - (Name : in JS.UTF8_String; - Value : in JS.JSON_Value) is - begin - Extract_Model (Name, Value, Models); - end JSON_Callback; - begin - Deck.SQL_Handle.Prepare ("SELECT models FROM col", Statement); - Statement.Step; - Raw_Data := Statement.Column (0); - JSON_Data := JS.Read (-Raw_Data); - JS.Map_JSON_Object (JSON_Data, JSON_Callback'Access); - end Query_Models; - - - - - procedure Tokenize_Fields - (Raw_Data : in SU.Unbounded_String; - Fields : out Field_Vector) - is - Charset : Strmap.Character_Set := Strmap.To_Set (Latin.US); - Position : Positive := 1; - Next : Natural := 1; - begin - while Next /= 0 and Position <= SU.Length (Raw_Data) loop - Next := SU.Index (Raw_Data, Charset, Position); - if Position <= Next then - Fields.Append (Datatypes.Field (SU.Unbounded_Slice - (Raw_Data, Position, Next - 1))); - else - Fields.Append (Datatypes.Field (SU.Unbounded_Slice - (Raw_Data, Position, SU.Length (Raw_Data)))); - end if; - Position := Next + 1; - end loop; - end Tokenize_Fields; - - - procedure Query_Notes - (Deck : in out Deck_Handle; - Notes : out Note_Vector) - is - use type SQLite3.Status_Code; - Statement : SQLite3.SQLite3_Statement; - Current_Note : Note; - Raw_Model : SU.Unbounded_String; - begin - Deck.SQL_Handle.Prepare ("SELECT mid, flds FROM notes", Statement); - loop - Statement.Step; - exit when Statement.Status /= SQLite3.SQLITE_ROW; - Raw_Model := Statement.Column (0); - Current_Note.Model := Model_ID (Raw_Model); - Tokenize_Fields (Statement.Column (1), Current_Note.Fields); - Notes.Append (Current_Note); - Current_Note.Fields.Clear; - end loop; - end Query_Notes; - - - - - function Compose_Name - (Directory : in String; - Basename : in String; - Extension : in String; - Model_Num : in Positive) - return SU.Unbounded_String - is - Result : SU.Unbounded_String := +FD.Compose (Directory, Basename); - begin - if Model_Num > 1 then - SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left)); - end if; - SU.Append (Result, "." & Extension); - return Result; - end Compose_Name; - - - function Compose_Dir - (Directory : in String; - Basename : in String; - Model_Num : in Positive) - return SU.Unbounded_String - is - Result : SU.Unbounded_String := +FD.Compose (Directory, Basename); - begin - if Model_Num > 1 then - SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left)); - end if; - return Result; - end Compose_Dir; - - - procedure Extract_Images - (Texts : in out Datatypes.Field_Vector; - Outdir : in SU.Unbounded_String; - Media : in Media_Collection) - is - use type Pat.Match_Location; - Matches : Pat.Match_Array (0 .. 2); - Regexp : Pat.Pattern_Matcher := Pat.Compile - -- Absolutely disgusting regexes - ("", - Pat.Single_Line); - Marker : Positive; - Location : Pat.Match_Location; - Match_Name : SU.Unbounded_String; - begin - for Text of Texts loop - Marker := 1; - loop - Pat.Match (Regexp, -(SU.Unbounded_String (Text)), Matches, Marker); - exit when Matches (0) = Pat.No_Match; - Location := (if Matches (1) = Pat.No_Match then Matches (2) else Matches (1)); - Match_Name := SU.Unbounded_Slice - (SU.Unbounded_String (Text), Location.First, Location.Last); - if Media.Map.Contains (Media_Name (Match_Name)) then - if not FD.Exists (-Outdir) then - FD.Create_Directory (-Outdir); - end if; - if not FD.Exists (FD.Compose (-Outdir, -Match_Name)) then - UnZip.Extract - (-Media.Filename, - SU.To_String (SU.Unbounded_String - (Media.Map.Element (Media_Name (Match_Name)))), - FD.Compose (-Outdir, -Match_Name)); - end if; - SU.Insert (SU.Unbounded_String (Text), Location.First, "%%/"); - end if; - Marker := Matches (0).Last + 1; - end loop; - end loop; - end Extract_Images; - - - - - procedure Write_CSV - (Directory : in String; - Basename : in String; - Models : in Model_Map; - Notes : in Note_Vector; - Overwrite : in Boolean := False) - is - package My_CSV is new CSV; - - Counter : Positive := 1; - Outname : SU.Unbounded_String; - File_Handle : TIO.File_Type; - Row_Size : Positive; - begin - for C in Models.Iterate loop - Outname := Compose_Name (Directory, Basename, "csv", Counter); - if FD.Exists (-Outname) then - if not Overwrite then - raise FD.Name_Error; - else - FD.Delete_File (-Outname); - end if; - end if; - TIO.Create (File_Handle, TIO.Out_File, -Outname); - Row_Size := Positive (Model_Maps.Element (C).Fields.Length); - My_CSV.Put_Header (File_Handle, Model_Maps.Element (C).Fields); - for N of Notes loop - if N.Model = Model_Maps.Key (C) then - My_CSV.Put_Row (File_Handle, N.Fields, Row_Size); - end if; - end loop; - TIO.Close (File_Handle); - Counter := Counter + 1; - end loop; - end Write_CSV; - - - - - procedure Write_FMD - (Directory : in String; - Basename : in String; - Models : in Model_Map; - Notes : in Note_Vector; - Media : in Media_Collection; - Overwrite : in Boolean := False) - is - Counter : Positive := 1; - Outname, Outdir : SU.Unbounded_String; - File_Handle : TIO.File_Type; - Current_Entry : Datatypes.Field_Vector; - Entry_Size : Positive; - begin - for C in Models.Iterate loop - Outname := Compose_Name (Directory, Basename, "fmd", Counter); - Outdir := Compose_Dir (Directory, Basename, Counter); - if FD.Exists (-Outname) then - if not Overwrite then - raise FD.Name_Error with "output file " & (-Outname) & " already exists"; - else - FD.Delete_File (-Outname); - end if; - end if; - if FD.Exists (-Outdir) and not Overwrite then - raise FD.Name_Error with "media directory " & (-Outdir) & " already exists"; - end if; - TIO.Create (File_Handle, TIO.Out_File, -Outname); - Entry_Size := Positive (Model_Maps.Element (C).Fields.Length); - FMD.Put_Header (File_Handle); - FMD.Put_Fields (File_Handle, Model_Maps.Element (C).Fields); - FMD.Start_Pack_Section (File_Handle); - for Tmpl of Model_Maps.Element (C).Templates loop - FMD.Put_Pack (File_Handle, Tmpl.Question, Tmpl.Answer); - end loop; - FMD.End_Pack_Section (File_Handle); - FMD.Start_Entry_Section (File_Handle); - for N of Notes loop - if N.Model = Model_Maps.Key (C) then - Current_Entry := N.Fields; - Extract_Images (Current_Entry, Outdir, Media); - FMD.Put_Entry (File_Handle, Current_Entry, Entry_Size); - end if; - end loop; - FMD.End_Entry_Section (File_Handle); - FMD.Put_Footer (File_Handle); - TIO.Close (File_Handle); - Counter := Counter + 1; - end loop; - end Write_FMD; - - -end Deck_IO; - - diff --git a/src/deck_io.ads b/src/deck_io.ads deleted file mode 100644 index e5d698a..0000000 --- a/src/deck_io.ads +++ /dev/null @@ -1,100 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Containers.Vectors, - Ada.Containers.Ordered_Maps, - Ada.Strings.Unbounded, - Datatypes; - -private with - - Ada.Finalization, - SQLite3; - - -package Deck_IO is - - - package SU renames Ada.Strings.Unbounded; - use type SU.Unbounded_String; - - - type Deck_Handle is limited private; - - - function Matches - (Models : in Datatypes.Model_Map; - Notes : in Datatypes.Note_Vector) - return Boolean; - - - procedure Read_Media_Collection - (Filename : in String; - Media : out Datatypes.Media_Collection); - - - procedure Open_Database - (Filename : in String; - Deck : in out Deck_Handle) - with Post => Is_Open (Deck); - - function Is_Open - (Deck : in Deck_Handle) - return Boolean; - - procedure Close_Database - (Deck : in out Deck_Handle) - with Post => not Is_Open (Deck); - - procedure Query_Models - (Deck : in out Deck_Handle; - Models : out Datatypes.Model_Map) - with Pre => Is_Open (Deck); - - procedure Query_Notes - (Deck : in out Deck_Handle; - Notes : out Datatypes.Note_Vector) - with Pre => Is_Open (Deck); - - - procedure Write_CSV - (Directory : in String; - Basename : in String; - Models : in Datatypes.Model_Map; - Notes : in Datatypes.Note_Vector; - Overwrite : in Boolean := False) - with Pre => Matches (Models, Notes); - - procedure Write_FMD - (Directory : in String; - Basename : in String; - Models : in Datatypes.Model_Map; - Notes : in Datatypes.Note_Vector; - Media : in Datatypes.Media_Collection; - Overwrite : in Boolean := False) - with Pre => Matches (Models, Notes); - - -private - - - type Deck_Handle is new Ada.Finalization.Limited_Controlled with record - SQL_Handle : SQLite3.SQLite3_DB; - Status : SQLite3.Status_Code := SQLite3.SQLITE_OK; - Opened : Boolean := False; - Tempfile : SU.Unbounded_String := SU.To_Unbounded_String (""); - end record; - - - overriding - procedure Finalize - (This : in out Deck_Handle); - - -end Deck_IO; - - diff --git a/src/deckdata-csv.adb b/src/deckdata-csv.adb new file mode 100644 index 0000000..4789469 --- /dev/null +++ b/src/deckdata-csv.adb @@ -0,0 +1,109 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Characters.Latin_1, + Ada.Strings.Fixed, + Ada.Strings.Maps, + Ada.Text_IO; + +use + + Ada.Text_IO; + + +package body Deckdata.CSV is + + + package Latin renames Ada.Characters.Latin_1; + package Strfix renames Ada.Strings.Fixed; + package Strmap renames Ada.Strings.Maps; + + + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in String) is + begin + Put_Cell (File_Handle, +Data); + end Put_Cell; + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Ada.Strings.Unbounded.Unbounded_String) + is + Processed : SU.Unbounded_String := Data; + Position : Natural; + begin + -- Deal with any lurking linefeed characters + loop + Position := SU.Index (Processed, Strmap.To_Set (Latin.LF)); + exit when Position = 0; + SU.Replace_Element (Processed, Position, ' '); + end loop; + + -- Escape any quizzical quotation characters + Position := SU.Index (Processed, Strmap.To_Set (Quote_Char)); + while Position /= 0 loop + SU.Insert (Processed, Position, Strfix."*" (1, Escape_Char)); + Position := Position + 2; -- skip over the \" we already know about + exit when Position > SU.Length (Processed); + Position := SU.Index (Processed, Strmap.To_Set (Quote_Char), Position); + end loop; + + -- Surround any suspicious separator characters + if SU.Index (Processed, Strmap.To_Set (Separator_Char)) /= 0 then + SU.Insert (Processed, 1, Strfix."*" (1, Quote_Char)); + SU.Append (Processed, Quote_Char); + end if; + + Put (File_Handle, -Processed); + end Put_Cell; + + + procedure Put_Header + (File_Handle : in Ada.Text_IO.File_Type; + Titles : in Field_ID_Vector) is + begin + for Position in Field_Ordinal range + Titles.First_Index .. Field_Ordinal'Pred (Titles.Last_Index) + loop + Put_Cell (File_Handle, SU.Unbounded_String (Titles.Element (Position))); + Put (File_Handle, Separator_Char); + end loop; + Put_Cell (File_Handle, SU.Unbounded_String (Titles.Last_Element)); + New_Line (File_Handle); + end Put_Header; + + + procedure Put_Row + (File_Handle : in Ada.Text_IO.File_Type; + Cells : in Field_Vector; + Quantity : in Positive) + is + Counter : Positive := 1; + Position : Field_Ordinal := Cells.First_Index; + begin + while Counter < Quantity loop + if Position <= Cells.Last_Index then + Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); + end if; + Put (File_Handle, Separator_Char); + Position := Field_Ordinal'Succ (Position); + Counter := Counter + 1; + end loop; + if Position <= Cells.Last_Index then + Put_Cell (File_Handle, SU.Unbounded_String (Cells.Element (Position))); + end if; + New_Line (File_Handle); + end Put_Row; + + +end Deckdata.CSV; + + diff --git a/src/deckdata-csv.ads b/src/deckdata-csv.ads new file mode 100644 index 0000000..f05cba1 --- /dev/null +++ b/src/deckdata-csv.ads @@ -0,0 +1,44 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Containers.Vectors, + Ada.Strings.Unbounded, + Ada.Text_IO; + + +generic + + Separator_Char : Character := ','; + Quote_Char : Character := '"'; + Escape_Char : Character := '\'; + +package Deckdata.CSV is + + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in String); + + procedure Put_Cell + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Ada.Strings.Unbounded.Unbounded_String); + + + procedure Put_Header + (File_Handle : in Ada.Text_IO.File_Type; + Titles : in Field_ID_Vector); + + + procedure Put_Row + (File_Handle : in Ada.Text_IO.File_Type; + Cells : in Field_Vector; + Quantity : in Positive); + + +end Deckdata.CSV; + + diff --git a/src/deckdata-fmd.adb b/src/deckdata-fmd.adb new file mode 100644 index 0000000..10040a0 --- /dev/null +++ b/src/deckdata-fmd.adb @@ -0,0 +1,212 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Characters.Latin_1, + Ada.Strings.Fixed, + Ada.Strings.Maps, + Ada.Text_IO; + +use + + Ada.Text_IO; + + +package body Deckdata.FMD is + + + package Latin renames Ada.Characters.Latin_1; + package Strfix renames Ada.Strings.Fixed; + package Strmap renames Ada.Strings.Maps; + + function "*" + (Left : in Natural; + Right : in Character) + return String + renames Ada.Strings.Fixed."*"; + + + + + procedure Put_Header + (File_Handle : in Ada.Text_IO.File_Type; + Version : in String := "1.4") is + begin + Put_Line (File_Handle, ""); + Put_Line (File_Handle, ""); + Put_Line (File_Handle, ""); + end Put_Header; + + + + + procedure Put_Fields + (File_Handle : in Ada.Text_IO.File_Type; + Field_IDs : in Field_ID_Vector) + is + Text : SU.Unbounded_String; + begin + Put_Line (File_Handle, (4 * ' ') & ""); + for FID of Field_IDs loop + Text := Prep (SU.Unbounded_String (FID)); + Put_Line (File_Handle, (8 * ' ') & "" & (-Text) & ""); + end loop; + Put_Line (File_Handle, (4 * ' ') & ""); + end Put_Fields; + + + + + procedure Start_Pack_Section + (File_Handle : in Ada.Text_IO.File_Type) is + begin + Put_Line (File_Handle, (4 * ' ') & ""); + end Start_Pack_Section; + + + procedure Put_Pack + (File_Handle : in Ada.Text_IO.File_Type; + Q_Data : in Field_ID_Vector; + A_Data : in Field_ID_Vector) + is + Text : SU.Unbounded_String; + begin + Put_Line (File_Handle, (8 * ' ') & ""); + Text := Prep (SU.Unbounded_String (Q_Data.First_Element)); + Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); + for I in Field_Ordinal + range Field_Ordinal'Succ (Q_Data.First_Index) .. Q_Data.Last_Index + loop + Text := Prep (SU.Unbounded_String (Q_Data.Element (I))); + -- Fresh Memory unfortunately cannot cope with multiple question fields + Put_Line (File_Handle, (12 * ' ') & ""); + end loop; + for FID of A_Data loop + Text := Prep (SU.Unbounded_String (FID)); + Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); + end loop; + Put_Line (File_Handle, (8 * ' ') & ""); + end Put_Pack; + + + procedure End_Pack_Section + (File_Handle : in Ada.Text_IO.File_Type) is + begin + Put_Line (File_Handle, (4 * ' ') & ""); + end End_Pack_Section; + + + + + procedure Start_Entry_Section + (File_Handle : in Ada.Text_IO.File_Type) is + begin + Put_Line (File_Handle, (4 * ' ') & ""); + end Start_Entry_Section; + + + procedure Put_Entry + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Field_Vector; + Quantity : in Positive) + is + Counter : Positive := 1; + Position : Field_Ordinal := Data.First_Index; + Text : SU.Unbounded_String; + begin + Put_Line (File_Handle, (8 * ' ') & ""); + while Counter <= Quantity loop + if Position <= Data.Last_Index then + Text := Prep (SU.Unbounded_String (Data.Element (Position))); + Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); + else + Put_Line (File_Handle, (12 * ' ') & ""); + end if; + Position := Field_Ordinal'Succ (Position); + Counter := Counter + 1; + end loop; + Put_Line (File_Handle, (8 * ' ') & ""); + end Put_Entry; + + + procedure End_Entry_Section + (File_Handle : in Ada.Text_IO.File_Type) is + begin + Put_Line (File_Handle, (4 * ' ') & ""); + end End_Entry_Section; + + + + + procedure Put_Footer + (File_Handle : in Ada.Text_IO.File_Type) is + begin + Put_Line (File_Handle, ""); + end Put_Footer; + + + + + procedure Replace_All + (Text : in out SU.Unbounded_String; + Char : in Character; + Sub : in String) + is + Position : Natural; + begin + loop + Position := SU.Index (Text, Strmap.To_Set (Char)); + exit when Position = 0; + SU.Replace_Slice (Text, Position, Position, Sub); + end loop; + end Replace_All; + + + procedure Replace_All + (Text : in out SU.Unbounded_String; + Item : in String; + Sub : in String) + is + Position : Natural; + begin + loop + Position := SU.Index (Text, Item); + exit when Position = 0; + SU.Replace_Slice (Text, Position, Position + Item'Length - 1, Sub); + end loop; + end Replace_All; + + + function Prep + (Text : in SU.Unbounded_String) + return SU.Unbounded_String + is + Result : SU.Unbounded_String := Text; + begin + -- Fresh Memory needs these character codes + Replace_All (Result, '<', "<"); + Replace_All (Result, '>', ">"); + Replace_All (Result, '"', """); + + -- Not sure why these cause Fresh Memory to not load the dict + -- Replace_All (Result, Latin.CR & Latin.LF, "
"); + -- Replace_All (Result, Latin.LF, "
"); + + -- Fresh memory doesn't recognise these character codes so get rid of them + -- Note that this list may not be complete + Replace_All (Result, "–", "–"); + Replace_All (Result, "’", "’"); + Replace_All (Result, "‘", "‘"); + Replace_All (Result, "”", "”"); + Replace_All (Result, "“", "“"); + + return Result; + end Prep; + + +end Deckdata.FMD; + + diff --git a/src/deckdata-fmd.ads b/src/deckdata-fmd.ads new file mode 100644 index 0000000..bf251f3 --- /dev/null +++ b/src/deckdata-fmd.ads @@ -0,0 +1,89 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Containers.Vectors, + Ada.Strings.Unbounded, + Ada.Text_IO; + +private with + + Ada.Strings.Fixed, + Ada.Strings.Maps; + + +package Deckdata.FMD is + + + procedure Put_Header + (File_Handle : in Ada.Text_IO.File_Type; + Version : in String := "1.4"); + + + + + procedure Put_Fields + (File_Handle : in Ada.Text_IO.File_Type; + Field_IDs : in Field_ID_Vector); + + + + + procedure Start_Pack_Section + (File_Handle : in Ada.Text_IO.File_Type); + + procedure Put_Pack + (File_Handle : in Ada.Text_IO.File_Type; + Q_Data : in Field_ID_Vector; + A_Data : in Field_ID_Vector) + with Pre => not Q_Data.Is_Empty and not A_Data.Is_Empty; + + procedure End_Pack_Section + (File_Handle : in Ada.Text_IO.File_Type); + + + + + procedure Start_Entry_Section + (File_Handle : in Ada.Text_IO.File_Type); + + procedure Put_Entry + (File_Handle : in Ada.Text_IO.File_Type; + Data : in Field_Vector; + Quantity : in Positive); + + procedure End_Entry_Section + (File_Handle : in Ada.Text_IO.File_Type); + + + + + procedure Put_Footer + (File_Handle : in Ada.Text_IO.File_Type); + + +private + + + procedure Replace_All + (Text : in out SU.Unbounded_String; + Char : in Character; + Sub : in String) + with Pre => Ada.Strings.Fixed.Count (Sub, Ada.Strings.Maps.To_Set (Char)) = 0; + + procedure Replace_All + (Text : in out SU.Unbounded_String; + Item : in String; + Sub : in String); + + function Prep + (Text : in SU.Unbounded_String) + return SU.Unbounded_String; + + +end Deckdata.FMD; + + diff --git a/src/deckdata-io.adb b/src/deckdata-io.adb new file mode 100644 index 0000000..e152ee0 --- /dev/null +++ b/src/deckdata-io.adb @@ -0,0 +1,493 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Characters.Latin_1, + Ada.Directories, + Ada.Strings.Fixed, + Ada.Strings.Maps, + Ada.Text_IO, + Deckdata.CSV, + Deckdata.FMD, + GNAT.Regpat, + GNATCOLL.JSON, + UnZip; + + +package body Deckdata.IO is + + + package Latin renames Ada.Characters.Latin_1; + package FD renames Ada.Directories; + package Strfix renames Ada.Strings.Fixed; + package Strmap renames Ada.Strings.Maps; + package TIO renames Ada.Text_IO; + package Pat renames GNAT.Regpat; + package JS renames GNATCOLL.JSON; + + + + + function To_Unbounded_String + (Item : in Field_ID) + return SU.Unbounded_String is + begin + return SU.Unbounded_String (Item); + end To_Unbounded_String; + + function To_Unbounded_String + (Item : in Field) + return SU.Unbounded_String is + begin + return SU.Unbounded_String (Item); + end To_Unbounded_String; + + + + + procedure Finalize + (This : in out Deck_Handle) is + begin + if This.Opened then + FD.Delete_File (-This.Tempfile); + end if; + end Finalize; + + + + + function Generate_Temp_Name + return String + is + Handle : TIO.File_Type; + Filename : SU.Unbounded_String; + begin + TIO.Create (File => Handle); + Filename := +TIO.Name (Handle); + TIO.Close (Handle); + return -Filename; + end Generate_Temp_Name; + + + + + function Matches + (Models : in Model_Map; + Notes : in Note_Vector) + return Boolean + is + use type Ada.Containers.Count_Type; + begin + for Note of Notes loop + if not Models.Contains (Note.Model) or else + Note.Fields.Length > Models.Element (Note.Model).Fields.Length + then + return False; + end if; + end loop; + return True; + end Matches; + + + + + procedure Read_Media_Collection + (Filename : in String; + Media : out Media_Collection) + is + Temp : String := Generate_Temp_Name; + + Input_Handle : TIO.File_Type; + Raw_Data : SU.Unbounded_String; + JSON_Data : JS.JSON_Value; + + procedure Map_Iteration + (Name : in JS.UTF8_String; + Value : in JS.JSON_Value) + is + Val : SU.Unbounded_String := JS.Get (Value); + begin + Media.Map.Insert (Media_Name (Val), Media_ID (+Name)); + end Map_Iteration; + begin + UnZip.Extract (Filename, "media", Temp); + + TIO.Open (Input_Handle, TIO.In_File, Temp); + while not TIO.End_Of_File (Input_Handle) loop + SU.Append (Raw_Data, TIO.Get_Line (Input_Handle) & Latin.LF); + end loop; + TIO.Close (Input_Handle); + FD.Delete_File (Temp); + + JSON_Data := JS.Read (-Raw_Data); + JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access); + Media.Filename := +Filename; + end Read_Media_Collection; + + + + + procedure Open_Database + (Filename : in String; + Deck : in out Deck_Handle) + is + Temp : String := Generate_Temp_Name; + begin + UnZip.Extract (Filename, "collection.anki2", Temp); + Deck.SQL_Handle.Open (Temp); + Deck.Opened := True; + Deck.Tempfile := +Temp; + end Open_Database; + + + function Is_Open + (Deck : in Deck_Handle) + return Boolean is + begin + return Deck.Opened; + end Is_Open; + + + procedure Close_Database + (Deck : in out Deck_Handle) is + begin + if Deck.Opened = False then + return; + end if; + Deck.SQL_Handle.Close; + Deck.Opened := False; + FD.Delete_File (-Deck.Tempfile); + Deck.Tempfile := +""; + end Close_Database; + + + + + procedure Extract_Field_IDs + (Value : in JS.JSON_Array; + FIDs : out Field_ID_Vector) + is + Index : Positive; + Item : JS.JSON_Value; + Ordinal : Integer; + begin + Index := JS.Array_First (Value); + while JS.Array_Has_Element (Value, Index) loop + Item := JS.Array_Element (Value, Index); + Ordinal := JS.Get (Item, "ord") + 1; + if Ordinal > Integer (FIDs.Length) then + FIDs.Set_Length (Ada.Containers.Count_Type (Ordinal)); + end if; + declare + Name : String := JS.Get (Item, "name"); + begin + FIDs.Replace_Element (Field_Ordinal (Ordinal), Field_ID (+Name)); + end; + Index := Index + 1; + end loop; + end Extract_Field_IDs; + + + procedure Regex_Fields + (Raw_Data : in JS.UTF8_String; + FIDs : out Field_ID_Vector) + is + use type Pat.Match_Location; + Matches : Pat.Match_Array (0 .. 1); + Regexp : Pat.Pattern_Matcher := + -- My god I hate regular expressions, they're such unreadable nonsense + Pat.Compile ("{{(?:(?:\w|\s)+:)?((?:\w|\s)+)}}", Pat.Single_Line); + Marker : Positive := Raw_Data'First; + begin + loop + Pat.Match (Regexp, Raw_Data, Matches, Marker); + exit when Matches (1) = Pat.No_Match; + declare + Item : String := Raw_Data (Matches (1).First .. Matches (1).Last); + begin + if Item /= "FrontSide" then + FIDs.Append (Field_ID (+Item)); + end if; + end; + Marker := Matches (0).Last + 1; + end loop; + end Regex_Fields; + + + procedure Extract_Templates + (Value : in JS.JSON_Array; + TMPLs : out Template_Vector) + is + Index : Positive; + Item : JS.JSON_Value; + Current_Tmpl : Template; + begin + Index := JS.Array_First (Value); + while JS.Array_Has_Element (Value, Index) loop + Item := JS.Array_Element (Value, Index); + Regex_Fields (JS.Get (Item, "qfmt"), Current_Tmpl.Question); + Regex_Fields (JS.Get (Item, "afmt"), Current_Tmpl.Answer); + TMPLs.Append (Current_Tmpl); + Current_Tmpl.Question.Clear; + Current_Tmpl.Answer.Clear; + Index := Index + 1; + end loop; + end Extract_Templates; + + + procedure Extract_Model + (Name : in JS.UTF8_String; + Value : in JS.JSON_Value; + Models : in out Model_Map) + is + Current_Model : Model; + begin + Extract_Field_IDs (JS.Get (Value, "flds"), Current_Model.Fields); + Extract_Templates (JS.Get (Value, "tmpls"), Current_Model.Templates); + Models.Insert (Model_ID (+Name), Current_Model); + end Extract_Model; + + + procedure Query_Models + (Deck : in out Deck_Handle; + Models : out Model_Map) + is + Statement : SQLite3.SQLite3_Statement; + Raw_Data : SU.Unbounded_String; + JSON_Data : JS.JSON_Value; + + procedure JSON_Callback + (Name : in JS.UTF8_String; + Value : in JS.JSON_Value) is + begin + Extract_Model (Name, Value, Models); + end JSON_Callback; + begin + Deck.SQL_Handle.Prepare ("SELECT models FROM col", Statement); + Statement.Step; + Raw_Data := Statement.Column (0); + JSON_Data := JS.Read (-Raw_Data); + JS.Map_JSON_Object (JSON_Data, JSON_Callback'Access); + end Query_Models; + + + + + procedure Tokenize_Fields + (Raw_Data : in SU.Unbounded_String; + Fields : out Field_Vector) + is + Charset : Strmap.Character_Set := Strmap.To_Set (Latin.US); + Position : Positive := 1; + Next : Natural := 1; + begin + while Next /= 0 and Position <= SU.Length (Raw_Data) loop + Next := SU.Index (Raw_Data, Charset, Position); + if Position <= Next then + Fields.Append (Field (SU.Unbounded_Slice (Raw_Data, Position, Next - 1))); + else + Fields.Append (Field (SU.Unbounded_Slice + (Raw_Data, Position, SU.Length (Raw_Data)))); + end if; + Position := Next + 1; + end loop; + end Tokenize_Fields; + + + procedure Query_Notes + (Deck : in out Deck_Handle; + Notes : out Note_Vector) + is + use type SQLite3.Status_Code; + Statement : SQLite3.SQLite3_Statement; + Current_Note : Note; + Raw_Model : SU.Unbounded_String; + begin + Deck.SQL_Handle.Prepare ("SELECT mid, flds FROM notes", Statement); + loop + Statement.Step; + exit when Statement.Status /= SQLite3.SQLITE_ROW; + Raw_Model := Statement.Column (0); + Current_Note.Model := Model_ID (Raw_Model); + Tokenize_Fields (Statement.Column (1), Current_Note.Fields); + Notes.Append (Current_Note); + Current_Note.Fields.Clear; + end loop; + end Query_Notes; + + + + + function Compose_Name + (Directory : in String; + Basename : in String; + Extension : in String; + Model_Num : in Positive) + return SU.Unbounded_String + is + Result : SU.Unbounded_String := +FD.Compose (Directory, Basename); + begin + if Model_Num > 1 then + SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left)); + end if; + SU.Append (Result, "." & Extension); + return Result; + end Compose_Name; + + + function Compose_Dir + (Directory : in String; + Basename : in String; + Model_Num : in Positive) + return SU.Unbounded_String + is + Result : SU.Unbounded_String := +FD.Compose (Directory, Basename); + begin + if Model_Num > 1 then + SU.Append (Result, "-" & Strfix.Trim (Integer'Image (Model_Num), Ada.Strings.Left)); + end if; + return Result; + end Compose_Dir; + + + procedure Extract_Images + (Texts : in out Field_Vector; + Outdir : in SU.Unbounded_String; + Media : in Media_Collection) + is + use type Pat.Match_Location; + Matches : Pat.Match_Array (0 .. 2); + Regexp : Pat.Pattern_Matcher := Pat.Compile + -- Absolutely disgusting regexes + ("", + Pat.Single_Line); + Marker : Positive; + Location : Pat.Match_Location; + Match_Name : SU.Unbounded_String; + begin + for Text of Texts loop + Marker := 1; + loop + Pat.Match (Regexp, -(SU.Unbounded_String (Text)), Matches, Marker); + exit when Matches (0) = Pat.No_Match; + Location := (if Matches (1) = Pat.No_Match then Matches (2) else Matches (1)); + Match_Name := SU.Unbounded_Slice + (SU.Unbounded_String (Text), Location.First, Location.Last); + if Media.Map.Contains (Media_Name (Match_Name)) then + if not FD.Exists (-Outdir) then + FD.Create_Directory (-Outdir); + end if; + if not FD.Exists (FD.Compose (-Outdir, -Match_Name)) then + UnZip.Extract + (-Media.Filename, + SU.To_String (SU.Unbounded_String + (Media.Map.Element (Media_Name (Match_Name)))), + FD.Compose (-Outdir, -Match_Name)); + end if; + SU.Insert (SU.Unbounded_String (Text), Location.First, "%%/"); + end if; + Marker := Matches (0).Last + 1; + end loop; + end loop; + end Extract_Images; + + + + + procedure Write_CSV + (Directory : in String; + Basename : in String; + Models : in Model_Map; + Notes : in Note_Vector; + Overwrite : in Boolean := False) + is + package My_CSV is new CSV; + + Counter : Positive := 1; + Outname : SU.Unbounded_String; + File_Handle : TIO.File_Type; + Row_Size : Positive; + begin + for C in Models.Iterate loop + Outname := Compose_Name (Directory, Basename, "csv", Counter); + if FD.Exists (-Outname) then + if not Overwrite then + raise FD.Name_Error; + else + FD.Delete_File (-Outname); + end if; + end if; + TIO.Create (File_Handle, TIO.Out_File, -Outname); + Row_Size := Positive (Model_Maps.Element (C).Fields.Length); + My_CSV.Put_Header (File_Handle, Model_Maps.Element (C).Fields); + for N of Notes loop + if N.Model = Model_Maps.Key (C) then + My_CSV.Put_Row (File_Handle, N.Fields, Row_Size); + end if; + end loop; + TIO.Close (File_Handle); + Counter := Counter + 1; + end loop; + end Write_CSV; + + + + + procedure Write_FMD + (Directory : in String; + Basename : in String; + Models : in Model_Map; + Notes : in Note_Vector; + Media : in Media_Collection; + Overwrite : in Boolean := False) + is + Counter : Positive := 1; + Outname, Outdir : SU.Unbounded_String; + File_Handle : TIO.File_Type; + Current_Entry : Field_Vector; + Entry_Size : Positive; + begin + for C in Models.Iterate loop + Outname := Compose_Name (Directory, Basename, "fmd", Counter); + Outdir := Compose_Dir (Directory, Basename, Counter); + if FD.Exists (-Outname) then + if not Overwrite then + raise FD.Name_Error with "output file " & (-Outname) & " already exists"; + else + FD.Delete_File (-Outname); + end if; + end if; + if FD.Exists (-Outdir) and not Overwrite then + raise FD.Name_Error with "media directory " & (-Outdir) & " already exists"; + end if; + TIO.Create (File_Handle, TIO.Out_File, -Outname); + Entry_Size := Positive (Model_Maps.Element (C).Fields.Length); + FMD.Put_Header (File_Handle); + FMD.Put_Fields (File_Handle, Model_Maps.Element (C).Fields); + FMD.Start_Pack_Section (File_Handle); + for Tmpl of Model_Maps.Element (C).Templates loop + FMD.Put_Pack (File_Handle, Tmpl.Question, Tmpl.Answer); + end loop; + FMD.End_Pack_Section (File_Handle); + FMD.Start_Entry_Section (File_Handle); + for N of Notes loop + if N.Model = Model_Maps.Key (C) then + Current_Entry := N.Fields; + Extract_Images (Current_Entry, Outdir, Media); + FMD.Put_Entry (File_Handle, Current_Entry, Entry_Size); + end if; + end loop; + FMD.End_Entry_Section (File_Handle); + FMD.Put_Footer (File_Handle); + TIO.Close (File_Handle); + Counter := Counter + 1; + end loop; + end Write_FMD; + + +end Deckdata.IO; + + diff --git a/src/deckdata-io.ads b/src/deckdata-io.ads new file mode 100644 index 0000000..acdcda3 --- /dev/null +++ b/src/deckdata-io.ads @@ -0,0 +1,92 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +private with + + Ada.Finalization, + SQLite3; + + +package Deckdata.IO is + + + use type SU.Unbounded_String; + + + type Deck_Handle is limited private; + + + function Matches + (Models : in Model_Map; + Notes : in Note_Vector) + return Boolean; + + + procedure Read_Media_Collection + (Filename : in String; + Media : out Media_Collection); + + + procedure Open_Database + (Filename : in String; + Deck : in out Deck_Handle) + with Post => Is_Open (Deck); + + function Is_Open + (Deck : in Deck_Handle) + return Boolean; + + procedure Close_Database + (Deck : in out Deck_Handle) + with Post => not Is_Open (Deck); + + procedure Query_Models + (Deck : in out Deck_Handle; + Models : out Model_Map) + with Pre => Is_Open (Deck); + + procedure Query_Notes + (Deck : in out Deck_Handle; + Notes : out Note_Vector) + with Pre => Is_Open (Deck); + + + procedure Write_CSV + (Directory : in String; + Basename : in String; + Models : in Model_Map; + Notes : in Note_Vector; + Overwrite : in Boolean := False) + with Pre => Matches (Models, Notes); + + procedure Write_FMD + (Directory : in String; + Basename : in String; + Models : in Model_Map; + Notes : in Note_Vector; + Media : in Media_Collection; + Overwrite : in Boolean := False) + with Pre => Matches (Models, Notes); + + +private + + + type Deck_Handle is new Ada.Finalization.Limited_Controlled with record + SQL_Handle : SQLite3.SQLite3_DB; + Status : SQLite3.Status_Code := SQLite3.SQLITE_OK; + Opened : Boolean := False; + Tempfile : SU.Unbounded_String := SU.To_Unbounded_String (""); + end record; + + + overriding + procedure Finalize + (This : in out Deck_Handle); + + +end Deckdata.IO; + + diff --git a/src/deckdata-process.adb b/src/deckdata-process.adb new file mode 100644 index 0000000..e7756a1 --- /dev/null +++ b/src/deckdata-process.adb @@ -0,0 +1,54 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Characters.Handling; + + +package body Deckdata.Process is + + + package Charhand renames Ada.Characters.Handling; + + + procedure Strip_Formatting + (Notes : in out Note_Vector) + is + procedure Strip + (Text : in out Note; + Item : in String) + is + Position : Natural; + begin + for F of Text.Fields loop + loop + Position := SU.Index + (Source => SU.Unbounded_String (F), + Pattern => Item, + Going => Ada.Strings.Forward, + Mapping => Charhand.To_Lower'Access); + exit when Position = 0; + SU.Delete (SU.Unbounded_String (F), Position, Position + Item'Length - 1); + end loop; + end loop; + end Strip; + + Formatting : array (Positive range <>) of SU.Unbounded_String := + (+"", +"", +"", +"", +"", +"", +"", +"", + +"", +"", +"", +"", +"", +"", + +"", +"", +"", +"", +"", +""); + begin + for N of Notes loop + for S of Formatting loop + Strip (N, -S); + end loop; + end loop; + end Strip_Formatting; + + +end Deckdata.Process; + + diff --git a/src/deckdata-process.ads b/src/deckdata-process.ads new file mode 100644 index 0000000..f0f16cf --- /dev/null +++ b/src/deckdata-process.ads @@ -0,0 +1,15 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +package Deckdata.Process is + + + procedure Strip_Formatting + (Notes : in out Note_Vector); + + +end Deckdata.Process; + + diff --git a/src/deckdata.ads b/src/deckdata.ads new file mode 100644 index 0000000..ae73ef2 --- /dev/null +++ b/src/deckdata.ads @@ -0,0 +1,107 @@ + + +-- This source is licensed under the Sunset License v1.0 + + +with + + Ada.Containers.Vectors, + Ada.Containers.Ordered_Maps, + Ada.Strings.Unbounded; + + +package Deckdata is + + + package SU renames Ada.Strings.Unbounded; + + + + + type Field_Ordinal is new Positive; + type Field_ID is new SU.Unbounded_String; + + package Field_ID_Vectors is new Ada.Containers.Vectors + (Index_Type => Field_Ordinal, + Element_Type => Field_ID); + + subtype Field_ID_Vector is Field_ID_Vectors.Vector; + + + type Template is record + Question : Field_ID_Vectors.Vector; + Answer : Field_ID_Vectors.Vector; + end record; + + package Template_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Template); + + subtype Template_Vector is Template_Vectors.Vector; + + + type Model_ID is new SU.Unbounded_String; + + type Model is record + Fields : Field_ID_Vectors.Vector; + Templates : Template_Vectors.Vector; + end record; + + package Model_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Model_ID, + Element_Type => Model); + + subtype Model_Map is Model_Maps.Map; + + + type Field is new SU.Unbounded_String; + + package Field_Vectors is new Ada.Containers.Vectors + (Index_Type => Field_Ordinal, + Element_Type => Field); + + subtype Field_Vector is Field_Vectors.Vector; + + + type Note is record + Model : Model_ID; + Fields : Field_Vectors.Vector; + end record; + + package Note_Vectors is new Ada.Containers.Vectors + (Index_Type => Positive, + Element_Type => Note); + + subtype Note_Vector is Note_Vectors.Vector; + + + type Media_Name is new SU.Unbounded_String; + type Media_ID is new SU.Unbounded_String; + + package Media_Maps is new Ada.Containers.Ordered_Maps + (Key_Type => Media_Name, + Element_Type => Media_ID); + + type Media_Collection is record + Filename : SU.Unbounded_String; + Map : Media_Maps.Map; + end record; + + +private + + + function "+" + (S : in String) + return SU.Unbounded_String + renames SU.To_Unbounded_String; + + function "-" + (US : in SU.Unbounded_String) + return String + renames SU.To_String; + + +end Deckdata; + + diff --git a/src/fmd.adb b/src/fmd.adb deleted file mode 100644 index ae037f4..0000000 --- a/src/fmd.adb +++ /dev/null @@ -1,214 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Characters.Latin_1, - Ada.Strings.Fixed, - Ada.Strings.Maps, - Ada.Text_IO, - Datatypes; - -use - - Ada.Text_IO; - - -package body FMD is - - - package Latin renames Ada.Characters.Latin_1; - package Strfix renames Ada.Strings.Fixed; - package Strmap renames Ada.Strings.Maps; - - function "*" - (Left : in Natural; - Right : in Character) - return String - renames Ada.Strings.Fixed."*"; - - - - - procedure Put_Header - (File_Handle : in Ada.Text_IO.File_Type; - Version : in String := "1.4") is - begin - Put_Line (File_Handle, ""); - Put_Line (File_Handle, ""); - Put_Line (File_Handle, ""); - end Put_Header; - - - - - procedure Put_Fields - (File_Handle : in Ada.Text_IO.File_Type; - Field_IDs : in Datatypes.Field_ID_Vector) - is - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (4 * ' ') & ""); - for FID of Field_IDs loop - Text := Prep (SU.Unbounded_String (FID)); - Put_Line (File_Handle, (8 * ' ') & "" & (-Text) & ""); - end loop; - Put_Line (File_Handle, (4 * ' ') & ""); - end Put_Fields; - - - - - procedure Start_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end Start_Pack_Section; - - - procedure Put_Pack - (File_Handle : in Ada.Text_IO.File_Type; - Q_Data : in Datatypes.Field_ID_Vector; - A_Data : in Datatypes.Field_ID_Vector) - is - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (8 * ' ') & ""); - Text := Prep (SU.Unbounded_String (Q_Data.First_Element)); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - for I in Datatypes.Field_Ordinal range - Datatypes.Field_Ordinal'Succ (Q_Data.First_Index) .. Q_Data.Last_Index - loop - Text := Prep (SU.Unbounded_String (Q_Data.Element (I))); - -- Fresh Memory unfortunately cannot cope with multiple question fields - Put_Line (File_Handle, (12 * ' ') & ""); - end loop; - for FID of A_Data loop - Text := Prep (SU.Unbounded_String (FID)); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - end loop; - Put_Line (File_Handle, (8 * ' ') & ""); - end Put_Pack; - - - procedure End_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end End_Pack_Section; - - - - - procedure Start_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end Start_Entry_Section; - - - procedure Put_Entry - (File_Handle : in Ada.Text_IO.File_Type; - Data : in Datatypes.Field_Vector; - Quantity : in Positive) - is - use type Datatypes.Field_Ordinal; - Counter : Positive := 1; - Position : Datatypes.Field_Ordinal := Data.First_Index; - Text : SU.Unbounded_String; - begin - Put_Line (File_Handle, (8 * ' ') & ""); - while Counter <= Quantity loop - if Position <= Data.Last_Index then - Text := Prep (SU.Unbounded_String (Data.Element (Position))); - Put_Line (File_Handle, (12 * ' ') & "" & (-Text) & ""); - else - Put_Line (File_Handle, (12 * ' ') & ""); - end if; - Position := Datatypes.Field_Ordinal'Succ (Position); - Counter := Counter + 1; - end loop; - Put_Line (File_Handle, (8 * ' ') & ""); - end Put_Entry; - - - procedure End_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, (4 * ' ') & ""); - end End_Entry_Section; - - - - - procedure Put_Footer - (File_Handle : in Ada.Text_IO.File_Type) is - begin - Put_Line (File_Handle, ""); - end Put_Footer; - - - - - procedure Replace_All - (Text : in out SU.Unbounded_String; - Char : in Character; - Sub : in String) - is - Position : Natural; - begin - loop - Position := SU.Index (Text, Strmap.To_Set (Char)); - exit when Position = 0; - SU.Replace_Slice (Text, Position, Position, Sub); - end loop; - end Replace_All; - - - procedure Replace_All - (Text : in out SU.Unbounded_String; - Item : in String; - Sub : in String) - is - Position : Natural; - begin - loop - Position := SU.Index (Text, Item); - exit when Position = 0; - SU.Replace_Slice (Text, Position, Position + Item'Length - 1, Sub); - end loop; - end Replace_All; - - - function Prep - (Text : in SU.Unbounded_String) - return SU.Unbounded_String - is - Result : SU.Unbounded_String := Text; - begin - -- Fresh Memory needs these character codes - Replace_All (Result, '<', "<"); - Replace_All (Result, '>', ">"); - Replace_All (Result, '"', """); - - -- Not sure why these cause Fresh Memory to not load the dict - -- Replace_All (Result, Latin.CR & Latin.LF, "
"); - -- Replace_All (Result, Latin.LF, "
"); - - -- Fresh memory doesn't recognise these character codes so get rid of them - -- Note that this list may not be complete - Replace_All (Result, "–", "–"); - Replace_All (Result, "’", "’"); - Replace_All (Result, "‘", "‘"); - Replace_All (Result, "”", "”"); - Replace_All (Result, "“", "“"); - - return Result; - end Prep; - - -end FMD; - - diff --git a/src/fmd.ads b/src/fmd.ads deleted file mode 100644 index 610aa88..0000000 --- a/src/fmd.ads +++ /dev/null @@ -1,106 +0,0 @@ - - --- This source is licensed under the Sunset License v1.0 - - -with - - Ada.Containers.Vectors, - Ada.Strings.Unbounded, - Ada.Text_IO, - Datatypes; - -private with - - Ada.Strings.Fixed, - Ada.Strings.Maps; - - -package FMD is - - - procedure Put_Header - (File_Handle : in Ada.Text_IO.File_Type; - Version : in String := "1.4"); - - - - - procedure Put_Fields - (File_Handle : in Ada.Text_IO.File_Type; - Field_IDs : in Datatypes.Field_ID_Vector); - - - - - procedure Start_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type); - - procedure Put_Pack - (File_Handle : in Ada.Text_IO.File_Type; - Q_Data : in Datatypes.Field_ID_Vector; - A_Data : in Datatypes.Field_ID_Vector) - with Pre => not Q_Data.Is_Empty and not A_Data.Is_Empty; - - procedure End_Pack_Section - (File_Handle : in Ada.Text_IO.File_Type); - - - - - procedure Start_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type); - - procedure Put_Entry - (File_Handle : in Ada.Text_IO.File_Type; - Data : in Datatypes.Field_Vector; - Quantity : in Positive); - - procedure End_Entry_Section - (File_Handle : in Ada.Text_IO.File_Type); - - - - - procedure Put_Footer - (File_Handle : in Ada.Text_IO.File_Type); - - -private - - - package SU renames Ada.Strings.Unbounded; - - - function "+" - (S : in String) - return SU.Unbounded_String - renames SU.To_Unbounded_String; - - function "-" - (US : in SU.Unbounded_String) - return String - renames SU.To_String; - - - - - procedure Replace_All - (Text : in out SU.Unbounded_String; - Char : in Character; - Sub : in String) - with Pre => Ada.Strings.Fixed.Count (Sub, Ada.Strings.Maps.To_Set (Char)) = 0; - - procedure Replace_All - (Text : in out SU.Unbounded_String; - Item : in String; - Sub : in String); - - function Prep - (Text : in SU.Unbounded_String) - return SU.Unbounded_String; - - -end FMD; - - -- cgit