/*
 * Copyright (c) 2003-2008 The University of Wroclaw.
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *    1. Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *    2. Redistributions in binary form must reproduce the above copyright
 *       notice, this list of conditions and the following disclaimer in the
 *       documentation and/or other materials provided with the distribution.
 *    3. The name of the University may not be used to endorse or promote
 *       products derived from this software without specific prior
 *       written permission.
 * 
 * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
 * NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */

using Nemerle.Compiler;
using Nemerle.Macros;
using Nemerle.Collections;
using System.Text.RegularExpressions;
using System.Data;

namespace Nemerle.Data 
{
  /**
    Define connection string, which will be used by application
    (also for compile-time verification of SQL queries by compiler)
   */
  [Nemerle.MacroUsage (Nemerle.MacroPhase.BeforeInheritance,
                       Nemerle.MacroTargets.Assembly)]
  macro ConfigureConnection (connClass : string, con_str : string, name : string = "")
  {
    def mng = Manager ();
    if (Helper.connections.Contains (name))
      Message.FatalError ("Connection with name `" + name + "' is already defined")
    else {
      try {
        def connection = Helper.CreateConnection (mng, connClass, con_str);
        connection.Open ();
        Helper.connections.Add (name, connection);
      }
      catch {
        | e is Recovery => throw e;
        | e =>
          Message.FatalError ($"connecting to database failed: $e")
      }
    };
  }

  macro CreateConnection (connStr, con_name : string = "") {
    <[ $(Helper.ConnectionExpr (Manager (), con_name)) ($connStr) ]>
  }
  
  macro ExecuteNonQuery (query : string, conn, con_name : string = "")
  {
    def (query, tpars, pars_init) =
      Helper.ExtractParameters (ImplicitCTX (), query, Helper.ParameterChar (con_name));

    // create compile-time query to check syntax and types in query
    def (mycmd, mytran) = Helper.CreateCommand (query, con_name);    

    try { 
      tpars.Iter (fun (name, tvar : Typedtree.TExpr) {
        Helper.InitParameter (mycmd, name, tvar.ty.Fix ());
      });
      // try to execute query chcecking its syntax and typecorrectness
      _ = mycmd.ExecuteNonQuery ()
    }
    catch {
      | e  =>
        Message.FatalError ("sql query error: " + e.Message)
    }
    finally {
      mytran.Rollback ();
      mycmd.Dispose ();
    };

    <[
      using (querycmd = $(Helper.CommandExpr (Manager (), con_name, query, conn))) 
      {
        { .. $pars_init };
        querycmd.ExecuteNonQuery ();
      }
    ]>
  }

  macro ExecuteScalar (query : string, conn, con_name : string = "")
  {
    def (query, tpars, pars_init) =
      Helper.ExtractParameters (ImplicitCTX (), query, Helper.ParameterChar (con_name));

    // create compile-time query to check syntax and types in query
    def (mycmd, mytran) = Helper.CreateCommand (query, con_name);

    mutable col_type = null;
    try {
      tpars.Iter (fun (name, tvar : Typedtree.TExpr) {
        Helper.InitParameter (mycmd, name, tvar.ty.Fix ());
      });

      // try to execute query chcecking its syntax and aquiring names of columns
      def myreader = mycmd.ExecuteReader(CommandBehavior.SchemaOnly);
      def table = myreader.GetSchemaTable ();
      if (table.Rows.Count < 1)
        Message.FatalError ("this query doesn't return any value")
      else 
        col_type = Parsetree.PExpr.FromQualifiedIdentifier (Manager (), table.Rows[0]["DataType"].ToString ());
      myreader.Close ();
    }
    catch {
      | e  =>
        Message.FatalError ("sql query error: " + e.Message)
    }
    finally {
      mytran.Rollback ();
      mycmd.Dispose ();
    };

    /// final code for entire sql loop
    <[
      using (querycmd = $(Helper.CommandExpr (Manager (), con_name, query, conn)))
      {
        { .. $pars_init };
        (querycmd.ExecuteScalar () :> $col_type);
      }
    ]>
  }

  macro ExecuteReader (query : string, conn, con_name : string = "")
  {
    def (query, tpars, pars_init) =
      Helper.ExtractParameters (ImplicitCTX (), query, Helper.ParameterChar (con_name));

    // create compile-time query to check syntax and types in query
    def (mycmd, mytran) = Helper.CreateCommand (query, con_name);
    try {
      tpars.Iter (fun (name, tvar : Typedtree.TExpr) {
        Helper.InitParameter (mycmd, name, tvar.ty.Fix ());
      });
      // try to execute query chcecking its syntax
      _ = mycmd.ExecuteNonQuery ();
    }
    catch {
      | e  =>
        Message.FatalError ("sql query error: " + e.Message)
    }
    finally {
      mytran.Rollback ();
      mycmd.Dispose ();
    };

    /// final code for entire sql loop
    <[
      using (querycmd = $(Helper.CommandExpr (Manager (), con_name, query, conn)))
      {
        { .. $pars_init };
        querycmd.ExecuteReader ();
      }
    ]>
  }

  macro ExecuteReaderLoop (query : string, conn, body, con_name : string = "")
  {
    def (query, tpars, pars_init) =
      Helper.ExtractParameters (ImplicitCTX (), query, Helper.ParameterChar (con_name));

    // list of definitions of query results inside loop body
    mutable bodyseq = [body];

    // create compile-time query to check syntax and types in query
    def (mycmd, mytran) = Helper.CreateCommand (query, con_name);
    try {
      tpars.Iter (fun (name, tvar : Typedtree.TExpr) {
        Helper.InitParameter (mycmd, name, tvar.ty.Fix ())
      });

      // try to execute query chcecking its syntax and aquiring names of columns
      def myreader = mycmd.ExecuteReader(CommandBehavior.SchemaOnly %|
                                         CommandBehavior.SingleRow);
      def table = myreader.GetSchemaTable ();
      mutable col_num = 0;
      foreach (myRow :> DataRow in table.Rows){
        def col_type = myRow["DataType"].ToString ();
        def col_name = myRow["ColumnName"].ToString ();
        def allow_null = myRow["AllowDBNull"] :> bool;
        def fetchexpr = Helper.GenerateFetchExpr (Manager (), col_type, col_num, allow_null);
          
        // create runtime variables definition according to extracted types
        bodyseq = <[ def $(col_name : usesite) = $fetchexpr ]> :: bodyseq;
        ++col_num;
      };

      myreader.Close ();
    }
    catch {
      | e  =>
        Message.FatalError ("sql query error: " + e.Message)
    }
    finally {
      mytran.Rollback ();
      mycmd.Dispose ();
    };

    /// final code for entire sql loop
    <[
      using (querycmd = $(Helper.CommandExpr (Manager (), con_name, query, conn))) {
        { .. $pars_init };
        def reader = querycmd.ExecuteReader ();
        while (reader.Read ()) { ..$bodyseq };
        reader.Close ();
      }
    ]>
  }

  module Helper {
    internal connections : Hashtable [string, IDbConnection] = Hashtable ();

    public CreateConnection (mng : ManagerClass, tyName : string, connStr : string) : IDbConnection
    {
      def idbTy = match (mng.NameTree.LookupExactType ("System.Data.IDbConnection")) {
        | Some (t) => t
        | None => Message.FatalError ("You need to have `System.Data.dll' among reference assemblies to use sql macros - could not find `System.Data.IDbConnection' interface");
      }
        
      match (mng.NameTree.LookupExactType (tyName)) {
        | Some (ty) => 
          if (ty.SuperType (idbTy).IsSome)
            System.Activator.CreateInstance (ty.SystemType, connStr) :> IDbConnection;
          else
            Message.FatalError ($"Specified type `$tyName' does not implement `System.Data.IDbConnection' interface for providing sql connection");
        | None =>
          Message.FatalError ($"Could not instantiate type `$tyName' providing sql connection - not found in referenced assemblies");
      }
      
    }
    
    public CreateCommand (query : string, con_name : string, want_tran = true) : IDbCommand * IDbTransaction
    {
      def conn = get_connection (con_name);
      mutable tran = null;
      when (want_tran)
        tran = conn.BeginTransaction ();
      def cmd = conn.CreateCommand ();
      cmd.CommandText = query;
      cmd.Connection = conn;
      when (tran != null)
        cmd.Transaction = tran;
      (cmd, tran)
    }
    
    public InitParameter (cmd : IDbCommand, name : string, ty : MType) : void
    {
       def dbvalue = type_representant (ty);
       def p = cmd.CreateParameter ();
       p.ParameterName = name;
       p.Value = dbvalue;
       _ = cmd.Parameters.Add (p);
    }
    
    public ConnectionExpr (mgr : ManagerClass, con_name : string) : Parsetree.PExpr {
      def connClass = connections [con_name].GetType ().TypeFullName ();
      Parsetree.PExpr.FromQualifiedIdentifier (mgr, connClass)
    }
    
    public CommandExpr (mgr : ManagerClass, con_name : string, query : string, conn : Parsetree.PExpr) : Parsetree.PExpr {
      def connClass = connections [con_name].GetType ().TypeFullName ();
      def cmdExpr = Parsetree.PExpr.FromQualifiedIdentifier (mgr, connClass.Replace ("Connection", "Command"));
      def connExpr = Parsetree.PExpr.FromQualifiedIdentifier (mgr, connClass);
      
      <[ $cmdExpr ($(query : string), ($conn : IDbConnection) :> $connExpr) ]> 
    }
    
    public ParameterChar (conName : string) : char {
      def connClass = connections [conName].GetType ().TypeFullName ();
      if (connClass.EndsWith (".SqlConnection"))
        '@' 
      else if (connClass.EndsWith (".NpgsqlConnection"))
        ':'
      else
        ':'
    }
    
    get_connection (name : string) : IDbConnection
    {
      match (connections.Get (name)) {
        | Some (c) => c
        | None =>
          if (name == "")
            Message.FatalError ("default connection was not found")
          else
            Message.FatalError ("connection `" + name + "' was not found")
      }
    }

    type_representant (t : MType) : object
    {
      match (t) {
        | MType.Class (tc, []) =>
          match (tc.FullName) {
            | "System.String" | "Nemerle.Core.string" => "st" : object
            | "System.Int32" | "Nemerle.Core.int" => 234
            | "System.Boolean" | "Nemerle.Core.bool" => true
            | "System.UInt32" | "Nemerle.Core.uint" => 234u
            | "System.Byte" | "Nemerle.Core.byte" => 34ub
            | "System.DateTime" => System.DateTime.Now
            | "System.Decimal" | "Nemerle.Core.decimal" => 45.3m
            | "System.Double" | "Nemerle.Core.double" => 34.4
            | "System.Int16" | "Nemerle.Core.short" => 34s
            | "System.UInt16" | "Nemerle.Core.ushort" => 34us
            | "System.Int64" | "Nemerle.Core.long" => 34l
            | "System.UInt64" | "Nemerle.Core.ulong" => 34ul
            | "System.SByte" | "Nemerle.Core.sbyte" => 34b
            | "System.Single" | "Nemerle.Core.float" => 34.4f
            | x => Message.FatalError (x + " type not supported")
          }
        | _ =>
          Message.FatalError ("only basic types supported in sql query")
      }
    }
    
    /** Extracts parameters after $, perform typing of expressions containing
        variables with names of those parameters.
    
        Returns:
        - final SQL provider specific query
        - collection of pairs of name and typed expression containing variable with this
          name
        - list of expressions initializing [querycmd.Parameters] to value of
          above variables
    */
    public ExtractParameters (ctx : Typer, query : string, param_prefix : char)
    : string * Hashtable [string, Typedtree.TExpr] * list [Parsetree.PExpr]
    {
      // take names after $
      def namesreg = Regex (@"(([^\$]*)\$(\w+))|(.+)", RegexOptions.Singleline);
      mutable m = namesreg.Match (query);
      def fquery = System.Text.StringBuilder (query);
      def pars = Hashtable ();

      // extract names and prefix them with Sql parameter delimiter `:'
      while (m.Success) {
        when (m.Groups[1].Success) {
          pars.Set (m.Groups[3].ToString (), null);
          fquery[m.Groups[3].Index - 1] = param_prefix;
        };
        m = m.NextMatch ();
      };

      /// initializers of sql command parameters
      def tpars = Hashtable ();
      /// expressions initializing [querycmd.Parameters] with their values    
      mutable pars_init = [];
      // itreate through parameters to type them and create initializers
      pars.Iter (fun (x : string, _) {
        def tvar = ctx.TypeExpr (<[ $(x : usesite) ]>);
        tpars.Set (x, tvar);

        /// add parameter initializer
        pars_init = <[
          def p = querycmd.CreateParameter ();
          p.ParameterName = $(x : string);
          querycmd.Parameters.Add (p).Value = $(tvar : typed);
        ]> :: pars_init;
      });
      (fquery.ToString (), tpars, pars_init)
    }
  
    public GenerateFetchExpr (mng : ManagerClass, typeName : string, colIdx : int, allow_null: bool) : Parsetree.PExpr {
      def type_suff = 
        if (typeName.StartsWith ("System."))
          typeName.Substring (7)
        else typeName;
      
      def retTy = 
        match (mng.NameTree.LookupExactType (typeName)) {
          | Some (t) => 
            def rawTy = <[ $(Parsetree.PExpr.FromQualifiedIdentifier (mng, typeName)) ]>;
            if (!allow_null || t.GetMemType ().CanBeNull) rawTy
            else <[ $rawTy ? ]>
          | None => Message.FatalError ("DB provider returned unknown type name: " + typeName);
        }
      
      def real_fetch = <[ reader.$("Get" + type_suff : usesite) ($(colIdx : int)) : $retTy ]>;
      
      if(allow_null)
        <[ if (reader.IsDBNull ($(colIdx : int))) null : $retTy
           else $real_fetch ]>
      else
        real_fetch
    }
  }
}