%---------------------------------------------------------------------------%
% 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, 2020, 2023, 2025-2026 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,
%   <https://mercurylang.org/documentation/papers/tr_96_45_cover.ps.gz>
%   and <https://mercurylang.org/documentation/papers/tr_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.)
%
% 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 io.
:- import_module list.
:- import_module pair.

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

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

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

:- type state.

    % 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 transaction(data_source::in, user_name::in, password::in,
    transaction(T)::in(transaction), odbc.result(T)::out,
    io::di, io::uo) is det.

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

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

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

:- type 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 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 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 aggregate(string, pred(odbc.row, T, T), T, T,
    odbc.state, odbc.state).
:- mode aggregate(in, in(pred(in, in, out) is det), in, out, di, uo) is det.
:- mode aggregate(in, 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 source_desc
    --->    source_desc(
                odbc.data_source,       % name
                string                  % description
            ).

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

    % Information about a table accessible by a transaction.
    %
:- type 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 data_sources(odbc.result(list(odbc.source_desc))::out,
    io::di, io::uo) is det.

    % 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 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 result == pair(odbc.status, list(odbc.message)).

:- type 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 result(T) == pair(odbc.status(T), list(odbc.message)).

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

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

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

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

:- type 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 connection_error
    --->    unable_to_establish
    ;       invalid_authorization
    ;       connection_name_in_use
    ;       nonexistent_connection
    ;       connection_rejected_by_server
    ;       connection_failure
    ;       timeout_expired.

:- type 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 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 string.
:- import_module unit.
:- import_module univ.

:- pragma require_feature_set([conservative_gc]).

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

    % We do not 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 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 ODBC 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 will 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, TransactionResult, !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, Results, GotMercuryException,
            Exception, Status, RevTransactionMessages, !IO),
        close_connection(Connection, CloseStatus - CloseMessages, !IO),
        % Pass on any exceptions found while processing the transaction.
        (
            GotMercuryException = yes,
            % XXX Without the explicit type qualification, the call to rethrow
            % would lead to an warning message about unresolved polymorphism.
            % The cause of that warning is that the exception_result type
            % is polymorphic in the type of the argument of its "succeeded"
            % function symbol. Since we do not use that function symbol,
            % that type does not matter here.
            ToRethrow = exception(Exception) : exception_result(int),
            rethrow(ToRethrow)
        ;
            GotMercuryException = no,
            list.reverse(RevTransactionMessages, TransactionMessages),
            Messages = ConnectMessages ++ TransactionMessages ++ CloseMessages,
            ( if
                odbc.ok(Status),
                CloseStatus = ok
            then
                TransactionResult = ok(Results) - Messages
            else
                TransactionResult = error - Messages
            )
        )
    ;
        ConnectStatus = error,
        TransactionResult = 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();
").

:- 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 throw(odbc.state::di, odbc.state::uo) is erroneous.

:- pragma foreign_proc("C",
    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 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", connection, "SQLHDBC").

open_connection(Source, User, Password, Result - Messages, !IO) :-
    do_open_connection(Source, User, Password, Handle, ConnectStatus,
        RevMessages, !IO),
    list.reverse(RevMessages, Messages),
    ( if odbc.ok(ConnectStatus) then
        Result = ok(Handle)
    else
        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),
    ( if Status = 0 then
        Result = ok - Messages
    else
        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();
").

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

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

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).

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(
    in(pred(di, uo, di, uo) is det),
    in(pred(in, in, out) is det), in, out, di, uo) is det.
:- mode do_aggregate(
    in(pred(di, uo, di, uo) is det),
    in(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(in(pred(in, in, out) is det), in, out, di, uo, di, uo) is det.
:- mode get_rows(in(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_loop(NumColumns, Accumulate, !Result, !Statement, !DB).

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

get_rows_loop(NumColumns, Accumulate, !Result, !Statement, !DB) :-
    % Try to fetch a new row.
    fetch_row(!Statement, Status, !DB),
    ( if no_data(Status) then
        true
    else
        get_attributes(1, NumColumns, Row, !Statement, !DB),
        Accumulate(Row, !Result),
        get_rows_loop(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) :-
    ( if CurrCol =< NumCols then
        NextCol = CurrCol + 1,
        get_attribute(CurrCol, Attribute, !Statement, !DB),
        get_attributes(NextCol, NumCols, Row1, !Statement, !DB),
        Row = [Attribute | Row1]
    else
        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 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) :-
    ( if int_to_attribute_type_table(Int, Type1) then
        Type = Type1
    else
        error("odbc.int_to_attribute_type: invalid type")
    ).

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

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

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

:- type statement.

:- pragma foreign_type("C", 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 cannot 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;

    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 do not 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 does not work with variable
    % length data, since if the data does not fit into the allocated
    % buffer it gets truncated and there is 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 does not 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 was not enough space
        // for the column name, but we are not 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 garbage collected.
            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 is 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;
    // dummy_buffer has room for the NUL termination byte and nothing else.
    char            dummy_buffer[1];

    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 did not allocate
        // any space for the data, so do not 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 could not 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 is 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 do not 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
// [ibScale] 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 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.
%

data_sources(MaybeSources - Messages, !IO) :-
    sql_data_sources(RevSourceNames, RevDescs, Status, RevMessages, !IO),
    ( if odbc.ok(Status) then
        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)
    else if odbc.no_data(Status) then
        % iODBC 2.12 does not implement this function.
        Messages = [
            error(feature_not_implemented) -
            "[Mercury][odbc.m]SQLDataSources not implemented."
        ],
        MaybeSources = error
    else
        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);
").

:- 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;
}").

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

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),
    ( if list.map(convert_table_desc, Results, Tables0) then
        Tables = Tables0
    else
        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 :-
            ( if Data0 = null then Data = string("") else Data = 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 were not 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),
    ( if Class = "01" then
        ( if sql_state_to_warning(SubClass, Warning) then
            Message = warning(Warning)
        else
            Message = warning(general_warning)
        )
    else
        ( if sql_state_to_error(Class, SubClass, Error) then
            Message = error(Error)
        else
            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) :-
    ( if SubClass = "000" then
        Error = general_error
    else if SubClass = "109" then
        Error = feature_not_implemented
    else if SubClass = "T00" then
        Error = timeout_expired
    else if SubClass = "T01" then
        Error = connection_error(timeout_expired)
    else
        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) :-
    ( if SubClass = "000" then
        Error = general_error
    else if SubClass = "C00" then
        Error = feature_not_implemented
    else if SubClass = "T01" then
        Error = connection_error(timeout_expired)
    else
        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.
%---------------------------------------------------------------------------%
