%%
%% This is part of Andrew Sadler's Database package.
%%

%% A wrapper functor to provide an abstract SQL interface

%% NOTE: this version interfaces to MySQL

functor

import
   Error(printException)
   System(/*show*/ showInfo)
   Finalize(register)

   MYSQL at 'MySqlLib.so{native}'
   
export
   Connect            % fun {$ Host User Password DBName} --> Conn
   Close              % proc {$ Conn}
   Query              % fun {$ Conn QueryStr} --> FieldList#ResultList or nil

   escape:      SqlEscape   % fun {$ Str} --> Str
   quoteString: SqlQuoteS   % fun {$ Str} --> VS
   quote:       SqlQuote    % fun {$ VS}  --> VS
   
   ToListQuoted       % fun {$ L OpenQuote CloseQuote} --> VS
   ToListUnQuoted     % fun {$ L} --> {ToListQuoted L ' ' ' '}
   ToList             % fun {$ L} --> {ToListQuoted L '"' '"'}

   ResultSetToRecords % fun {$ ResSet} --> Records
   
define

   %% Connects to a given database on a given host
   proc {Connect Host User Password DBName ?Conn}
      Conn = {MYSQL.connect Host User Password DBName 0 0}
      {Finalize.register Conn Close}
   end

   %% Closes a host connection
   %% NOTE: This will be called by the garbage collector
   proc {Close Conn}
      {MYSQL.close Conn}
      {System.showInfo "%%% Connection to database closed."}
   end
   
   %% Sends a query, and awaits the result
   %% Returns a pair FieldNames#Rows where each row is a ColValues list
   %% ResultSetToRecords can be used to convert it to a list of records
   %% NOTE: This might block
   fun {Query Conn QueryStr}
      
      ResultSet
      fun {MakeResultList}
         Row={MYSQL.fetch_row ResultSet}
      in
         %%{System.show Row}
         if Row=='MYSQL_EMPTY_QUERY'
         then nil
         else Row|{MakeResultList}
         end
      end
      ResultList FieldList
   in
      case {MYSQL.query Conn QueryStr} of 0 then
         try
            ResultSet  = {MYSQL.store_result Conn}
            FieldList  = {MYSQL.fetch_fields ResultSet}
            ResultList = {MakeResultList}
            {MYSQL.free_result ResultSet}
         catch /*Err=*/error(...) then
            %%{System.showInfo 'SQL.Query: An exception was thrown.'}
            %%{Error.printException Err}
            FieldList  = nil
            ResultList = nil
         end
         FieldList#ResultList
      [] _/*ErrorCode*/ then
         ErrNo = {MYSQL.errno Conn}
         ErrMsg = {MYSQL.error Conn}
      in
         {System.showInfo "ERROR "#ErrNo#": "#ErrMsg}
         error(ErrNo ErrMsg)
      end
   end

   /*
   fun {Insert Conn TableVS Values}
      {Query Conn "insert into "#TableVS#" values ("#{ToList Values}#")"}
   end
   */
   
   %% quote and escape values for use in SQL statements and queries
   fun {SqlEscape S}
      case S of nil then nil
      [] C|Sr then
         case C
         of 0 then &\\|&0|{SqlEscape Sr}      %% ASCII  0 (NUL)
         [] &\\ then &\\|&\\|{SqlEscape Sr}   %% ASCII 92 (backslash)
         [] &' then &\\|&'|{SqlEscape Sr}     %% ASCII 39 (single quote)
         [] &" then &\\|&"|{SqlEscape Sr}     %% ASCII 34 (double quote)
         else C|{SqlEscape Sr}
         end
      end
   end
   
   fun {SqlQuoteS S}
      "'"#{SqlEscape S}#"'"
   end
   fun {SqlQuote VS}
      {SqlQuoteS {VirtualString.toString VS}}
   end

   %% Converts a list of OZ values to a quoted
   fun {ToList L}
      {ToListQuoted L '"' '"'}
   end

   %% Converts a list of oz values to an un-quoted list
   fun {ToListUnQuoted L}
      {ToListQuoted L " " " "}
   end

   %% Converts an list of OZ values into a virtual string of comma
   %% seperated strings eg...
   %% "1,2,\"foo\",4"={VirtualString.toString {ToList [1 2 foo 4]}}

   fun {QuoteVal X OpenQuote CloseQuote}
      case {Value.type X}
      of 'int' then X
      [] 'byteString' then
         OpenQuote#{SqlEscape {ByteString.toString X}}#CloseQuote
      [] 'atom' then
         if X=='NULL'
         then X
         else OpenQuote#X#CloseQuote
         end
      [] 'float' then
         {VirtualString.changeSign X "-"}
      else %% VirtualString. Are there other cases?
         OpenQuote#{SqlEscape {VirtualString.toString X}}#CloseQuote
      end
   end
   
   fun {ToListQuoted L OpenQuote CloseQuote}
      {List.foldR L
       fun {$ X Xr}
          XStr = {QuoteVal X OpenQuote CloseQuote}
       in
          if Xr==nil
          then '#'(XStr)
          else {Tuple.append '#'(XStr ',') Xr}
          end
       end
       nil}
   end

   %% auxiliuary function
   fun {MakePairs Xs Ys}
      case Xs of nil then case Ys of nil then nil end
      [] X|Xr then case Ys of Y|Yr then (X#Y)|{MakePairs Xr Yr} end
      end
   end
   /* same as
   fun {MakePairs Xs Ys}
      {List.zip Xs Ys
       fun {$ X Y} X#Y end}
   end
   */
   
   %% Converts the return value of a Query into a list of records
   fun {ResultSetToRecords ResultSet}
      case ResultSet
      of ColNames#Rows then
         {Map Rows
          fun {$ ColValues}
             {List.toRecord rec {MakePairs ColNames ColValues}}
          end}
      else
         ResultSet
      end
   end
   
   %% some stuff that may be useful for ``partial result lists''
   /*
   fun {MapLazy Xs F}
      if {IsFuture Xs} then
         {ByNeed fun {$}
                    X|Xr = Xs in
                    {F X}|{MapLazy Xr F}
                 end}
      else
         case Xs of nil then nil
         [] X|Xr then {F X}|{MapLazy Xr F} end
      end
   end
   */
   
end