path: root/src/deck_io.adb

with

    Ada.Characters.Latin_1,
    Ada.Directories,
    Ada.Text_IO,
    GNAT.Regpat,
    GNATCOLL.JSON,
    UnZip;

use

    Ada.Text_IO;


package body Deck_IO is


    package Latin renames Ada.Characters.Latin_1;
    package FD renames Ada.Directories;
    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;




    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   : File_Type;
        Filename : SU.Unbounded_String;
    begin
        Create (File => Handle);
        Filename := +Name (Handle);
        Close (Handle);
        return -Filename;
    end Generate_Temp_Name;




    function Matches
           (Models : in Model_Maps.Map;
            Notes  : in Note_Vectors.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_Map
           (Filename  : in     String;
            Media_Map :    out Media_Maps.Map)
    is
        Temp : String := Generate_Temp_Name;

        Input_Handle : 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
        begin
            Media_Map.Insert (Media_ID (+Name), JS.Get (Value));
        end Map_Iteration;
    begin
        UnZip.Extract (Filename, "media", Temp);

        Open (Input_Handle, In_File, Temp);
        while not End_Of_File (Input_Handle) loop
            SU.Append (Raw_Data, Get_Line (Input_Handle) & Latin.LF);
        end loop;
        Close (Input_Handle);
        FD.Delete_File (Temp);

        JSON_Data := JS.Read (-Raw_Data);
        JS.Map_JSON_Object (JSON_Data, Map_Iteration'Access);
    end Read_Media_Map;




    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_Vectors.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_Vectors.Vector)
    is
        use type Pat.Match_Location;
        Matches : Pat.Match_Array (0 .. 1);
        Regexp  : Pat.Pattern_Matcher := Pat.Compile ("{{(?:\w+:)?(\w+)}}", 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_Vectors.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_Maps.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_Maps.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 Query_Notes
           (Deck  : in out Deck_Handle;
            Notes :    out Note_Vectors.Vector)
    is
    begin
        null;
    end Query_Notes;




    procedure Write_CSV
           (Directory : in String;
            Basename  : in String;
            Models    : in Model_Maps.Map;
            Notes     : in Note_Vectors.Vector)
    is
    begin
        null;
    end Write_CSV;


    procedure Write_FMD
           (Directory : in String;
            Basename  : in String;
            Models    : in Model_Maps.Map;
            Notes     : in Note_Vectors.Vector;
            Media     : in Media_Maps.Map)
    is
    begin
        null;
    end Write_FMD;


end Deck_IO;