%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997 Mission Critical.
% Copyright (C) 1997-2000, 2002, 2004-2006, 2010 The University of Melbourne.
% Copyright (C) 2017-2018 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: odbc.m.
% Authors: Renaud Paquay (rpa@miscrit.be), stayl.
% ODBC version: 2.0.
%
% The transaction interface used here is described in the following paper:
%
%   Kemp, Conway, Harris, Henderson, Ramamohanarao and Somogyi,
%   "Database transactions in a purely declarative logic programming language".
%   In Proceedings of the Fifth International Conference on Database
%   Systems for Advanced Applications, pp. 283-292.
%   Melbourne, Australia, 1-4 April, 1997.
%
%   An earlier(?) version of this paper is available as
%   Technical Report 96/45, Department of Computer Science,
%   University of Melbourne, December 1996,
%   <http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45_cover.ps.gz>
%   and <http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45.ps.gz>.
%
% This has been tested using the following platforms:
% - MySQL 3.20.19 and iODBC 2.12 under Solaris 2.5
% - MySQL 3.22.32 and iODBC 2.50.3 under Solaris 2.6
% - Microsoft SQL Server 6.5 under Windows NT 4.0 with the
%   GNU-Win32 tools beta 17.1
%
% Notes:
%
%   Binary data is converted to a string of hexadecimal digits.
%
%   This module requires a compilation grade with conservative garbage
%   collection. Any grade containing .gc in its name, such as asm_fast.gc,
%   will do. See the section "Compilation model options" in the Mercury
%   User's Guide for more information.
%
%   The header files distributed with the Microsoft ODBC SDK require
%   some modification for compilation with gcc.  In particular,
%   some conflicting typedefs for SQLUINTEGER and SQLSCHAR must be
%   removed from sqltypes.h.
%   (For legal reasons a patch cannot be included in the Mercury
%   distribution.)
%   The Microsoft ODBC header files also use some C++ style comments,
%   so you need to use the `--no-ansi' option to mgnuc.
%
% To do:
%
%   Improve the interface to the catalog functions.
%
%   Add a nicer interface so the user does not need to manipulate
%   SQL strings.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module odbc.
:- interface.

:- import_module list.
:- import_module io.
:- import_module pair.
:- import_module string.

%-----------------------------------------------------------------------------%
%
% Predicates and types for transaction processing
%

:- type odbc.data_source   == string.
:- type odbc.user_name     == string.
:- type odbc.password      == string.

    % A closure to be executed atomically.
    %
:- type odbc.transaction(T) ==  pred(T, odbc.state, odbc.state).
:- mode odbc.transaction ==  (pred(out, di, uo) is det).

:- type odbc.state.

    % odbc.transaction(Source, UserName, Password, Transaction, Result).
    %
    % Open a connection to `Source' using the given `UserName'
    % and `Password', perform `Transaction' within a transaction
    % using that connection, then close the connection.
    %
    % `Result' is `ok(Results) - Messages' if the transaction
    % succeeds or `error - Messages' if the transaction is aborted.
    % Whether updates are rolled back if the transaction aborts depends
    % on the database. MySQL will not roll back updates.
    %
    % If `Transaction' throws an exception, odbc.transaction will
    % attempt to roll back the transaction, and will then rethrow
    % the exception to the caller.
    %
:- pred odbc.transaction(data_source::in, user_name::in, password::in,
    transaction(T)::transaction, odbc.result(T)::out, io::di, io::uo) is det.

    % Abort the current transaction, returning the given error message.
    %
:- pred odbc.rollback(string::in, odbc.state::di, odbc.state::uo) is erroneous.

%-----------------------------------------------------------------------------%
%
% Predicates and types for execution of SQL statements
%

:- type odbc.row == list(odbc.attribute).

:- type odbc.attribute
    --->    null            % SQL NULL value
    ;       int(int)
    ;       string(string)
    ;       float(float)
    ;       time(string).   % Time string: "YYYY-MM-DD hh:mm:ss.mmm"

% The odbc.state arguments threaded through these predicates
% enforce the restriction that database activity can only occur
% within a transaction, since odbc.states are only available
% to the closure called by odbc.transaction/5.

    % Execute an SQL statement which doesn't return any results, such
    % as DELETE.
    %
:- pred odbc.execute(string::in, odbc.state::di, odbc.state::uo) is det.

    % Execute an SQL statement, returning a list of results in the
    % order they are returned from the database.
    %
:- pred odbc.solutions(string::in, list(odbc.row)::out,
    odbc.state::di, odbc.state::uo) is det.

    % Execute an SQL statement, applying the accumulator predicate
    % to each element of the result set as it is returned from
    % the database.
    %
:- pred odbc.aggregate(string, pred(odbc.row, T, T), T, T,
    odbc.state, odbc.state).
:- mode odbc.aggregate(in, pred(in, in, out) is det, in, out, di, uo) is det.
:- mode odbc.aggregate(in, pred(in, di, uo) is det, di, uo, di, uo) is det.

%-----------------------------------------------------------------------------%
%
% Predicates and types to get information about database tables
%

% This is very incomplete, it would be nice to be able to get
% information about the columns in a table and about privileges
% for tables and columns.

:- type odbc.source_desc
    --->    source_desc(
                odbc.data_source,   % name
                string              % description
            ).

:- type odbc.search_pattern
    --->    any                 % _ matches any single character.
    ;       pattern(string).    % Matches a sequence of characters.

    % Information about a table accessible by a transaction.
    %
:- type odbc.table_desc
    --->    table_desc(
                string,         % table qualifier
                string,         % table owner
                string,         % table name
                string,         % table type
                string,         % description
                list(odbc.attribute)   % data source specific columns
            ).

    % Get a list of all the available data sources.
    % Note that iODBC 2.12 doesn't implement this.
    %
:- pred odbc.data_sources(odbc.result(list(odbc.source_desc))::out,
    io::di, io::uo) is det.

    % odbc.tables(QualifierPattern, OwnerPattern, TableNamePattern, Result).
    %
    % Get a list of database tables matching the given description.
    % Note that wildcards are not allowed in the QualifierPattern.
    % This is fixed in ODBC 3.0.
    %
:- pred odbc.tables(odbc.search_pattern::in, odbc.search_pattern::in,
    odbc.search_pattern::in, list(odbc.table_desc)::out,
    odbc.state::di, odbc.state::uo) is det.

%-----------------------------------------------------------------------------%
%
% The following types are used to return status and error information from
% ODBC calls.
%

:- type odbc.result == pair(odbc.status, list(odbc.message)).

:- type odbc.status
    --->    ok
    ;       error.

    % The message list returned from a transaction contains all errors
    % and warnings reported by the driver during the transaction in
    % the order that they were reported.
    %
:- type odbc.result(T) == pair(odbc.status(T), list(odbc.message)).

:- type odbc.status(T)
    --->    ok(T)
    ;       error.

:- type odbc.message == pair(odbc.message_type, string).

:- type odbc.message_type
    --->    warning(odbc.warning)
    ;       error(odbc.error).

:- type odbc.warning
    --->    disconnect_error
    ;       fractional_truncation
    ;       general_warning
    ;       null_value_in_set_function
    ;       privilege_not_revoked
    ;       privilege_not_granted
    ;       string_data_truncated.

:- type odbc.error
    --->    connection_error(odbc.connection_error)
    ;       execution_error(odbc.execution_error)
    ;       feature_not_implemented
    ;       general_error
    ;       internal_error
    ;       timeout_expired
    ;       transaction_error(odbc.transaction_error)
    ;       user_requested_rollback.

:- type odbc.connection_error
    --->    unable_to_establish
    ;       invalid_authorization
    ;       connection_name_in_use
    ;       nonexistent_connection
    ;       connection_rejected_by_server
    ;       connection_failure
    ;       timeout_expired.

:- type odbc.execution_error
    --->    column_already_exists
    ;       column_not_found
    ;       division_by_zero
    ;       general_error
    ;       incorrect_count_field
    ;       incorrect_derived_table_arity
    ;       index_already_exists
    ;       index_not_found
    ;       integrity_constraint_violation
    ;       interval_field_overflow
    ;       invalid_cast_specification
    ;       invalid_date_time
    ;       invalid_escape
    ;       invalid_insert_value_list
    ;       invalid_schema_name
    ;       invalid_use_of_default_parameter
    ;       length_mismatch_in_string_data
    ;       no_default_for_column
    ;       overflow
    ;       range_error
    ;       restricted_data_type_violation
    ;       string_data_length_mismatch
    ;       string_data_truncated
    ;       syntax_error_or_access_violation
    ;       table_or_view_already_exists
    ;       table_or_view_not_found.

:- type odbc.transaction_error
    --->    rolled_back
    ;       still_active
    ;       serialization_failure
    ;       invalid_state.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module assoc_list.
:- import_module bool.
:- import_module exception.
:- import_module int.
:- import_module require.
:- import_module unit.
:- import_module univ.

:- pragma require_feature_set([conservative_gc]).

%-----------------------------------------------------------------------------%

    % We don't actually store anything in the odbc.state, since that
    % would make the exception handling more inconvenient and error-prone.
    % The odbc.state would have to be stored in a global anyway just
    % before calling longjmp.
    % All the data related to a transaction (ODBC handles, error messages)
    % is stored in the global variables defined below.
    %
:- type odbc.state == unit.

:- pragma foreign_decl("C", "

#include ""mercury_imp.h""
#include <stdio.h>
#include <stdlib.h>
#include <setjmp.h>
#include <assert.h>

    /*
    ** odbc.m allocates memory within may_call_mercury pragma C code,
    ** which is a bit dodgy in non-conservative GC grades.
    ** Allowing non-conservative GC grades would require a bit of fairly
    ** error-prone code to save/restore the heap pointer in the right
    ** places. When accurate garbage collection is implemented and a
    ** nicer way of allocating heap space from within C code is available,
    ** this should be revisited.
    ** Conservative garbage collection also makes restoring the state
    ** after an exception a bit simpler.
    */
#ifndef MR_CONSERVATIVE_GC
#error ""The OBDC interface requires conservative garbage collection. \\
        Use a compilation grade containing .gc.""
#endif /* ! MR_CONSERVATIVE_GC */

/*
** For use with iODBC.
*/
#ifdef MODBC_IODBC

    #include ""isql.h""
    #include ""isqlext.h""
    /* #include ""odbc_funcs.h"" */
    #include ""sqltypes.h""

    /*
    ** iODBC 2.12 doesn't define this, so define it to something
    ** harmless.
    */
    #ifndef SQL_NO_DATA
        #define SQL_NO_DATA SQL_NO_DATA_FOUND
    #endif

#endif /* MODBC_IODBC */

/*
** For use with unixODBC.
*/
#ifdef MODBC_UNIX

    #include ""sql.h""
    #include ""sqlext.h""
    #include ""sqltypes.h""

#endif /* MODBC_UNIX */

/*
** For interfacing directly with ODBC driver bypassing driver managers
** such as iODBC
*/
#ifdef MODBC_ODBC

    #include ""sql.h""
    #include ""sqlext.h""
    #include ""sqltypes.h""

    #ifndef SQL_NO_DATA
        #define SQL_NO_DATA SQL_NO_DATA_FOUND
    #endif

#endif /* MODBC_ODBC */

#ifdef MODBC_MS

    /*
    ** ODBC_VER set to 0x0250 means that this uses only ODBC 2.0
    ** functionality but compiles with the ODBC 3.0 header files.
    */
    #define ODBC_VER 0x0250

    /*
    ** The following is needed to allow the Microsoft headers to
    ** compile with GNU C under gnu-win32.
    */

    #if defined(__GNUC__) && !defined(__stdcall)
      #define __stdcall __attribute__((stdcall))
    #endif

    #if defined(__CYGWIN32__) && !defined(WIN32)
      #define WIN32 1
    #endif

    #include <windows.h>
    #include ""sql.h""
    #include ""sqlext.h""
    #include ""sqltypes.h""

#endif /* MODBC_MS */

/*
** Assert the implication: a => b
*/
#define MR_ASSERT_IMPLY(a,b)    MR_assert( !(a) || (b) )

/*
** All integers get converted to long by the driver, then to MR_Integer.
** All floats get converted to double by the driver, then to MR_Float.
*/
typedef long            MODBC_C_INT;
typedef double          MODBC_C_FLOAT;

/*
** Define some wrappers around setjmp and longjmp for exception
** handling. We need to use MR_setjmp and MR_longjmp because we'll
** be longjmping across C->Mercury calls, so we need to restore
** some state in runtime/engine.c.
** Beware: the Mercury registers must be valid when odbc_catch
** is called. odbc_throw will clobber the general-purpose registers
** r1, r2, etc.
*/
#define odbc_catch(longjmp_label)                   \
            MR_setjmp(&odbc_trans_jmp_buf, longjmp_label)

#define odbc_throw()    MR_longjmp(&odbc_trans_jmp_buf)

/*
** odbc_trans_jmp_buf stores information saved by odbc_catch (setjmp)
** to be used by odbc_throw (longjmp) when a database exception is
** found.
*/
extern MR_jmp_buf odbc_trans_jmp_buf;

/*
** odbc_env_handle is the output of SQLAllocEnv. SQLAllocEnv must
** be called before attempting to open any connections.
*/
extern SQLHENV odbc_env_handle;

/*
** The connection being acted on by the current transaction.
*/
extern SQLHDBC odbc_connection;

/*
** The last return code from an ODBC system call.
*/
extern SQLRETURN odbc_ret_code;

/*
** The list of accumulated warnings and errors for the transaction
** in reverse order.
*/
extern MR_Word odbc_message_list;

extern void
odbc_transaction_c_code(MR_Word type_info, SQLHDBC Connection,
    MR_Word Closure, MR_Word *Results, MR_Bool *GotMercuryException,
    MR_Word *Exception, MR_Integer *Status, MR_Word *Msgs);

extern MR_bool
odbc_check(SQLHENV, SQLHDBC, SQLHSTMT, SQLRETURN);

").

:- pragma foreign_code("C", "

MR_jmp_buf odbc_trans_jmp_buf;

SQLHENV  odbc_env_handle = SQL_NULL_HENV;

SQLHDBC  odbc_connection = SQL_NULL_HDBC;

SQLRETURN odbc_ret_code = SQL_SUCCESS;

MR_Word  odbc_message_list;

").

%-----------------------------------------------------------------------------%

transaction(Source, User, Password, Closure, Result, !IO) :-
    %
    % We could have separate open and close connection predicates in the
    % interface, but that would just be more effort for the programmer
    % for a very minor efficiency gain. The connection time will be
    % insignificant for even trivial queries.
    %
    open_connection(Source, User, Password, ConnectStatus - ConnectMessages,
        !IO),
    (
        ConnectStatus = ok(Connection),
        %
        % Do the transaction.
        %
        transaction_2(Connection, Closure, Data, GotMercuryException,
            Exception, Status, RevMessages, !IO),
        list.reverse(RevMessages, TransMessages),

        close_connection(Connection, CloseStatus - CloseMessages, !IO),
        %
        % Pass on any exception that was found while
        % processing the transaction.
        %
        (
            GotMercuryException = yes,
            rethrow(exception(Exception))
        ;
            GotMercuryException = no,
            list.condense([ConnectMessages, TransMessages, CloseMessages],
                Messages),
            ( odbc.ok(Status), CloseStatus = ok ->
                Result = ok(Data) - Messages
            ;
                Result = error - Messages
            )
        )
    ;
        ConnectStatus = error,
        Result = error - ConnectMessages
    ).

:- pred transaction_2(connection::in,
    pred(T, odbc.state, odbc.state)::in(pred(out, di, uo) is det),
    T::out, bool::out, univ::out, int::out, list(odbc.message)::out,
    io::di, io::uo) is det.

:- pragma foreign_proc("C",
    transaction_2(Connection::in, Closure::in(pred(out, di, uo) is det),
        Results::out, GotMercuryException::out, Exception::out,
        Status::out, Msgs::out, IO0::di, IO::uo),
    [promise_pure, may_call_mercury],
"
    /*
    ** The Mercury registers must be valid at the call to odbc_catch
    ** in odbc_transaction_c_code().
    ** odbc_transaction_c_code() may clobber the Mercury general-purpose
    ** registers r1, r2, ..., but that is OK, because this C code is
    ** declared as 'may_call_mercury', so the compiler assumes that it
    ** is allowed to clobber those registers.
    */
    MR_save_transient_registers();
    odbc_transaction_c_code(TypeInfo_for_T, Connection, Closure,
            &Results, &GotMercuryException, &Exception,
            &Status, &Msgs);
    MR_restore_transient_registers();
    IO = IO0;
").


:- pragma foreign_code("C",
"
void
odbc_transaction_c_code(MR_Word TypeInfo_for_T, SQLHDBC Connection,
        MR_Word Closure, MR_Word *Results, MR_Bool *GotMercuryException,
        MR_Word *Exception, MR_Integer *Status, MR_Word *Msgs)
{
    MR_Word DB0 = (MR_Word) 0;
    MR_Word DB = (MR_Word) 0;
    SQLRETURN rc;

    MR_restore_transient_registers();

    /*
    ** Mercury state to restore on rollback.
    */
    odbc_connection = Connection;
    odbc_message_list = MR_list_empty();

    /*
    ** Set up a location to jump to on a database exception.
    ** The Mercury registers must be valid here.
    */
    odbc_catch(transaction_error);

    /*
    ** Anything changed between the call to odbc_catch() and the call to
    ** MODBC_odbc__do_transaction() must be declared volatile.
    */

    MODBC_odbc__do_transaction(TypeInfo_for_T, Closure,
        GotMercuryException, Results, Exception);

    /*
    ** MR_longjmp() cannot be called after here.
    */

    if (*GotMercuryException == MR_NO) {

        rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_COMMIT);

        if (! odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT,
                rc)) {
            goto transaction_error;
        }

    } else {

        /*
        ** There was a Mercury exception -- abort the transaction.
        ** The return value of the call to SQLTransact() is
        ** ignored because the caller won't look at the result --
        ** it will just rethrow the exception.
        */
        MR_DEBUG(printf(
            ""Mercury exception in transaction: aborting\\n""));
        (void) SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);
    }

    *Status = SQL_SUCCESS;

    goto transaction_done;

transaction_error:

    /*
    ** Make the database rollback the transaction if it
    ** hasn't already.
    */

    *Status = odbc_ret_code;

    *GotMercuryException = 0;

    rc = SQLTransact(odbc_env_handle, odbc_connection, SQL_ROLLBACK);

    odbc_check(odbc_env_handle, odbc_connection, SQL_NULL_HSTMT, rc);

    /* Fall through. */

transaction_done:

    *Msgs = odbc_message_list;
    odbc_message_list = MR_list_empty();
    odbc_connection = SQL_NULL_HDBC;
    odbc_ret_code = SQL_SUCCESS;

    MR_save_transient_registers();
}
").

%-----------------------------------------------------------------------------%
%
% Call the transaction closure
%

:- pred do_transaction(transaction(T)::transaction, bool::out, T::out,
    univ::out, odbc.state::di, odbc.state::uo) is cc_multi.

:- pragma foreign_export("C",
    do_transaction(transaction, out, out, out, di, uo),
    "MODBC_odbc__do_transaction").

do_transaction(Closure, GotException, Results, Exception, State0, State) :-
    try((pred(TryResult::out) is det :-
        unsafe_promise_unique(State0, State1),
        Closure(Result, State1, ResultState),
        TryResult = Result - ResultState
    ), ExceptResult),
    (
        ExceptResult = succeeded(Results - State2),
        unsafe_promise_unique(State2, State),
        make_dummy_value(Exception),
        GotException = no
    ;
        ExceptResult = exception(Exception),
        make_dummy_value(Results),
        unsafe_promise_unique(State0, State),
        GotException = yes
    ).

    % Produce a value which is never looked at, for returning
    % discriminated unions to C.
    %
:- pred make_dummy_value(T::out) is det.
:- pragma foreign_proc("C",
    make_dummy_value(T::out),
    [promise_pure, will_not_call_mercury, thread_safe],
"
    T = 0;
").

%-----------------------------------------------------------------------------%

rollback(Error, !DB) :-
    odbc.add_message(error(user_requested_rollback) - Error, !DB),
    odbc.throw(!DB).

:- pred add_message(odbc.message::in, odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    add_message(Error::in, DB0::di, DB::uo),
    [promise_pure, will_not_call_mercury],
"
    odbc_message_list = MR_list_cons(Error, odbc_message_list);
    DB = DB0;
").

:- pred odbc.throw(odbc.state::di, odbc.state::uo) is erroneous.

:- pragma foreign_proc("C",
    odbc.throw(DB0::di, DB::uo),
    [promise_pure, will_not_call_mercury],
"
    odbc_ret_code = SQL_ERROR;
    odbc_throw();
    /* DB = DB0; (not reached) */
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Predicates and types to manage connections
%

    % A connection to a specific source.
    %
:- type odbc.connection.

    % Given the data source to connect to and a user name and password,
    % open a connection.
    %
:- pred open_connection(data_source::in, user_name::in,
    password::in, odbc.result(odbc.connection)::out, io::di, io::uo) is det.

    % Close the connection to the given data source.
    %
:- pred close_connection(odbc.connection::in, odbc.result::out,
    io::di, io::uo) is det.

%-----------------------------------------------------------------------------%

:- pragma foreign_type("C", odbc.connection, "SQLHDBC").

open_connection(Source, User, Password, Result - Messages, !IO) :-
    do_open_connection(Source, User, Password, Handle, ConnectStatus,
        RevMessages, !IO),
    list.reverse(RevMessages, Messages),
    ( odbc.ok(ConnectStatus) ->
        Result = ok(Handle)
    ;
        Result = error
    ).

%-----------------------------------------------------------------------------%

:- pred do_open_connection(string::in, string::in, string::in,
    odbc.connection::uo, int::out, list(odbc.message)::out, io::di, io::uo)
    is det.

:- pragma foreign_proc("C",
    do_open_connection(Source::in, User::in, Password::in, Handle::uo,
        Status::out, Messages::out, _IO0::di, _IO::uo),
    [promise_pure, may_call_mercury],
"
    SQLHDBC connect_handle;

    if (odbc_env_handle == SQL_NULL_HENV) {
        Status = SQLAllocEnv(&odbc_env_handle);
    } else {
        Status = SQL_SUCCESS;
    }

    MR_DEBUG(printf(""SQLAllocEnv status: %d\\n"", (int) Status));

    if (odbc_check(odbc_env_handle, SQL_NULL_HDBC,
            SQL_NULL_HSTMT, Status)) {

        Status = SQLAllocConnect(odbc_env_handle, &connect_handle);

        MR_DEBUG(printf(""SQLAllocConnect status: %d\\n"", (int) Status));

        if (odbc_check(odbc_env_handle, connect_handle,
                SQL_NULL_HSTMT, Status)) {
            /* Put the connection into manual commit mode */
            Status = SQLSetConnectOption(connect_handle,
                SQL_AUTOCOMMIT, SQL_AUTOCOMMIT_OFF);

            MR_DEBUG(printf(""manual commit status: %d\\n"",
                    (int) Status));

            odbc_check(odbc_env_handle, connect_handle,
                SQL_NULL_HSTMT, Status);
        }
    }

    Status = SQLConnect(connect_handle,
            (UCHAR *)Source, strlen(Source),
            (UCHAR *)User, strlen(User),
            (UCHAR *)Password, strlen(Password));

    MR_DEBUG(printf(""connect status: %d\\n"", (int) Status));

    odbc_check(odbc_env_handle, connect_handle, SQL_NULL_HSTMT, Status);

    Messages = odbc_message_list;
    odbc_message_list = MR_list_empty();

    Handle = connect_handle;
    odbc_connection = SQL_NULL_HDBC;
").

%-----------------------------------------------------------------------------%

close_connection(Connection, Result, !IO) :-
    do_close_connection(Connection, Status, RevMessages, !IO),
    list.reverse(RevMessages, Messages),
    ( Status = 0 ->
        Result = ok - Messages
    ;
        Result = error - Messages
    ).

:- pred do_close_connection(odbc.connection::in, int::out,
    list(odbc.message)::out, io::di, io::uo) is det.

:- pragma foreign_proc("C",
    do_close_connection(Handle::in, Status::out, Messages::out,
        _IO0::di, _IO::uo),
    [promise_pure, may_call_mercury],
"
    Status = SQLDisconnect(Handle);
    if (odbc_check(odbc_env_handle, Handle,
            SQL_NULL_HSTMT, Status)) {
        Status = SQLFreeConnect(Handle);
        odbc_check(odbc_env_handle, Handle,
            SQL_NULL_HSTMT, Status);
    }

    Messages = odbc_message_list;
    odbc_message_list = MR_list_empty();
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

odbc.execute(SQLString, !DB) :-
    some [!Statement] (
        odbc.alloc_statement(!:Statement, !DB),
        odbc.execute_statement(SQLString, !Statement, !DB),
        odbc.cleanup_statement_check_error(!.Statement, !DB)
    ).

odbc.solutions(SQLString, Results, !DB) :-
    % XXX optimize this when we have better support
    % for last call optimization.
    odbc.do_aggregate(odbc.execute_statement(SQLString), list.cons, [],
        Results0, !DB),
    list.reverse(Results0, Results).

odbc.aggregate(SQLString, Accumulator, !Acc, !DB) :-
    do_aggregate(odbc.execute_statement(SQLString), Accumulator, !Acc, !DB).

%-----------------------------------------------------------------------------%

:- pred do_aggregate(
    pred(odbc.statement, odbc.statement, odbc.state, odbc.state),
    pred(odbc.row, T, T), T, T, odbc.state, odbc.state).
:- mode do_aggregate(
    pred(di, uo, di, uo) is det,
    pred(in, in, out) is det, in, out, di, uo) is det.
:- mode do_aggregate(
    pred(di, uo, di, uo) is det,
    pred(in, di, uo) is det, di, uo, di, uo) is det.

do_aggregate(Execute, Accumulate, !Result, !DB) :-
    some [!Statement] (
        alloc_statement(!:Statement, !DB),
        Execute(!Statement, !DB),
        bind_columns(!Statement, !DB),
        get_rows(Accumulate, !Result, !Statement, !DB),
        cleanup_statement_check_error(!.Statement, !DB)
    ).

%-----------------------------------------------------------------------------%

    % Get the set of result rows from the statement.
    %
:- pred get_rows(pred(odbc.row, T, T), T, T, odbc.statement, odbc.statement,
    odbc.state, odbc.state).
:- mode get_rows(pred(in, in, out) is det, in, out, di, uo, di, uo) is det.
:- mode get_rows(pred(in, di, uo) is det, di, uo, di, uo, di, uo) is det.

get_rows(Accumulate, !Result, !Statement, !DB) :-
    get_number_of_columns(NumColumns, !Statement, !DB),
    get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB).

:- pred get_rows_2(int, pred(odbc.row, T, T), T, T,
    odbc.statement, odbc.statement, odbc.state, odbc.state).
:- mode get_rows_2(in, pred(in, in, out) is det, in, out, di, uo,
    di, uo) is det.
:- mode get_rows_2(in, pred(in, di, uo) is det, di, uo, di, uo,
    di, uo) is det.

get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB) :-
    % Try to fetch a new row.
    fetch_row(!Statement, Status, !DB),
    ( no_data(Status) ->
        true
    ;
        get_attributes(1, NumColumns, Row, !Statement, !DB),
        Accumulate(Row, !Result),
        get_rows_2(NumColumns, Accumulate, !Result, !Statement, !DB)
    ).

%-----------------------------------------------------------------------------%

    % Get the values from the current fetched row.
    %
:- pred get_attributes(int::in, int::in, list(odbc.attribute)::out,
    odbc.statement::di, odbc.statement::uo,
    odbc.state::di, odbc.state::uo) is det.

get_attributes(CurrCol, NumCols, Row, !Statement, !DB) :-
    ( CurrCol =< NumCols ->
        NextCol = CurrCol + 1,
        get_attribute(CurrCol, Attribute, !Statement, !DB),
        get_attributes(NextCol, NumCols, Row1, !Statement, !DB),
        Row = [Attribute | Row1]
    ;
        Row = []
    ).

%-----------------------------------------------------------------------------%

    % Get the value of a column in the current fetched row.
    %
:- pred get_attribute(int::in, odbc.attribute::out,
    odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
    is det.

get_attribute(NumColumn, Value, !Statement, !DB) :-
    get_data(NumColumn, Int, Float, String, TypeInt, !Statement, !DB),
    int_to_attribute_type(TypeInt, Type),
    (
        Type = null,
        Value = null
    ;
        Type = string,
        Value = string(String)
    ;
        Type = time,
        Value = time(String)
    ;
        Type = int,
        Value = int(Int)
    ;
        Type = float,
        Value = float(Float)
    ).

%-----------------------------------------------------------------------------%

:- type odbc.attribute_type
    --->    int
    ;       float
    ;       time
    ;       string
    ;       null.

:- pred int_to_attribute_type(int::in, odbc.attribute_type::out) is det.

int_to_attribute_type(Int, Type) :-
    ( int_to_attribute_type_2(Int, Type1) ->
        Type = Type1
    ;
        error("odbc.int_to_attribute_type: invalid type")
    ).

    % Keep this in sync with the C enum MODBC_AttrType below.
    %
:- pred int_to_attribute_type_2(int::in, odbc.attribute_type::out) is semidet.

int_to_attribute_type_2(0, int).
int_to_attribute_type_2(1, float).
int_to_attribute_type_2(2, time).
int_to_attribute_type_2(3, string).
int_to_attribute_type_2(4, string).
int_to_attribute_type_2(5, null).

%-----------------------------------------------------------------------------%

:- type odbc.statement.

:- pragma foreign_type("C", odbc.statement, "MODBC_Statement *",
    [can_pass_as_mercury_type]).

:- pragma foreign_decl("C", "

/*
** Notes on memory allocation:
**
** C data structures (MODBC_Statement and MODBC_Column) are allocated
** using MR_GC_malloc/MR_GC_free.
**
** MODBC_Statement contains a statement handle which must be freed
** using SQLFreeStmt.
**
** Variable length data types are collected in chunks allocated on
** the Mercury heap using MR_incr_hp_atomic. The chunks are then
** condensed into memory allocated on the Mercury heap using
** string.append_list.
** XXX this may need revisiting when accurate garbage collection
** is implemented to make sure the collector can see the data when
** it is stored within a MODBC_Column.
**
** Other data types have a buffer which is allocated once using
** MR_GC_malloc.
*/

/*
** If the driver can't work out how much data is in a blob in advance,
** get the data in chunks. The chunk size is fairly arbitrary.
** MODBC_CHUNK_SIZE must be a multiple of sizeof(MR_Word).
*/
#define MODBC_CHUNK_WORDS   1024
#define MODBC_CHUNK_SIZE    (MODBC_CHUNK_WORDS * sizeof(MR_Word))

typedef enum {
    MODBC_INT        = 0,   /* Word-sized Integer */
    MODBC_FLOAT      = 1,   /* Mercury Float */
    MODBC_TIME       = 2,   /* time and/or date converted to a string */
    MODBC_STRING     = 3,   /* string, or type converted to a string */
    MODBC_VAR_STRING = 4,   /* string with no maximum length */
    MODBC_NULL       = 5
} MODBC_AttrType;

typedef enum { MODBC_BIND_COL, MODBC_GET_DATA } MODBC_BindType;

/*
** Information about a column in a result set.
*/
typedef struct {
        size_t      size;       /* size of allocated buffer */
        MODBC_AttrType  attr_type;
        SWORD       sql_type;   /*
                                ** the actual type,
                                ** e.g. SQL_LONG_VAR_CHAR
                                */
        SWORD       conversion_type;/*
                                    ** the type the data is
                                    ** being converted into,
                                    ** e.g SQL_C_CHAR
                                    */
        SDWORD      value_info; /*
                                ** size of returned data,
                                ** or SQL_NULL_DATA
                                */
        MR_Word         *data;
} MODBC_Column;


/*
** Information about a result set.
*/
typedef struct {
        SQLHSTMT    stat_handle;    /* statement handle   */
        int         num_columns;    /* columns per row    */
        MODBC_Column    *row;       /*
                                    ** array of columns in
                                    ** the current row
                                    */
        int         num_rows;       /* number of fetched rows */
        MODBC_BindType  binding_type;   /*
                                        ** are we using SQL_BIND_COL
                                        ** or SQL_GET_DATA
                                        */
} MODBC_Statement;

extern SQLRETURN
odbc_do_cleanup_statement(MODBC_Statement *statement);

extern size_t
odbc_sql_type_to_size(SWORD sql_type, UDWORD cbColDef, SWORD ibScale,
    SWORD fNullable);

extern MODBC_AttrType
odbc_sql_type_to_attribute_type(SWORD sql_type);

extern SWORD
odbc_attribute_type_to_sql_c_type(MODBC_AttrType AttrType);

extern MR_bool
odbc_is_variable_length_sql_type(SWORD);

extern void
odbc_do_get_data(MODBC_Statement *statement, int column_id);

extern void
odbc_get_data_in_chunks(MODBC_Statement *statement, int column_id);

extern void
odbc_get_data_in_one_go(MODBC_Statement *statement, int column_id);

").

%-----------------------------------------------------------------------------%

:- pred alloc_statement(odbc.statement::uo,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    alloc_statement(Statement::uo, DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"
    SQLRETURN rc;

    /* Doing manual deallocation of the statement object. */
    Statement = MR_GC_NEW(MODBC_Statement);

    Statement->num_columns = 0;
    Statement->row = NULL;
    Statement->num_rows = 0;
    Statement->stat_handle = SQL_NULL_HSTMT;

    rc = SQLAllocStmt(odbc_connection, &(Statement->stat_handle));
    if (! odbc_check(odbc_env_handle, odbc_connection,
            Statement->stat_handle, rc))
    {
        odbc_throw();
        /* not reached */
    }

    MR_assert(Statement->stat_handle != SQL_NULL_HSTMT);
    DB = DB0;
").

%-----------------------------------------------------------------------------%

:- pred execute_statement(string::in, odbc.statement::di, odbc.statement::uo,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    execute_statement(SQLString::in, Statement0::di, Statement::uo,
        DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"
    SQLRETURN rc;
    SQLHSTMT stat_handle;

    Statement = Statement0;

    stat_handle = Statement->stat_handle;

    MR_DEBUG(printf(""executing SQL string: %s\\n"", SQLString));

    rc = SQLPrepare(stat_handle, (SQLCHAR *)SQLString, strlen(SQLString));

    if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {

        /*
        ** We don't check the return status of this because
        ** the programmer is likely to be more interested
        ** in the earlier error.
        */
        odbc_do_cleanup_statement(Statement);
        odbc_throw();
        /* not reached */
    }

    rc = SQLExecute(stat_handle);
    if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
        odbc_do_cleanup_statement(Statement);
        odbc_throw();
        /* not reached */
    }

    MR_DEBUG(printf(""execution succeeded\\n""));
    DB = DB0;
").

%-----------------------------------------------------------------------------%

    % There are two methods to get data back from an ODBC application.
    %
    % One involves binding a buffer to each column using SQLBindCol,
    % then calling SQLFetch repeatedly to read rows into the buffers.
    % The problem with this method is it doesn't work with variable
    % length data, since if the data doesn't fit into the allocated
    % buffer it gets truncated and there's no way to have a second
    % try with a larger buffer.
    %
    % The other method is to not bind any columns. Instead, after
    % SQLFetch is called to update the cursor, SQLGetData is used
    % on each column to get the data. SQLGetData can be called repeatedly
    % to get all the data if it doesn't fit in the buffer. The problem
    % with this method is that it requires an extra ODBC function call
    % for each attribute received, which may have a significant impact
    % on performance if the database is being accessed over a network.
    %
    % Hybrid methods are also possible if all the variable length columns
    % come after the fixed length columns in the result set, but that
    % is probably overkill. (SQLGetData can only be used on columns
    % after those bound using SQLBindCol).
    %
    % The first method is used if there are no variable length columns,
    % otherwise the second method is used.
    %
:- pred bind_columns(odbc.statement::di, odbc.statement::uo,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    bind_columns(Statement0::di, Statement::uo, DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"
    int             column_no;
    SQLSMALLINT     num_columns;
    MODBC_Column    *column;
    SQLRETURN       rc;
    SQLHSTMT        stat_handle;

    Statement = Statement0;
    stat_handle = Statement->stat_handle;

    /*
    ** Retrieve the number of columns of the statement.
    */
    rc = SQLNumResultCols(stat_handle, &num_columns);
    if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle, rc)) {
        odbc_do_cleanup_statement(Statement);
        odbc_throw();
        /* not reached */
    }
    Statement->num_columns = num_columns;

    /*
    ** Allocate an array containing the info for each column.
    ** The extra column is because ODBC counts columns starting from 1.
    */
    Statement->row = MR_GC_NEW_ARRAY(MODBC_Column, num_columns + 1);

    /*
    ** Use SQLBindCol unless there are columns with no set maximum length.
    */
    Statement->binding_type = MODBC_BIND_COL;

    /*
    ** Get information about the result set columns.
    ** ODBC counts columns from 1.
    */
    for (column_no = 1; column_no <= Statement->num_columns; column_no++) {

        char        col_name[1];    /* Not looked at */
        SWORD       col_name_len;
        SWORD       col_type;
        UDWORD      pcbColDef;
        SWORD       pibScale;
        SWORD       pfNullable;

        column = &(Statement->row[column_no]);
        column->size = 0;
        column->data = NULL;

        /*
        ** Retrieve the C type of the column.
        ** (SQL type mapped to a conversion type).
        ** Create an attribute object with room to store the
        ** attribute value.
        */

        rc = SQLDescribeCol(stat_handle, column_no,
                (UCHAR *) col_name, sizeof(col_name),
                &col_name_len, &col_type, &pcbColDef,
                &pibScale, &pfNullable);

        /*
        ** SQL_SUCCESS_WITH_INFO means there wasn't
        ** enough space for the column name, but we
        ** aren't collecting the column name anyway.
        */
        if (rc != SQL_SUCCESS_WITH_INFO &&
                ! odbc_check(odbc_env_handle, odbc_connection,
                    stat_handle, rc))
        {
            odbc_do_cleanup_statement(Statement);
            odbc_throw();
            /* not reached */
        }

        column->sql_type = col_type;
        column->size = odbc_sql_type_to_size(col_type, pcbColDef,
                pibScale, pfNullable);

        column->attr_type = odbc_sql_type_to_attribute_type(col_type);

        /* Request a conversion into one of the supported types. */
        column->conversion_type =
            odbc_attribute_type_to_sql_c_type(column->attr_type);

        MR_DEBUG(printf(""Column %i: size %i - sql_type %i - attr_type %i - conversion_type %i\\n"",
            column_no, column->size, column->sql_type,
            column->attr_type, column->conversion_type));

        if (odbc_is_variable_length_sql_type(col_type)) {
            Statement->binding_type = MODBC_GET_DATA;
        } else {
            /*
            ** Do the buffer allocation once for columns which
            ** have a fixed maximum length.
            */
            column->data = MR_GC_malloc(column->size);
        }

    } /* for */

    if (Statement->binding_type == MODBC_BIND_COL) {

        for (column_no = 1; column_no <= Statement->num_columns; column_no++) {

            MR_DEBUG(printf(""Binding column %d/%d\\n"",
                    column_no, Statement->num_columns));
            column = &(Statement->row[column_no]);

            rc = SQLBindCol(stat_handle, column_no,
                    column->conversion_type,
                    (SQLPOINTER) column->data,
                    column->size, &(column->value_info));
            if (! odbc_check(odbc_env_handle, odbc_connection, stat_handle,
                    rc)) {
                odbc_do_cleanup_statement(Statement);
                odbc_throw();
                /* not reached */
            }
        }
    }
    DB = DB0;
").

%-----------------------------------------------------------------------------%

    % Fetch the next row of the current statement.
    %
:- pred fetch_row(odbc.statement::di, odbc.statement::uo, int::out,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    fetch_row(Statement0::di, Statement::uo, Status::out, DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"
    Statement = Statement0;
    MR_assert(Statement != NULL);

    if (Statement->num_rows == 0 ) {
        MR_DEBUG(printf(""Fetching rows...\\n""));
    }

    /* Fetching new row */
    Status = SQLFetch(Statement->stat_handle);

    if (Status != SQL_NO_DATA_FOUND &&
            ! odbc_check(odbc_env_handle, odbc_connection,
                Statement->stat_handle, Status))
    {
        odbc_do_cleanup_statement(Statement);
        odbc_throw();
        /* not reached */
    }

    /* Update number of rows fetched */
    if (Status == SQL_SUCCESS) {
        Statement->num_rows++;
    }

    if (Status == SQL_NO_DATA_FOUND) {
        MR_DEBUG(printf(""Fetched %d rows\\n"", Statement->num_rows));
    }

    DB = DB0;
").

%-----------------------------------------------------------------------------%

:- pred get_number_of_columns(int::out,
    odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
    is det.

:- pragma foreign_proc("C",
    get_number_of_columns(NumColumns::out, Statement0::di, Statement::uo,
        DB0::di, DB::uo),
    [promise_pure, will_not_call_mercury],
"
    Statement = Statement0;
    MR_assert(Statement != NULL);
    NumColumns = Statement->num_columns;
    DB = DB0;
").

%-----------------------------------------------------------------------------%

:- pred get_data(int::in, int::out, float::out, string::out, int::out,
    odbc.statement::di, odbc.statement::uo, odbc.state::di, odbc.state::uo)
    is det.

:- pragma foreign_proc("C",
    get_data(Column::in, Int::out, Flt::out, Str::out, Type::out,
        Statement0::di, Statement::uo, DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"
    MODBC_Column    *col;
    SQLRETURN       rc;
    SDWORD          column_info;

    Statement = Statement0;

    MR_assert(Statement != NULL);
    MR_assert(Statement->row != NULL);

    MR_DEBUG(printf(""Getting column %i\\n"", (int) Column));

    if (Statement->binding_type == MODBC_GET_DATA) {

        /* Slurp up the data for this column. */
        odbc_do_get_data(Statement, Column);
    }

    col = &(Statement->row[Column]);

    if (col->value_info == SQL_NULL_DATA) {
        Type = MODBC_NULL;
    } else {
        Type = col->attr_type;
    }

    switch ((int) Type) {

        case MODBC_NULL:
            break;

        case MODBC_INT: {

            MODBC_C_INT data = *(MODBC_C_INT *)(col->data);

            Int = (MR_Integer) data;

            MR_DEBUG(printf(""got integer %ld\\n"", (long) Int));

                /* Check for overflow */
            if (Int != data) {
                MR_Word overflow_message;
                MODBC_overflow_message(&overflow_message);
                odbc_message_list =
                    MR_list_cons(overflow_message,
                        odbc_message_list);
                odbc_do_cleanup_statement(Statement);
                odbc_throw();
            }
            break;
        }

        case MODBC_FLOAT:

            Flt = (MR_Float) *(MODBC_C_FLOAT *)(col->data);

            MR_DEBUG(printf(""got float %f\\n"", Flt));

            break;

        case MODBC_STRING:
        case MODBC_TIME:

            MR_assert(col->data);
            MR_make_aligned_string_copy(Str, (char *) col->data);

            MR_DEBUG(printf(""got string %s\\n"", (char *) Str));

            break;

        case MODBC_VAR_STRING:
            /*
            ** The data was allocated on the Mercury heap,
            ** get it then kill the pointer so it can be GC'ed.
            */
            MR_make_aligned_string(Str, (char *) col->data);

            MR_DEBUG(printf(""got var string %s\\n"", (char *) col->data));

            col->data = NULL;

            /* As far as Mercury is concerned it's an ordinary string */
            Type = MODBC_STRING;
            break;

        default:
            MR_external_fatal_error(\"odbc.m\",
                \"invalid attribute type in odbc.get_data\");
            break;
    } /* end switch (Type) */

    DB = DB0;
").

:- pragma foreign_code("C", "

void
odbc_do_get_data(MODBC_Statement *statement, int column_id)
{
    MODBC_Column    *column;
    SQLRETURN       rc;
    SDWORD          column_info;
    char            dummy_buffer[1]; /*
                                     ** Room for the NUL termination
                                     ** byte and nothing else.
                                     */

    column = &(statement->row[column_id]);
    if (column->attr_type == MODBC_VAR_STRING) {

        /* Just get the length first time through. */
        rc = SQLGetData(statement->stat_handle, column_id,
                column->conversion_type, dummy_buffer,
                1, &(column->value_info));

        /*
        ** SQL_SUCCESS_WITH_INFO is expected here, since
        ** we didn't allocate any space for the data, so
        ** don't collect the ""data truncated"" message.
        */
        if (rc != SQL_SUCCESS_WITH_INFO &&
                ! odbc_check(odbc_env_handle,
                    odbc_connection,
                    statement->stat_handle, rc))
        {
            odbc_do_cleanup_statement(statement);
            odbc_throw();
        }

        if (column->value_info == SQL_NULL_DATA) {
            /*
            ** The column is NULL, so there is no data to get.
            */
            return;
        } else if (column->value_info == SQL_NO_TOTAL) {
            /*
            ** The driver couldn't work out the length
            ** in advance, so get the data in chunks of
            ** some arbitrary size, and append the chunks
            ** together.
            ** This method must be used with MODBC_IODBC,
            ** since iODBC-2.12 uses a different interpretation
            ** of the ODBC standard to Microsoft, for which
            ** the length returned by the first call to SQLGetData
            ** above is the minimum of the buffer length and the
            ** length of the available data, rather than the
            ** total length of data available.
            */
            odbc_get_data_in_chunks(statement, column_id);
        } else {
            MR_Word data;

            /*
            ** column->value_info == length of data
            */
            column->size = column->value_info + 1;
            MR_incr_hp_atomic(data,
                (column->size + sizeof(MR_Word)) / sizeof(MR_Word));
            column->data = (MR_Word *) data;
            odbc_get_data_in_one_go(statement, column_id);
        }
    } else {
        /*
        ** It's a fixed length column, so we can
        ** get the lot in one go.
        */
        odbc_get_data_in_one_go(statement, column_id);
    }
}

void
odbc_get_data_in_one_go(MODBC_Statement *statement, int column_id)
{
    MODBC_Column    *col;
    SQLRETURN       rc;

    MR_DEBUG(printf(""getting column %i in one go\\n"", column_id));

    col = &(statement->row[column_id]);

    rc = SQLGetData(statement->stat_handle, column_id,
        col->conversion_type,
        (SQLPOINTER) col->data, col->size, &(col->value_info));

    if (! odbc_check(odbc_env_handle, odbc_connection,
        statement->stat_handle, rc))
    {
        odbc_do_cleanup_statement(statement);
        odbc_throw();
    }
}

void
odbc_get_data_in_chunks(MODBC_Statement *statement, int column_id)
{
    MODBC_Column    *col;
    SQLRETURN       rc;
    MR_Word         this_bit;
    MR_Word         chunk_list;
    MR_String       result;

    MR_DEBUG(printf(""getting column %i in chunks\\n"", column_id));

    chunk_list = MR_list_empty();

    col = &(statement->row[column_id]);

    rc = SQL_SUCCESS_WITH_INFO;

    MR_incr_hp_atomic(this_bit, MODBC_CHUNK_WORDS);

        /*
        ** Keep collecting chunks until we run out.
        */
    while (rc == SQL_SUCCESS_WITH_INFO) {

        rc = SQLGetData(statement->stat_handle, column_id,
                col->conversion_type, (SQLPOINTER) this_bit,
                MODBC_CHUNK_SIZE - 1, &(col->value_info));

        if (rc == SQL_NO_DATA_FOUND) {
            break;
        }

        if (rc != SQL_SUCCESS_WITH_INFO &&
                ! odbc_check(odbc_env_handle, odbc_connection,
                    statement->stat_handle, rc))
        {
            odbc_do_cleanup_statement(statement);
            odbc_throw();
        }

        chunk_list = MR_list_cons(this_bit, chunk_list);
        MR_incr_hp_atomic(this_bit, MODBC_CHUNK_WORDS);
    }

    MODBC_odbc_condense_chunks(chunk_list, &result);
    col->data = (MR_Word *) result;
}
").

:- pragma foreign_export("C", overflow_message(out), "MODBC_overflow_message").
:- pred overflow_message(odbc.message::out) is det.

overflow_message(Error) :-
    ErrorType = error(execution_error(overflow)),
    ErrorMsg  = "[Mercury][odbc.m]Integer overflow detected in result set." ++
                "  Integers must be no larger than a word.",
    Error = ErrorType - ErrorMsg.

:- pragma foreign_export("C", condense_chunks(in, out),
    "MODBC_odbc_condense_chunks").
:- pred condense_chunks(list(string)::in, string::out) is det.

condense_chunks(RevChunks, String) :-
    list.reverse(RevChunks, Chunks),
    string.append_list(Chunks, String).

%-----------------------------------------------------------------------------%

:- pred cleanup_statement_check_error(odbc.statement::di,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    cleanup_statement_check_error(Statement::di, DB0::di, DB::uo),
    [promise_pure, may_call_mercury],
"{
    MODBC_Statement *statement;
    SQLRETURN rc;

    statement = (MODBC_Statement *) Statement;

    rc = odbc_do_cleanup_statement(statement);
    if (! odbc_check(odbc_env_handle, odbc_connection,
            SQL_NULL_HSTMT, rc))
    {
        odbc_throw();
    }
    DB = DB0;
}").

:- pragma foreign_code("C", "

SQLRETURN
odbc_do_cleanup_statement(MODBC_Statement *statement)
{
    int i;
    SQLRETURN rc;

    if (statement != NULL) {
        MR_DEBUG(printf(""cleaning up statement\\n""));
        if (statement->row != NULL) {
            for (i = 1; i <= statement->num_columns; i++) {
                /*
                ** Variable length types are allocated directly
                ** onto the Mercury heap, so don't free them here.
                */
                if (!odbc_is_variable_length_sql_type(
                        statement->row[i].sql_type))
                {
                    MR_GC_free(statement->row[i].data);
                }
            }
            MR_GC_free(statement->row);
        }
        rc = SQLFreeStmt(statement->stat_handle, SQL_DROP);
        MR_GC_free(statement);
        return rc;
    } else {
        return SQL_SUCCESS;
    }
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- pragma foreign_code("C", "

/*
**  Map an ODBC SQL type to a supported attribute type.
**  Currently, supported attribute types are minimal,
**  but this function will allow us to ask ODBC to make
**  conversion from SQL types to supported types.
**  Binary types are currently converted to strings.
*/
MODBC_AttrType
odbc_sql_type_to_attribute_type(SWORD sql_type)
{
    switch (sql_type) {
        case SQL_BIGINT:        return MODBC_STRING;
        case SQL_BINARY:        return MODBC_STRING;
        case SQL_BIT:           return MODBC_STRING;
        case SQL_CHAR:          return MODBC_STRING;
        case SQL_DATE:          return MODBC_TIME;
        case SQL_DECIMAL:       return MODBC_STRING; /*?*/
        case SQL_DOUBLE:        return MODBC_FLOAT;
        case SQL_FLOAT:         return MODBC_FLOAT;
        case SQL_INTEGER:       return MODBC_INT;

    /*
    ** For MySQL, SQLGetData does not work correctly (multiple calls
    ** return the same data, not successive pieces of the data).
    ** It seems to be guaranteed to be able to find the maximum length
    ** of the data in the column, so we treat those columns as if
    ** they were fixed length.
    */
#ifdef MODBC_MYSQL
        case SQL_LONGVARBINARY:     return MODBC_STRING;
        case SQL_LONGVARCHAR:       return MODBC_STRING;
#else /* ! MODBC_MYSQL */
        case SQL_LONGVARBINARY:     return MODBC_VAR_STRING;
        case SQL_LONGVARCHAR:       return MODBC_VAR_STRING;
#endif /* ! MODBC_MYSQL */

        case SQL_NUMERIC:       return MODBC_STRING;
        case SQL_REAL:          return MODBC_FLOAT;
        case SQL_SMALLINT:      return MODBC_INT;
        case SQL_TIME:          return MODBC_TIME;
        case SQL_TIMESTAMP:     return MODBC_TIME;
        case SQL_TINYINT:       return MODBC_INT;
        case SQL_VARBINARY:     return MODBC_STRING;
        case SQL_VARCHAR:       return MODBC_STRING;
        default:
            MR_external_fatal_error(\"odbc.m\",
                \"sql_type_to_attribute_type: unknown type\");
    }
}

/*
** Return the SQL_C type corresponding to a supported attribute type.
*/
SWORD
odbc_attribute_type_to_sql_c_type(MODBC_AttrType AttrType)
{
    switch (AttrType) {
        case MODBC_FLOAT:       return SQL_C_DOUBLE;
        case MODBC_INT:         return SQL_C_SLONG;
        case MODBC_TIME:        return SQL_C_CHAR;
        case MODBC_STRING:      return SQL_C_CHAR;
        case MODBC_VAR_STRING:      return SQL_C_CHAR;
        default:
            /* Unsupported MODBC_xxx type */
            MR_external_fatal_error(\"odbc.m\",
                \"attribute_type_to_sql_c_type: unknown type\");
    }
}


/*
** Does the data have no maximum length?
** Note: the implementation of SQLGetData for MySQL does not follow the same
** standard as SQL Server, but from examination of the sources SQLDescribeCol
** seems guaranteed to find the maximum length of a result column containing
** variable length data. SQL_NO_TOTAL, which should be returned if the length
** cannot be determined, is not defined by the iODBC header files.
*/
MR_bool
odbc_is_variable_length_sql_type(SWORD sql_type) {

#ifdef MODBC_MYSQL

    return MR_FALSE;

#else /* ! MODBC_MYSQL */

    return (
        sql_type == SQL_LONGVARBINARY ||
        sql_type == SQL_LONGVARCHAR
    );

#endif /* !MODBC_MYSQL */
}

/*
** This function computes to total number of bytes needed
** to store an attribute value, returning -1 if there is no
** maximum size.
** [SqlType] is the ODBC SQL type of the column
** [cbColDef] is the size returned by SQLDescribeCol
** [ibScaler] is the scale returned by SQLDescribeCol
** [fNullable] is whether the column can be NULL
*/
size_t
odbc_sql_type_to_size(SWORD sql_type, UDWORD cbColDef,
        SWORD ibScale, SWORD fNullable)
{
    switch (sql_type)
    {
        /*
        ** 64-bit signed int converted to SQL_C_CHAR
        */
        case SQL_BIGINT:
            return 1 + cbColDef + 1;  /* +1 for sign, +1 for NUL */

        /*
        ** Binary data converted to SQL_C_CHAR
        ** Each byte is converted to 2-digit Hex
        */
        case SQL_BINARY:
            return cbColDef * 2 + 1;  /* +1 for NUL */

        /*
        ** Bit converted to SQL_C_CHAR
        */
        case SQL_BIT:
            return cbColDef + 1;  /* +1 for NUL */

        /*
        ** Fixed char to SQL_C_CHAR
        */
        case SQL_CHAR:
            return cbColDef + 1;  /* 1 for NUL */

        /*
        ** Date YYYY-MM-DD converted to SQL_C_CHAR
        */
        case SQL_DATE:
            return cbColDef + 1;  /* 1 for NUL */

        /*
        ** Signed decimal ddd.dd converted to SQL_C_CHAR
        */
        case SQL_DECIMAL:
            return 1 + cbColDef + 1 + ibScale + 1;
            /* 1 for sign 1, 1 for decimal point, 1, for NUL */

        /*
        ** 32-bit float converted to MODBC_SQL_C_FLOAT
        */
        case SQL_DOUBLE:
            return sizeof(MODBC_C_FLOAT);

        /*
        ** 32-bit float converted to MODBC_SQL_C_FLOAT
        */
        case SQL_FLOAT:
            return sizeof(MODBC_C_FLOAT);

        /*
        ** 32-bit integer converted to SQL_C_SLONG
        */
        case SQL_INTEGER:
            return sizeof(MODBC_C_INT);

        /*
        ** Any length binary convert to SQL_C_CHAR
        ** For MySQL, there are no column types for
        ** which the maximum length cannot be determined before
        ** starting to fetch data, hence the #ifdefs below.
        */
        case SQL_LONGVARBINARY:
#ifdef MODBC_MYSQL
            return cbColDef * 2 + 1;    /* 1 for NUL */
#else /* !MODBC_MYSQL */
            return -1;
#endif /* !MODBC_MYSQL */

        /*
        ** Any length char convert to SQL_C_CHAR
        ** For MySQL, there are no column types for
        ** which the maximum length cannot be determined before
        ** starting to fetch data, hence the #ifdefs below.
        */
        case SQL_LONGVARCHAR:
#ifdef MODBC_MYSQL
            return cbColDef + 1;    /* 1 for NUL */
#else /* !MODBC_MYSQL */
            return -1;
#endif /* !MODBC_MYSQL */

        /*
        ** Signed numeric ddd.dd converted to SQL_C_CHAR
        */
        case SQL_NUMERIC:
            return 1 + cbColDef + 1 + ibScale + 1;
                    /* 1 for NUL */

        /*
        ** 32-bit float converted to MODBC_SQL_C_FLOAT
        */
        case SQL_REAL:
            return sizeof(MODBC_C_FLOAT);

        /*
        ** 16-bit integer converted to SQL_C_SLONG
        */
        case SQL_SMALLINT:
            return sizeof(MODBC_C_INT);

        /*
        ** Time hh:mm:ss converted to SQL_C_CHAR
        */
        case SQL_TIME:
            return cbColDef + 1;  /* 1 for NUL */

        /*
        ** Time YYYY-MM-DD hh:mm:ss converted to SQL_C_CHAR
        */
        case SQL_TIMESTAMP:
            return cbColDef + 1;  /* 1 for NUL */

        /*
        ** 8-bit integer converted to MODBC_SQL_INT
        */
        case SQL_TINYINT:
            return sizeof(MODBC_C_INT);

        /*
        ** Binary data converted to SQL_C_CHAR
        ** Each byte is converted to 2-digit Hex
        */
        case SQL_VARBINARY:
            return cbColDef * 2 + 1;  /* 1 for NUL */

        /*
        ** Fixed char to SQL_C_CHAR
        */
        case SQL_VARCHAR:
            return cbColDef + 1;  /* 1 for NUL */

        default:
            MR_external_fatal_error(\"odbc.m\",
                \"sql_type_to_size: unknown type\");
    }
}
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Catalog functions
%

odbc.data_sources(MaybeSources - Messages, !IO) :-
    sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages, !IO),
    ( odbc.ok(Status) ->
        list.reverse(RevMessages, Messages),
        list.reverse(RevSourceNames, SourceNames),
        list.reverse(RevDescs, Descs),
        assoc_list.from_corresponding_lists(SourceNames, Descs, SourceAL),
        MakeSource = (pred(Pair::in, SourceDesc::out) is det :-
            Pair = SourceName - Desc,
            SourceDesc = odbc.source_desc(SourceName, Desc)
        ),
        list.map(MakeSource, SourceAL, Sources),
        MaybeSources = ok(Sources)
    ; odbc.no_data(Status) ->
        % iODBC 2.12 doesn't implement this function.
        Messages = [
            error(feature_not_implemented) -
            "[Mercury][odbc.m]SQLDataSources not implemented."
        ],
        MaybeSources = error
    ;
        list.reverse(RevMessages, Messages),
        MaybeSources = error
    ).

:- pred sql_data_sources(list(string)::out, list(string)::out, int::out,
    list(odbc.message)::out, io::di, io::uo) is det.

:- pragma foreign_proc("C",
    sql_data_sources(SourceNames::out, SourceDescs::out, Status::out,
        Messages::out, IO0::di, IO::uo),
    [promise_pure, may_call_mercury],
"
    Status = odbc_do_get_data_sources(&SourceNames, &SourceDescs, &Messages);
    IO = IO0;
").

:- pragma foreign_decl("C", "

SQLRETURN
odbc_do_get_data_sources(MR_Word *SourceNames, MR_Word *SourceDescs,
        MR_Word *Messages);
").

:- pragma foreign_code("C", "

SQLRETURN
odbc_do_get_data_sources(MR_Word *SourceNames, MR_Word *SourceDescs,
        MR_Word *Messages)
{
    SQLCHAR dsn[SQL_MAX_DSN_LENGTH];
    SQLCHAR desc[128];
    /*
    ** Arbitrary size, only needs to hold a
    ** descriptive string like ""SQL Server"".
    */
    MR_String new_dsn;
    MR_String new_desc;
    SWORD dsn_len;
    SWORD desc_len;
    SQLRETURN rc;

    odbc_message_list = MR_list_empty();
    *SourceNames = MR_list_empty();
    *SourceDescs = MR_list_empty();

    if (odbc_env_handle == SQL_NULL_HENV) {
        rc = SQLAllocEnv(&odbc_env_handle);
    } else {
        rc = SQL_SUCCESS;
    }

    MR_DEBUG(printf(""SQLAllocEnv status: %d\\n"", rc));

    if (odbc_check(odbc_env_handle, SQL_NULL_HDBC, SQL_NULL_HSTMT, rc)) {

        rc = SQLDataSources(odbc_env_handle, SQL_FETCH_FIRST,
                dsn, SQL_MAX_DSN_LENGTH - 1,
                &dsn_len, desc, sizeof(desc), &desc_len);

            /*
            ** The documentation varies on whether the driver
            ** returns SQL_NO_DATA_FOUND or SQL_NO_DATA, so
            ** check for both.
            */
        while (rc != SQL_NO_DATA_FOUND && rc != SQL_NO_DATA &&
                odbc_check(odbc_env_handle, SQL_NULL_HDBC,
                    SQL_NULL_HSTMT, rc))
        {

            /*
            ** Copy the new data onto the Mercury heap
            */
            MR_make_aligned_string_copy(new_dsn, (MR_String)dsn);
            *SourceNames = MR_list_cons((MR_Word)new_dsn, *SourceNames);
            MR_make_aligned_string_copy(new_desc, (MR_String)desc);
            *SourceDescs = MR_list_cons((MR_Word)new_desc, *SourceDescs);

            rc = SQLDataSources(odbc_env_handle,
                    SQL_FETCH_NEXT, dsn,
                    SQL_MAX_DSN_LENGTH - 1, &dsn_len,
                    desc, sizeof(desc), &desc_len);
        }
    }

    if (rc == SQL_NO_DATA_FOUND) {
        rc = SQL_SUCCESS;
    }

    *Messages = odbc_message_list;
    odbc_message_list = MR_list_empty();
    return rc;
}").

%-----------------------------------------------------------------------------%

odbc.tables(Qualifier, Owner, TableName, Tables, !DB) :-
    convert_pattern_argument(Qualifier, QualifierStr, QualifierStatus),
    convert_pattern_argument(Owner, OwnerStr, OwnerStatus),
    convert_pattern_argument(TableName, TableStr, TableStatus),
    do_aggregate(odbc.sql_tables(QualifierStr, QualifierStatus,
        OwnerStr, OwnerStatus, TableStr, TableStatus),
        list.cons, [], Results0, !DB),
    list.reverse(Results0, Results),
    ( list.map(convert_table_desc, Results, Tables0) ->
        Tables = Tables0
    ;
        add_message(error(internal_error) -
            "[Mercury][odbc.m]Invalid results from SQLTables.", !DB),
        odbc.throw(!DB)
    ).

:- pred convert_table_desc(odbc.row::in, odbc.table_desc::out) is semidet.

convert_table_desc(Row0, Table) :-
    NullToEmptyStr = (pred(Data0::in, Data::out) is det :-
        Data = ( Data0 = null -> string("") ; Data0 )
    ),
    list.map(NullToEmptyStr, Row0, Row),
    Row = [string(Qualifier), string(Owner), string(Name),
        string(Type), string(Description) | DriverColumns],
    Table = odbc.table_desc(Qualifier, Owner, Name,
        Type, Description, DriverColumns).

%-----------------------------------------------------------------------------%

    % convert_pattern_argument(Pattern, String, Status).
    % This is used in a fairly crude interface to C. If the Status is 0,
    % the corresponding argument to the ODBC function should be NULL,
    % meaning no constraint on the search. If the Status is 1, the
    % argument to the ODBC function should be the given string.
    %
:- pred convert_pattern_argument(search_pattern::in, string::out, int::out)
    is det.

convert_pattern_argument(any, "", 0).
convert_pattern_argument(pattern(Str), Str, 1).

:- pred sql_tables(string::in, int::in, string::in, int::in, string::in,
    int::in, odbc.statement::di, odbc.statement::uo,
    odbc.state::di, odbc.state::uo) is det.

:- pragma foreign_proc("C",
    sql_tables(QualifierStr::in, QualifierStatus::in,
        OwnerStr::in, OwnerStatus::in, TableStr::in, TableStatus::in,
        Statement0::di, Statement::uo, DB0::di, DB::uo),
    [may_call_mercury, promise_pure],
"
    char *qualifier_str = NULL;
    char *owner_str = NULL;
    char *table_str = NULL;
    int qualifier_len = 0;
    int owner_len = 0;
    int table_len = 0;
    SQLRETURN rc;

    Statement = Statement0;

    /*
    ** A NULL pointer in any of the string pattern fields
    ** means no constraint on the search for that field.
    */
    if (QualifierStatus) {
        qualifier_str = (char *) QualifierStr;
        qualifier_len = strlen(qualifier_str);
    }
    if (OwnerStatus) {
        owner_str = (char *) OwnerStr;
        owner_len = strlen(owner_str);
    }
    if (TableStatus) {
        table_str = (char *) TableStr;
        table_len = strlen(table_str);
    }

    rc = SQLTables(Statement->stat_handle, (SQLCHAR *)qualifier_str,
            qualifier_len, (SQLCHAR *)owner_str, owner_len,
            (SQLCHAR *)table_str, table_len, NULL, 0);
    if (! odbc_check(odbc_env_handle, odbc_connection,
            Statement->stat_handle, rc)) {
        odbc_do_cleanup_statement(Statement);
        odbc_throw();
    }

    DB = DB0;
").

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
%
% Error checking
%

:- pred odbc.ok(int::in) is semidet.

:- pragma foreign_proc("C",
    odbc.ok(Status::in),
    [promise_pure, will_not_call_mercury, thread_safe],
"
    SUCCESS_INDICATOR =
        (Status == SQL_SUCCESS || Status == SQL_SUCCESS_WITH_INFO);
").

:- pred odbc.no_data(int::in) is semidet.

:- pragma foreign_proc("C",
    odbc.no_data(Status::in),
    [promise_pure, will_not_call_mercury, thread_safe],
"
    SUCCESS_INDICATOR = (Status == SQL_NO_DATA_FOUND);
").

%-----------------------------------------------------------------------------%

    % Handle ODBC error codes. Refer to the ODBC API Reference
    % provided with the ODBC SDK. The first two characters of the
    % SQLSTATE are meant to specify an error class. Looking at the
    % predicates below, the classes weren't terribly well chosen.
    %
:- pred sql_state_to_message(string::in, string::in,
    odbc.message::out) is det.
:- pragma foreign_export("C", sql_state_to_message(in, in, out),
    "MODBC_odbc_sql_state_to_message").

sql_state_to_message(SQLState, String, Message - String) :-
    string.split(SQLState, 2, Class, SubClass),
    ( Class = "01" ->
        ( sql_state_to_warning(SubClass, Warning) ->
            Message = warning(Warning)
        ;
            Message = warning(general_warning)
        )
    ;
        ( sql_state_to_error(Class, SubClass, Error) ->
            Message = error(Error)
        ;
            Message = error(general_error)
        )
    ).

:- pred sql_state_to_warning(string::in, odbc.warning::out) is semidet.

sql_state_to_warning("000", general_warning).
sql_state_to_warning("001", general_warning).
sql_state_to_warning("002", disconnect_error).
sql_state_to_warning("003", null_value_in_set_function).
sql_state_to_warning("004", string_data_truncated).
sql_state_to_warning("006", privilege_not_revoked).
sql_state_to_warning("007", privilege_not_granted).
sql_state_to_warning("S03", general_warning).
sql_state_to_warning("S04", general_warning).

:- pred sql_state_to_error(string::in, string::in, odbc.error::out) is semidet.

sql_state_to_error("07", "002", execution_error(incorrect_count_field)).
sql_state_to_error("07", "005", general_error).
sql_state_to_error("07", "006",
        execution_error(restricted_data_type_violation)).
sql_state_to_error("07", "009", general_error).
sql_state_to_error("07", "S01", internal_error).

sql_state_to_error("08", "001", connection_error(unable_to_establish)).
sql_state_to_error("08", "002", connection_error(connection_name_in_use)).
sql_state_to_error("08", "003", connection_error(nonexistent_connection)).
sql_state_to_error("08", "004",
        connection_error(connection_rejected_by_server)).
sql_state_to_error("08", "007", connection_error(connection_failure)).
sql_state_to_error("08", "S01", connection_error(connection_failure)).


sql_state_to_error("21", "S01", execution_error(invalid_insert_value_list)).
sql_state_to_error("21", "S02", execution_error(incorrect_derived_table_arity)).

sql_state_to_error("22", "001", execution_error(string_data_truncated)).
sql_state_to_error("22", "002", execution_error(general_error)).
sql_state_to_error("22", "003", execution_error(range_error)).
sql_state_to_error("22", "007", execution_error(invalid_date_time)).
sql_state_to_error("22", "008", execution_error(overflow)).
sql_state_to_error("22", "012", execution_error(division_by_zero)).
sql_state_to_error("22", "015", execution_error(overflow)).
sql_state_to_error("22", "018", execution_error(invalid_cast_specification)).
sql_state_to_error("22", "019", execution_error(invalid_escape)).
sql_state_to_error("22", "025", execution_error(invalid_escape)).
sql_state_to_error("22", "026", execution_error(string_data_length_mismatch)).

sql_state_to_error("23", "000",
        execution_error(integrity_constraint_violation)).

sql_state_to_error("24", "000", execution_error(general_error)).

sql_state_to_error("25", "S00", transaction_error(invalid_state)).
sql_state_to_error("25", "S01", transaction_error(invalid_state)).
sql_state_to_error("25", "S02", transaction_error(still_active)).
sql_state_to_error("25", "S03", transaction_error(rolled_back)).

sql_state_to_error("28", "000", connection_error(invalid_authorization)).

sql_state_to_error("37", "000",
        execution_error(syntax_error_or_access_violation)).

sql_state_to_error("3C", "000", execution_error(general_error)).

sql_state_to_error("3D", "000", execution_error(general_error)).

sql_state_to_error("3F", "000", execution_error(invalid_schema_name)).

sql_state_to_error("40", "001", transaction_error(serialization_failure)).
sql_state_to_error("40", "003", execution_error(general_error)).

sql_state_to_error("42", "000",
        execution_error(syntax_error_or_access_violation)).
sql_state_to_error("42", "S01", execution_error(table_or_view_already_exists)).
sql_state_to_error("42", "S02", execution_error(table_or_view_not_found)).
sql_state_to_error("42", "S11", execution_error(index_already_exists)).
sql_state_to_error("42", "S12", execution_error(index_not_found)).
sql_state_to_error("42", "S21", execution_error(column_already_exists)).
sql_state_to_error("42", "S22", execution_error(column_not_found)).

sql_state_to_error("44", "000", execution_error(general_error)).

sql_state_to_error("IM", _, internal_error).

sql_state_to_error("HY", SubClass, Error) :-
    ( SubClass = "000" ->
        Error = general_error
    ; SubClass = "109" ->
        Error = feature_not_implemented
    ; SubClass = "T00" ->
        Error = timeout_expired
    ; SubClass = "T01" ->
        Error = connection_error(timeout_expired)
    ;
        Error = internal_error
    ).

sql_state_to_error("S0", "001", execution_error(table_or_view_already_exists)).
sql_state_to_error("S0", "002", execution_error(table_or_view_not_found)).
sql_state_to_error("S0", "011", execution_error(index_already_exists)).
sql_state_to_error("S0", "012", execution_error(index_not_found)).
sql_state_to_error("S0", "021", execution_error(column_already_exists)).
sql_state_to_error("S0", "022", execution_error(column_not_found)).
sql_state_to_error("S0", "023", execution_error(no_default_for_column)).

sql_state_to_error("S1", SubClass, Error) :-
    ( SubClass = "000" ->
        Error = general_error
    ; SubClass = "C00" ->
        Error = feature_not_implemented
    ; SubClass = "T01" ->
        Error = connection_error(timeout_expired)
    ;
        Error = internal_error
    ).

:- pragma foreign_code("C", "

/*
** Return MR_TRUE if the last ODBC call succeeded.
** Return MR_FALSE if the ODBC call failed.
** Add any error messages to odbc_message_list.
*/
MR_bool
odbc_check(SQLHENV env_handle, SQLHDBC connection_handle,
        SQLHSTMT statement_handle, SQLRETURN rc)
{
    SQLRETURN   status;
    SQLINTEGER  native_error;
    SQLSMALLINT msg_len;
    UCHAR       message[SQL_MAX_MESSAGE_LENGTH];
    UCHAR       sql_state[SQL_SQLSTATE_SIZE + 1];
    MR_String   mercury_message;
    MR_Word     new_message;

    MR_ASSERT_IMPLY(connection_handle == SQL_NULL_HDBC,
            statement_handle == SQL_NULL_HSTMT);

    odbc_ret_code = rc;

    /* Check type of error */
    if (rc == SQL_SUCCESS) {
        return MR_TRUE;
    } else {

        MR_DEBUG(printf(""getting error message for status %i\\n"", rc));

        while (1) {

            status = SQLError(env_handle, connection_handle,
                statement_handle, sql_state, &native_error,
                message, SQL_MAX_MESSAGE_LENGTH - 1, &msg_len);

            MR_DEBUG(printf(""SQLError status: %i\\n"", status));
            MR_DEBUG(printf(""SQL_STATE: %s\\n"", sql_state));
            MR_DEBUG(printf(""Error: %s\\n"", message));

            if (status != SQL_SUCCESS) {
                break;
            }


            /* Copy the error string to the Mercury heap. */
            MR_make_aligned_string_copy(mercury_message, (char *)message);

            /* Convert the SQL state to an odbc__message. */
            MODBC_odbc_sql_state_to_message((MR_String)sql_state,
                mercury_message, &new_message);

            /* Append the message onto the list. */
            odbc_message_list =
                MR_list_cons(new_message, odbc_message_list);

        }

        if (rc == SQL_SUCCESS_WITH_INFO) {
            return MR_TRUE;
        } else {
            return MR_FALSE;
        }
    }
}

").

%-----------------------------------------------------------------------------%
:- end_module odbc.
%-----------------------------------------------------------------------------%
