Models are queried

6 files changed, 1050 insertions, 40 deletions

diff --git a/freshdeck.gpr b/freshdeck.gpr
index f3065e0..d5b0450 100644
--- a/freshdeck.gpr
+++ b/freshdeck.gpr
@@ -1,6 +1,7 @@
 
 
 --  with "fltkada";
+with "gnatcoll";
 with "zipada_lib";
 
 
@@ -23,13 +24,14 @@ project Freshdeck is
 
 
     package Compiler is
-        for Default_Switches("Ada") use ("-gnaty4aAbcefhiklM100nprt");
+        for Default_Switches ("Ada") use ("-gnaty4aAbcefhiklM100nprt");
     end Compiler;
 
 
-    --  package Linker is
-    --      for Default_Switches("Ada") use ("-lfltk", "-lfltk_images");
-    --  end Linker;
+    package Linker is
+        --  for Default_Switches("Ada") use ("-lfltk", "-lfltk_images");
+        for Default_Switches ("Ada") use ("-lsqlite3");
+    end Linker;
 
 
 end Freshdeck;
diff --git a/src/deck_convert.adb b/src/deck_convert.adb
index 6d140a4..94b7098 100644
--- a/src/deck_convert.adb
+++ b/src/deck_convert.adb
@@ -10,7 +10,8 @@ with
     Ada.Directories,
     Ada.Strings.Unbounded,
     Ada.Text_IO,
-    UnZip;
+    SQLite3,
+    Deck_IO;
 
 use
 
@@ -50,16 +51,23 @@ procedure Deck_Convert is
     Further_Help : String := "Try ""deckconv --help"" for more information.";
 
 
-    Verbose       : aliased Boolean;
-    Help          : aliased Boolean;
-    Overwrite     : aliased Boolean;
-    Output_Format : aliased GStr.String_Access;
-    Input_Name    : aliased GStr.String_Access;
-    Output_Name   : aliased GStr.String_Access;
+    Verbose    : aliased Boolean;
+    Help       : aliased Boolean;
+    Overwrite  : aliased Boolean;
+    Format_Arg : aliased GStr.String_Access;
+    Input_Arg  : aliased GStr.String_Access;
+    Output_Arg : aliased GStr.String_Access;
 
 
-    Temp : File_Type;
-    Temp_Name : SU.Unbounded_String;
+    Deck_Format : SU.Unbounded_String;
+    Input_Name  : SU.Unbounded_String;
+    Output_Name : SU.Unbounded_String;
+
+
+    Deck   : Deck_IO.Deck_Handle;
+    Models : Deck_IO.Model_Maps.Map;
+    Notes  : Deck_IO.Note_Vectors.Vector;
+    Media  : Deck_IO.Media_Maps.Map;
 
 
 begin
@@ -81,19 +89,19 @@ begin
             Help   => "overwrite selected output file if present");
 
     GCom.Define_Switch
-           (Config => Config, Output      => Output_Format'Access,
+           (Config => Config, Output      => Format_Arg'Access,
             Switch => "-t:",  Long_Switch => "--type=",
             Help   => "format of output data, valid options are CSV or FMD");
 
     GCom.Define_Switch
-           (Config => Config, Output      => Input_Name'Access,
+           (Config => Config, Output      => Input_Arg'Access,
             Switch => "-i:",  Long_Switch => "--input=",
             Help   => "file name of input deck");
 
     GCom.Define_Switch
-           (Config => Config, Output      => Output_Name'Access,
+           (Config => Config, Output      => Output_Arg'Access,
             Switch => "-o:",  Long_Switch => "--output=",
-            Help   => "file name to store output data");
+            Help   => "base name to store output data");
 
 
     GCom.Set_Usage
@@ -116,10 +124,16 @@ begin
     end;
 
 
-    if Charhand.To_Upper (Output_Format.all) /= "CSV" and
-        Charhand.To_Upper (Output_Format.all) /= "FMD"
-    then
-        Put_Line (Standard_Error, Output_Format.all);
+    if Format_Arg.all = "" then
+        if Verbose then
+            Put_Line (Standard_Error, "WARNING: No output deck format selected. " &
+                "Proceeding with FMD as default.");
+        end if;
+        Deck_Format := +"fmd";
+    else
+        Deck_Format := +(Charhand.To_Lower (Format_Arg.all));
+    end if;
+    if Deck_Format /= "csv" and Deck_Format /= "fmd" then
         Put_Line (Standard_Error, "Output deck format required. Valid options are CSV or FMD." &
             Latin.LF & Further_Help);
         ACom.Set_Exit_Status (ACom.Failure);
@@ -127,13 +141,14 @@ begin
     end if;
 
 
-    if Input_Name.all = "" then
+    if Input_Arg.all = "" then
         Put_Line (Standard_Error, "File name of input deck was not provided." &
             Latin.LF & Further_Help);
         ACom.Set_Exit_Status (ACom.Failure);
         return;
     end if;
-    if not File.Exists (Input_Name.all) then
+    Input_Name := +(Input_Arg.all);
+    if not File.Exists (-Input_Name) then
         Put_Line (Standard_Error, "Input deck does not exist." &
             Latin.LF & Further_Help);
         ACom.Set_Exit_Status (ACom.Failure);
@@ -141,13 +156,14 @@ begin
     end if;
 
 
-    if Output_Name.all = "" then
+    if Output_Arg.all = "" then
         Put_Line (Standard_Error, "File name for output deck was not provided." &
             Latin.LF & Further_Help);
         ACom.Set_Exit_Status (ACom.Failure);
         return;
     end if;
-    if File.Exists (Output_Name.all) and not Overwrite then
+    Output_Name := +(Output_Arg.all);
+    if File.Exists ((-Output_Name) & "." & (-Deck_Format)) and not Overwrite then
         Put_Line (Standard_Error, "Output deck file name already exists." &
             Latin.LF & Further_Help);
         ACom.Set_Exit_Status (ACom.Failure);
@@ -155,24 +171,49 @@ begin
     end if;
 
 
-    if File.Exists ("collection.anki2") and not Overwrite then
-        Put_Line (Standard_Error, "Temporary collection.anki2 file already exists." &
-            Latin.LF & Further_Help);
-        ACom.Set_Exit_Status (ACom.Failure);
-        return;
+    --  if File.Exists ("collection.anki2") and not Overwrite then
+    --      Put_Line (Standard_Error, "Temporary collection.anki2 file already exists." &
+    --          Latin.LF & Further_Help);
+    --      ACom.Set_Exit_Status (ACom.Failure);
+    --      return;
+    --  end if;
+
+
+    --  1. extract media to a temporary file
+    --  2. generate mapping of what media filenames correspond to what names in the zip
+    --  3. extract collection.anki2 to a temporary file
+    --  4. open collection.anki2 as an SQL database
+    --  5. SELECT models from col
+    --  6. store models in vector with id, flds, tmpls
+    --  7. SELECT mid, flds FROM notes
+    --  8. store as a map from mid -> array of flds values
+    --  9. generate required output file names and dir names for each mid from base name
+    --  10. for each of the models...
+
+    --  CSV process
+    --    10.1. write header to output file using the fld names in model
+    --    10.2. write csv formatted row of each note for that model
+    --    10.3. as that is being done, if any note needs media, extract from zip into relevant dir
+
+    --  FMD process
+    --    10.1.
+
+
+    Deck_IO.Open_Database (-Input_Name, Deck);
+    Deck_IO.Query_Models (Deck, Models);
+    Deck_IO.Query_Notes (Deck, Notes);
+    Deck_IO.Close_Database (Deck);
+
+    if Deck_Format = "csv" then
+        Deck_IO.Write_CSV ("", "", Models, Notes);
+    elsif Deck_Format = "fmd" then
+        Deck_IO.Read_Media_Map (-Input_Name, Media);
+        Deck_IO.Write_FMD ("", "", Models, Notes, Media);
+    else
+        raise Constraint_Error;
     end if;
 
 
-    --  Generate a temporary filename
-    Create (File => Temp);
-    Temp_Name := +Name (Temp);
-    Close (Temp);
-
-    UnZip.Extract (Input_Name.all, "collection.anki2", (-Temp_Name));
-    Put_Line ("Extracted collection as " & (-Temp_Name));
-    File.Delete_File (-Temp_Name);
-
-
 end Deck_Convert;
 
 
diff --git a/src/deck_io.adb b/src/deck_io.adb
new file mode 100644
index 0000000..20eb6c1
--- /dev/null
+++ b/src/deck_io.adb
@@ -0,0 +1,298 @@
+
+
+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
+            SQLite3.Close (This.SQL_Handle);
+            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);
+        SQLite3.Open (Temp, Deck.SQL_Handle);
+        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;
+        SQLite3.Close (Deck.SQL_Handle);
+        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
+        SQLite3.Prepare (Deck.SQL_Handle, "SELECT models FROM col", Statement);
+        SQLite3.Step (Statement, Deck.Status);
+        SQLite3.Column (Statement, 0, Raw_Data);
+        SQLite3.Finish (Statement);
+        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;
+
+
diff --git a/src/deck_io.ads b/src/deck_io.ads
new file mode 100644
index 0000000..5fe9880
--- /dev/null
+++ b/src/deck_io.ads
@@ -0,0 +1,149 @@
+
+
+with
+
+    Ada.Containers.Vectors,
+    Ada.Containers.Ordered_Maps,
+    Ada.Strings.Unbounded;
+
+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;
+
+
+    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);
+
+
+    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);
+
+
+    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);
+
+
+    type Field is new SU.Unbounded_String;
+
+    package Field_Vectors is new Ada.Containers.Vectors
+       (Index_Type   => Positive,
+        Element_Type => Field);
+
+
+    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);
+
+
+    function Matches
+           (Models : in Model_Maps.Map;
+            Notes  : in Note_Vectors.Vector)
+        return Boolean;
+
+
+    type Media_ID is new SU.Unbounded_String;
+    subtype Media_Name is SU.Unbounded_String;
+
+    package Media_Maps is new Ada.Containers.Ordered_Maps
+       (Key_Type     => Media_ID,
+        Element_Type => Media_Name);
+
+
+    procedure Read_Media_Map
+           (Filename  : in     String;
+            Media_Map :    out Media_Maps.Map);
+
+
+    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_Maps.Map)
+    with Pre => Is_Open (Deck);
+
+    procedure Query_Notes
+           (Deck  : in out Deck_Handle;
+            Notes :    out Note_Vectors.Vector)
+    with Pre => Is_Open (Deck);
+
+
+    procedure Write_CSV
+           (Directory : in String;
+            Basename  : in String;
+            Models    : in Model_Maps.Map;
+            Notes     : in Note_Vectors.Vector)
+    with Pre => Matches (Models, Notes);
+
+    procedure Write_FMD
+           (Directory : in String;
+            Basename  : in String;
+            Models    : in Model_Maps.Map;
+            Notes     : in Note_Vectors.Vector;
+            Media     : in Media_Maps.Map)
+    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/sqlite3.adb b/src/sqlite3.adb
new file mode 100644
index 0000000..081d076
--- /dev/null
+++ b/src/sqlite3.adb
@@ -0,0 +1,372 @@
+
+
+with
+
+    Interfaces.C.Strings;
+
+
+package body SQLite3 is
+
+
+    procedure Open
+           (Filename : in     String;
+            Handle   :    out SQLite3_DB)
+    is
+        function sqlite3_open
+               (Filename  : in     Interfaces.C.char_array;
+                DB_Handle : access DB_Private_Access)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+    begin
+        Code := sqlite3_open (Interfaces.C.To_C (Filename), Handle.Ptr'Access);
+        if Status_Code (Code) /= SQLITE_OK then
+            raise Program_Error with Error_Message (Handle);
+        end if;
+    end Open;
+
+
+    procedure Open
+           (Filename : in     String;
+            Handle   :    out SQLite3_DB;
+            Flags    : in     Open_Flag)
+    is
+        function sqlite3_open_v2
+               (Filename  : in     Interfaces.C.char_array;
+                DB_Handle : access DB_Private_Access;
+                Flags     : in     Interfaces.C.int;
+                VFS       : in     Interfaces.C.char_array)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+    begin
+        Code := sqlite3_open_v2
+           (Interfaces.C.To_C (Filename),
+            Handle.Ptr'Access,
+            Interfaces.C.int (Flags),
+            Interfaces.C.To_C (""));
+        if Status_Code (Code) /= SQLITE_OK then
+            raise Program_Error with Error_Message (Handle);
+        end if;
+    end Open;
+
+
+    procedure Close
+           (Handle : in out SQLite3_DB)
+    is
+        function sqlite3_close
+               (DB_Handle : in DB_Private_Access)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+        Status : Status_Code;
+    begin
+        Code := sqlite3_close (Handle.Ptr);
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then
+            raise Program_Error with Error_Message (Handle);
+        end if;
+    end Close;
+
+
+    procedure Prepare
+           (Handle     : in     SQLite3_DB;
+            SQL        : in     String;
+            SQL_Handle :    out SQLite3_Statement)
+    is
+        type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
+
+        --  int sqlite3_prepare_v2(
+        --    sqlite3 *db,            /* Database handle */
+        --    const char *zSql,       /* SQL statement, UTF-8 encoded */
+        --    int nByte,              /* Maximum length of zSql in bytes. */
+        --    sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
+        --    const char **pzTail     /* OUT: Pointer to unused portion of zSql */
+        --  );
+        function sqlite3_prepare_v2
+               (DB_Handle : in     DB_Private_Access;
+                zSql      : in     Interfaces.C.char_array;
+                nByte     : in     Interfaces.C.int;
+                ppStmt    : access Statement_Private_Access;
+                pzTail    : in     Chars_Ptr_Ptr)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL);
+        Code : Interfaces.C.int;
+    begin
+        Code := sqlite3_prepare_v2
+           (DB_Handle => Handle.Ptr,
+            zSql      => SQL_Str,
+            nByte     => SQL_Str'Length,
+            ppStmt    => SQL_Handle.Ptr'Access,
+            pzTail    => null);
+        if Status_Code (Code) /= SQLITE_OK then
+            raise Program_Error with Error_Message (Handle);
+        end if;
+    end Prepare;
+
+
+    procedure Prepare
+           (Handle     : in     SQLite3_DB;
+            SQL        : in     String;
+            Flags      : in     Prepare_Flag;
+            SQL_Handle :    out SQLite3_Statement)
+    is
+        type Chars_Ptr_Ptr is access all Interfaces.C.Strings.chars_ptr;
+
+        --  int sqlite3_prepare_v3(
+        --    sqlite3 *db,            /* Database handle */
+        --    const char *zSql,       /* SQL statement, UTF-8 encoded */
+        --    int nByte,              /* Maximum length of zSql in bytes. */
+        --    unsigned int prepFlags  /* Zero or more SQLITE_PREPARE_ flags */
+        --    sqlite3_stmt **ppStmt,  /* OUT: Statement handle */
+        --    const char **pzTail     /* OUT: Pointer to unused portion of zSql */
+        --  );
+        function sqlite3_prepare_v2
+               (DB_Handle : in     DB_Private_Access;
+                zSql      : in     Interfaces.C.char_array;
+                nByte     : in     Interfaces.C.int;
+                prepFlags : in     Interfaces.C.unsigned;
+                ppStmt    : access Statement_Private_Access;
+                pzTail    : in     Chars_Ptr_Ptr)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        SQL_Str : Interfaces.C.char_array := Interfaces.C.To_C (SQL);
+        Code : Interfaces.C.int;
+    begin
+        Code := sqlite3_prepare_v2
+           (DB_Handle => Handle.Ptr,
+            zSql      => SQL_Str,
+            nByte     => SQL_Str'Length,
+            prepFlags => Interfaces.C.unsigned (Flags),
+            ppStmt    => SQL_Handle.Ptr'Access,
+            pzTail    => null);
+        if Status_Code (Code) /= SQLITE_OK then
+            raise Program_Error with Error_Message (Handle);
+        end if;
+    end Prepare;
+
+
+    procedure Step
+           (SQL_Handle : in     SQLite3_Statement;
+            Status     :    out Status_Code)
+    is
+        --  int sqlite3_step(sqlite3_stmt*);
+        function sqlite3_step
+               (Stmt : in Statement_Private_Access)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+    begin
+        Code := sqlite3_step (SQL_Handle.Ptr);
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK and Status /= SQLITE_ROW and Status /= SQLITE_DONE then
+            raise Program_Error with Error_String (Status);
+        end if;
+    end Step;
+
+
+    procedure Finish
+           (SQL_Handle : in SQLite3_Statement)
+    is
+        --  int sqlite3_finalize(sqlite3_stmt*);
+        function sqlite3_finalize
+               (Stmt : in Statement_Private_Access)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+        Status : Status_Code;
+    begin
+        Code := sqlite3_finalize (SQL_Handle.Ptr);
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK then
+            raise Program_Error with Error_String (Status);
+        end if;
+    end Finish;
+
+
+    procedure Reset
+           (SQL_Handle : in SQLite3_Statement)
+    is
+        --  int sqlite3_reset(sqlite3_stmt*);
+        function sqlite3_reset
+               (Stmt : in Statement_Private_Access)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+        Status : Status_Code;
+    begin
+        Code := sqlite3_reset (SQL_Handle.Ptr);
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK then
+            raise Program_Error with Error_String (Status);
+        end if;
+    end Reset;
+
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Integer) is
+    begin
+        Bind (SQL_Handle, Index, Long_Integer (Value));
+    end Bind;
+
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Long_Integer)
+    is
+        --  int sqlite3_bind_int(sqlite3_stmt*, int, int);
+        function sqlite3_bind_int
+               (Stmt  : in Statement_Private_Access;
+                Index : in Interfaces.C.int;
+                Value : in Interfaces.C.int)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+        Status : Status_Code;
+    begin
+        Code := sqlite3_bind_int
+           (Stmt  => SQL_Handle.Ptr,
+            Index => Interfaces.C.int (Index),
+            Value => Interfaces.C.int (Value));
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK then
+            raise Program_Error with Error_String (Status);
+        end if;
+    end Bind;
+
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Ada.Strings.Unbounded.Unbounded_String)
+    is
+        use Ada.Strings.Unbounded;
+
+        --  int sqlite3_bind_text
+        --       (sqlite3_stmt*,
+        --        int,
+        --        const char*,
+        --        int,
+        --        void(*)(void*));
+        function sqlite3_bind_text
+               (Stmt  : in Statement_Private_Access;
+                Index : in Interfaces.C.int;
+                Value : in Interfaces.C.char_array;
+                Bytes : in Interfaces.C.int;
+                Opt   : in Interfaces.C.long)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Code : Interfaces.C.int;
+        Status : Status_Code;
+    begin
+        Code := sqlite3_bind_text
+           (Stmt  => SQL_Handle.Ptr,
+            Index => Interfaces.C.int (Index),
+            Value => Interfaces.C.To_C (To_String (Value)),
+            Bytes => Interfaces.C.int (Length (Value)),
+            Opt   => SQLITE_TRANSIENT);
+        Status := Status_Code (Code);
+        if Status /= SQLITE_OK then
+            raise Program_Error with Error_String (Status);
+        end if;
+    end Bind;
+
+
+    procedure Column
+           (SQL_Handle : in     SQLite3_Statement;
+            Index      : in     SQL_Column_Index;
+            Value      :    out Int)
+    is
+        --  int sqlite3_column_int(sqlite3_stmt*, int iCol);
+        function sqlite3_column_int
+               (Stmt  : in Statement_Private_Access;
+                Index : in Interfaces.C.int)
+            return Interfaces.C.int
+        with Import => True, Convention => C;
+
+        Ret_Val : Interfaces.C.int;
+    begin
+        Ret_Val := sqlite3_column_int
+           (Stmt => SQL_Handle.Ptr,
+            Index => Interfaces.C.int (Index));
+        Value := Int (Ret_Val);
+    end Column;
+
+
+    procedure Column
+           (SQL_Handle : in     SQLite3_Statement;
+            Index      : in     SQL_Column_Index;
+            Value      :    out Ada.Strings.Unbounded.Unbounded_String)
+    is
+        use Ada.Strings.Unbounded;
+        use Interfaces;
+        use type Interfaces.C.Strings.chars_ptr;
+
+        --  const unsigned char *sqlite3_column_text(sqlite3_stmt*, int iCol);
+        function sqlite3_column_text
+               (Stmt  : in Statement_Private_Access;
+                Index : in Interfaces.C.int)
+            return Interfaces.C.Strings.chars_ptr
+        with Import => True, Convention => C;
+
+        Ret_Val : Interfaces.C.Strings.chars_ptr;
+    begin
+        Ret_Val := sqlite3_column_text
+           (Stmt  => SQL_Handle.Ptr,
+            Index => Interfaces.C.int (Index));
+        if Ret_Val = C.Strings.Null_Ptr then
+            Value := Null_Unbounded_String;
+        else
+            Value := To_Unbounded_String (C.To_Ada (C.Strings.Value (Ret_Val)));
+        end if;
+    end Column;
+
+
+    function Error_Message
+           (Handle : in SQLite3_DB)
+        return String
+    is
+        use Interfaces;
+
+        --  const char *sqlite3_errmsg(sqlite3*);
+        function sqlite3_errmsg
+               (DB_Handle : in DB_Private_Access)
+            return C.Strings.chars_ptr
+        with Import => True, Convention => C;
+    begin
+        return C.To_Ada (C.Strings.Value (sqlite3_errmsg (Handle.Ptr)));
+    end Error_Message;
+
+
+    function Error_String
+           (Status : in Status_Code)
+        return String
+    is
+        use Interfaces;
+
+        function sqlite3_errstr
+               (Code : in Interfaces.C.int)
+            return C.Strings.chars_ptr
+        with Import => True, Convention => C;
+    begin
+        return C.To_Ada (C.Strings.Value (sqlite3_errstr (Interfaces.C.int (Status))));
+    end Error_String;
+
+
+end SQLite3;
+
+
diff --git a/src/sqlite3.ads b/src/sqlite3.ads
new file mode 100644
index 0000000..667fdd6
--- /dev/null
+++ b/src/sqlite3.ads
@@ -0,0 +1,148 @@
+
+
+with
+
+    Ada.Strings.Unbounded,
+    System,
+    Interfaces.C;
+
+
+package SQLite3 is
+
+
+    type SQLite3_DB is private;
+    type SQLite3_Statement is private;
+
+    type Open_Flag is mod 2**32;
+    type Prepare_Flag is mod 2**32;
+    type Status_Code is new Long_Integer;
+
+    subtype SQL_Parameter_Index is Integer range 1 .. Integer'Last;
+    subtype SQL_Column_Index is Integer;
+    type Int is new Interfaces.C.int;
+
+
+    OPEN_READONLY      : constant Open_Flag := 1;
+    OPEN_READWRITE     : constant Open_Flag := 2;
+    OPEN_CREATE        : constant Open_Flag := 4;
+    OPEN_DELETEONCLOSE : constant Open_Flag := 8;
+    OPEN_EXCLUSIVE     : constant Open_Flag := 16;
+    OPEN_AUTOPROXY     : constant Open_Flag := 32;
+    OPEN_URI           : constant Open_Flag := 64;
+    OPEN_MEMORY        : constant Open_Flag := 128;
+    OPEN_MAIN_DB       : constant Open_Flag := 256;
+    OPEN_TEMP_DB       : constant Open_Flag := 512;
+    OPEN_TRANSIENT_DB  : constant Open_Flag := 1024;
+    OPEN_MAIN_JOURNAL  : constant Open_Flag := 2048;
+    OPEN_TEMP_JOURNAL  : constant Open_Flag := 4096;
+    OPEN_SUBJOURNAL    : constant Open_Flag := 8192;
+    OPEN_SUPER_JOURNAL : constant Open_Flag := 16384;
+    OPEN_NOMUTEX       : constant Open_Flag := 32768;
+    OPEN_FULLMUTEX     : constant Open_Flag := 65536;
+    OPEN_SHAREDCACHE   : constant Open_Flag := 131072;
+    OPEN_PRIVATECACHE  : constant Open_Flag := 262144;
+    OPEN_WAL           : constant Open_Flag := 524288;
+    OPEN_NOFOLLOW      : constant Open_Flag := 16777216;
+
+    PREPARE_PERSISTENT : constant Prepare_Flag := 1;
+    PREPARE_NORMALIZE  : constant Prepare_Flag := 2;
+    PREPARE_NO_VTAB    : constant Prepare_Flag := 4;
+
+    SQLITE_OK    : constant Status_Code := 0;
+    SQLITE_ROW   : constant Status_Code := 100;
+    SQLITE_DONE  : constant Status_Code := 101;
+
+    SQLITE_TRANSIENT : constant := -1;
+
+
+    procedure Open
+           (Filename : in     String;
+            Handle   :    out SQLite3_DB);
+
+    procedure Open
+           (Filename : in     String;
+            Handle   :    out SQLite3_DB;
+            Flags    : in     Open_Flag);
+
+    procedure Close
+           (Handle : in out SQLite3_DB);
+
+    procedure Prepare
+           (Handle     : in     SQLite3_DB;
+            SQL        : in     String;
+            SQL_Handle :    out SQLite3_Statement);
+
+    procedure Prepare
+           (Handle     : in     SQLite3_DB;
+            SQL        : in     String;
+            Flags      : in     Prepare_Flag;
+            SQL_Handle :    out SQLite3_Statement);
+
+    procedure Step
+           (SQL_Handle : in     SQLite3_Statement;
+            Status     :    out Status_Code);
+
+    procedure Finish
+           (SQL_Handle : in SQLite3_Statement);
+
+    procedure Reset
+           (SQL_Handle : in SQLite3_Statement);
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Integer);
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Long_Integer);
+
+    procedure Bind
+           (SQL_Handle : in SQLite3_Statement;
+            Index      : in SQL_Parameter_Index;
+            Value      : in Ada.Strings.Unbounded.Unbounded_String);
+
+    procedure Column
+           (SQL_Handle : in     SQLite3_Statement;
+            Index      : in     SQL_Column_Index;
+            Value      :    out Int);
+
+    procedure Column
+           (SQL_Handle : in     SQLite3_Statement;
+            Index      : in     SQL_Column_Index;
+            Value      :    out Ada.Strings.Unbounded.Unbounded_String);
+
+
+private
+
+
+    --  There are actually many more errors than this
+    SQLITE_ERROR : constant Status_Code := 1;
+
+    function Error_Message
+           (Handle : in SQLite3_DB)
+        return String;
+
+    function Error_String
+           (Status : in Status_Code)
+        return String;
+
+
+    type DB_Private is null record;
+    type DB_Private_Access is access all DB_Private;
+
+    type SQLite3_DB is record
+        Ptr : aliased DB_Private_Access;
+    end record;
+
+    type Statement_Private is null record;
+    type Statement_Private_Access is access all Statement_Private;
+    type SQLite3_Statement is record
+        Ptr : aliased Statement_Private_Access;
+    end record;
+
+
+end SQLite3;
+
+