{-# OPTIONS -ffi #-}
{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

#ifdef mingw32_HOST_OS
#include <windows.h>
#endif
#include <sql.h>
#include <sqlext.h>

#ifdef mingw32_HOST_OS
#let CALLCONV = "stdcall"
#else
#let CALLCONV = "ccall"
#endif

{-
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/odbc/htm/odbcodbc_api_reference.asp
http://www.dbmaker.com.tw/reference/manuals/odbc/odbc_chap_04.html
-}


-- |
-- Module      :  Database.ODBC.OdbcFunctions
-- Copyright   :  (c) 2007 Oleg Kiselyov, Alistair Bayley
-- License     :  BSD-style
-- Maintainer  :  oleg@pobox.com, alistair@abayley.org
-- Stability   :  experimental
-- Portability :  non-portable
-- 
-- Wrappers for ODBC FFI functions, plus buffer marshaling.

module Database.ODBC.OdbcFunctions where

import Control.Exception
import Control.Monad
import Data.Dynamic
import Data.Time
import Database.Util
import Foreign
import Foreign.C
import Foreign.C.UTF8

data HandleObj = HandleObj
type Handle = Ptr HandleObj
data EnvObj = EnvObj
type EnvHandle = Ptr EnvObj
-- We store the dbms name name in the connection and stmt objects.
-- This allows us to customise behaviour based on the dbms we're
-- connected to. At present we use this when binding datetime
-- parameters for MS SQL Server.
data ConnObj = ConnObj
type ConnHdl = Ptr ConnObj
data ConnHandle = ConnHandle { connHdl :: ConnHdl, connDbms :: String }
data StmtObj = StmtObj
type StmtHdl = Ptr StmtObj
data StmtHandle = StmtHandle { stmtHdl :: StmtHdl, stmtDbms :: String }
type WindowHandle = Ptr ()
data Buffer = Buffer
type BufferFPtr = ForeignPtr Buffer
type SizeFPtr = ForeignPtr SqlLen

type MyCString = CString
type MyCStringLen = CStringLen
myPeekCStringLen p = peekUTF8StringLen p
myWithCString s = withUTF8String s
myWithCStringLen s = withUTF8StringLen s
--myPeekCStringLen p = peekCStringLen p
--myWithCString s = withCString s
--myWithCStringLen s = withCStringLen s

data BindBuffer = BindBuffer
  { bindBufPtr :: BufferFPtr
  , bindBufSzPtr :: SizeFPtr
  , bindBufSize :: SqlLen
  }

type SqlInteger = #{type SQLINTEGER}
type SqlUInteger = #{type SQLUINTEGER}
type SqlSmallInt = #{type SQLSMALLINT}
type SqlUSmallInt = #{type SQLUSMALLINT}
type SqlLen = #{type SQLLEN}
type SqlULen = #{type SQLULEN}
type SqlReturn = SqlSmallInt
type SqlHandleType = SqlSmallInt
type SqlDataType = SqlSmallInt
type SqlCDataType = SqlSmallInt
type SqlParamDirection = SqlSmallInt
type SqlInfoType = SqlUSmallInt

-- Return codes from API calls

(
  sqlRcInvalidHandle :
  sqlRcStillExecuting :
  sqlRcSuccess :
  sqlRcSuccessWithInfo :
  sqlRcError :
  sqlRcNeedData :
  sqlRcNoData :
--  []) = [-2,-1,0,1,2,99,100] :: [SqlReturn]
  []) =
  (
  #{const SQL_INVALID_HANDLE} :
  #{const SQL_STILL_EXECUTING} :
  #{const SQL_SUCCESS} :
  #{const SQL_SUCCESS_WITH_INFO} :
  #{const SQL_ERROR} :
  #{const SQL_NEED_DATA} :
  #{const SQL_NO_DATA} :
  []) :: [SqlReturn]

showReturnCode rc
  | rc == #{const SQL_INVALID_HANDLE} = "SQL_INVALID_HANDLE"
  | rc == #{const SQL_STILL_EXECUTING} = "SQL_STILL_EXECUTING"
  | rc == #{const SQL_SUCCESS} = "SQL_SUCCESS"
  | rc == #{const SQL_SUCCESS_WITH_INFO}  = "SQL_SUCCESS_WITH_INFO"
  | rc == #{const SQL_ERROR} = "SQL_ERROR"
  | rc == #{const SQL_NEED_DATA} = "SQL_NEED_DATA"
  | rc == #{const SQL_NO_DATA} = "SQL_NO_DATA"
  | otherwise = "UNKNOWN_RETURN_CODE"

-- There are only four handle types in ODBC.

(
  sqlHTypeEnv :
  sqlHTypeConn :
  sqlHTypeStmt :
  sqlHTypeDesc :
--  []) = [1..4] :: [SqlHandleType]
  []) =
  (
  #{const SQL_HANDLE_ENV} :
  #{const SQL_HANDLE_DBC} :
  #{const SQL_HANDLE_STMT} :
  #{const SQL_HANDLE_DESC} :
  []) :: [SqlHandleType]

sqlDriverNoPrompt :: SqlUSmallInt
sqlDriverNoPrompt = #{const SQL_DRIVER_NOPROMPT}

sqlNullTermedString :: SqlInteger
sqlNullTermedString = #{const SQL_NTS}

sqlNullData :: SqlLen
sqlNullData = #{const SQL_NULL_DATA}

sqlTransCommit :: SqlSmallInt
sqlTransCommit = #{const SQL_COMMIT}

sqlTransRollback :: SqlSmallInt
sqlTransRollback = #{const SQL_ROLLBACK}

sqlAutoCommitOn, sqlAutoCommitOff :: SqlInteger
sqlAutoCommitOn = #{const SQL_AUTOCOMMIT_ON}
sqlAutoCommitOff = #{const SQL_AUTOCOMMIT_OFF}

-- These are attribute types, which are passed as the second parameter
-- to sqlSetEnvAttr.

(
  sqlAttrOdbcVersion :
  sqlAttrAutoCommit :
  sqlAttrTxnIsolation :
  []) =
  (
  #{const SQL_ATTR_ODBC_VERSION} :
  #{const SQL_ATTR_AUTOCOMMIT} :
  #{const SQL_ATTR_TXN_ISOLATION} :
  []) :: [SqlInteger]

-- These are attribute values, which are passed as the third parameter
-- to sqlSetEnvAttr. Obviously that must accompany the relevant
-- attribute type.

(
  sqlOvOdbc3 :
  sqlTxnCapable :
  sqlDefaultTxnIsolation :
  sqlTxnIsolationOption :
  sqlTxnReadUncommitted :
  sqlTxnReadCommitted :
  sqlTxnRepeatableRead :
  sqlTxnSerializable :
  []) =
  (
  #{const SQL_OV_ODBC3} : -- 3 (UL)
  #{const SQL_TXN_CAPABLE} :  -- 46
  #{const SQL_DEFAULT_TXN_ISOLATION} :  -- 26
  #{const SQL_TXN_ISOLATION_OPTION} :  -- 72
  #{const SQL_TXN_READ_UNCOMMITTED} :  -- 1
  #{const SQL_TXN_READ_COMMITTED} :  -- 2
  #{const SQL_TXN_REPEATABLE_READ} :  -- 4
  #{const SQL_TXN_SERIALIZABLE} :  -- 8
  []) :: [SqlInteger]


-- ODBC SQL data types
(
  sqlDTypeString :
  sqlDTypeInt :
  sqlDTypeBinary :
  sqlDTypeDouble :
  sqlDTypeDate :
  sqlDTypeTime :
  sqlDTypeTimestamp :
  sqlDTypeCursor :
  []) =
  (
  #{const SQL_CHAR} :  -- 1
  #{const SQL_INTEGER} :  -- 4
  #{const SQL_BINARY} :  -- -2
  #{const SQL_DOUBLE} :  -- 8
  #{const SQL_TYPE_DATE} :  -- 9
  #{const SQL_TYPE_TIME} :  -- 10
  #{const SQL_TYPE_TIMESTAMP} :  -- 11
  #{const SQL_CURSOR_TYPE} :  -- 6
  []) :: [SqlDataType]

-- host language (C) data types

(
  sqlCTypeString :
  sqlCTypeInt :
  sqlCTypeBinary :
  sqlCTypeDouble :
  sqlCTypeDate :
  sqlCTypeTime :
  sqlCTypeTimestamp :
  []) =
  (
  #{const SQL_C_CHAR} :
  #{const SQL_C_LONG} :
  #{const SQL_C_BINARY} :
  #{const SQL_C_DOUBLE} :
  #{const SQL_C_TYPE_DATE} :
  #{const SQL_C_TYPE_TIME} :
  #{const SQL_C_TYPE_TIMESTAMP} :
  []) :: [SqlCDataType]

{-
#define SQL_C_BINARY SQL_BINARY
#define SQL_C_BIT SQL_BIT
#define SQL_C_BOOKMARK SQL_C_ULONG
#define SQL_C_CHAR SQL_CHAR
#define SQL_C_DATE SQL_DATE
#define SQL_C_DEFAULT 99
#define SQL_C_DOUBLE SQL_DOUBLE
#define SQL_C_FLOAT SQL_REAL
#define SQL_C_LONG SQL_INTEGER
#define SQL_C_SHORT SQL_SMALLINT
#define SQL_C_SLONG (SQL_C_LONG+SQL_SIGNED_OFFSET)
#define SQL_C_SSHORT (SQL_C_SHORT+SQL_SIGNED_OFFSET)
#define SQL_C_STINYINT (SQL_TINYINT+SQL_SIGNED_OFFSET)
#define SQL_C_TIME SQL_TIME
#define SQL_C_TIMESTAMP SQL_TIMESTAMP
#define SQL_C_TINYINT SQL_TINYINT
#define SQL_C_ULONG (SQL_C_LONG+SQL_UNSIGNED_OFFSET)
#define SQL_C_USHORT (SQL_C_SHORT+SQL_UNSIGNED_OFFSET)
#define SQL_C_UTINYINT (SQL_TINYINT+SQL_UNSIGNED_OFFSET)
-}

-- Bind Parameter directions
(
  sqlParamInput :
  sqlParamInputOutput :
  sqlParamOutput :
  sqlParamDefault :
  sqlParamUnknown :
  [] ) =
  (
  #{const SQL_PARAM_INPUT} :
  #{const SQL_PARAM_INPUT_OUTPUT} :
  #{const SQL_PARAM_OUTPUT} :
  #{const SQL_PARAM_TYPE_DEFAULT} :
  #{const SQL_PARAM_TYPE_UNKNOWN} :
  [] ) :: [SqlParamDirection]


-- Information Types, for SQLGetInfo

(
  -- Driver info
  sqlInfoDriverHdbc :
  sqlInfoDriverHdesc :
  sqlInfoDriverHenv :
  sqlInfoDriverHlib :
  sqlInfoDriverHstmt :
  sqlInfoDriverName :
  sqlInfoDriverOdbcVer :
  sqlInfoDriverVer :
  sqlOdbcVer :
  -- DBMS product info
  sqlInfoDatabaseName :
  sqlInfoDbmsName :
  sqlInfoDbmsVer :
  [] ) =
  (
  #{const SQL_DRIVER_HDBC} :
  #{const SQL_DRIVER_HDESC} :
  #{const SQL_DRIVER_HENV} :
  #{const SQL_DRIVER_HLIB} :
  #{const SQL_DRIVER_HSTMT} :
  #{const SQL_DRIVER_NAME} :
  #{const SQL_DRIVER_ODBC_VER} :
  #{const SQL_DRIVER_VER} :
  #{const SQL_ODBC_VER} :
  #{const SQL_DATABASE_NAME} :
  #{const SQL_DBMS_NAME} :
  #{const SQL_DBMS_VER} :
  [] ) :: [SqlInfoType]


---------------------------------------------------------------------

data OdbcException = OdbcException Int String String [OdbcException]
  deriving (Typeable)

instance Show OdbcException where
  show (OdbcException i st s more) = "OdbcException "
    ++ (show i) ++ " " ++ st ++ " " ++ s -- ++ (concat (map showOdbcExMsg more))

-- showOdbcExMsg (OdbcException i st s more) = s

catchOdbc :: IO a -> (OdbcException -> IO a) -> IO a
catchOdbc = catchDyn

throwOdbc :: OdbcException -> a
throwOdbc = throwDyn

-- define SQL_SUCCEEDED(rc) (((rc)&(~1))==0)
sqlSucceeded rc = rc == sqlRcSuccess || rc == sqlRcSuccessWithInfo

getDiagRec :: SqlReturn -> SqlHandleType -> Handle -> SqlSmallInt -> IO [OdbcException]
getDiagRec retcode htype handle row =
  allocaBytes 6 $ \cstrState -> do
  alloca $ \errorNumPtr -> do
  allocaBytes 1025 $ \cstrMsg -> do
  alloca $ \msgLenPtr -> do
    rc <- sqlGetDiagRec htype handle row cstrState errorNumPtr cstrMsg 1024 msgLenPtr
    --putStrLn ("getDiagRec: rc=" ++ show rc)
    case () of
      _ | rc == sqlRcSuccess -> do
          errnum <- peek errorNumPtr
          state <- myPeekCStringLen (cstrState, 5)
          msglen <- peek msgLenPtr
          --putStrLn ("getDiagRec: msglen=" ++ show msglen)
          msg <- myPeekCStringLen (cstrMsg, fromIntegral msglen)
          --putStrLn ("getDiagRec: msg=" ++ msg)
          more <- getDiagRec retcode htype handle (row+1)
          return ((OdbcException (fromIntegral errnum) state msg []) : more)
        | rc == sqlRcNoData -> return []
        | otherwise -> return [OdbcException (fromIntegral rc) "01000" (showReturnCode retcode) []]

checkError :: SqlReturn -> SqlHandleType -> Handle -> IO ()
checkError rc htype handle =
  when (rc /= sqlRcSuccess && rc /= sqlRcSuccessWithInfo)
    (do
      exs <- getDiagRec rc htype handle 1
      if null exs
        then throwOdbc (OdbcException (fromIntegral rc) "01000"
          ("No error messages for return code " ++ show rc ++ " (" ++ showReturnCode rc ++ ")") [])
        else do
          let (OdbcException i st s _) = head exs
          throwOdbc (OdbcException i st s (tail exs))
    )

allocHdl :: (Storable a) => Handle -> SqlHandleType -> IO a
allocHdl h htype = do
  alloca $ \hptr -> do
    rc <- sqlAllocHandle htype h (castPtr hptr)
    checkError rc htype h
    peek hptr

allocEnv :: IO EnvHandle
allocEnv = allocHdl nullPtr sqlHTypeEnv

allocConn :: EnvHandle -> IO ConnHandle
allocConn env = do
  c <- allocHdl (castPtr env) sqlHTypeConn
  return (ConnHandle c "")

allocStmt :: ConnHandle -> IO StmtHandle
allocStmt conn = do
  s <- allocHdl (castPtr (connHdl conn)) sqlHTypeStmt
  -- copy dbms name from connection object
  return (StmtHandle s (connDbms conn))

freeHandle :: SqlHandleType -> Handle -> IO ()
freeHandle htype h = do
  rc <- sqlFreeHandle htype h
  checkError rc htype h

freeEnv :: EnvHandle -> IO ()
freeEnv env = freeHandle sqlHTypeEnv (castPtr env)

freeConn :: ConnHandle -> IO ()
freeConn conn = freeHandle sqlHTypeConn (castPtr (connHdl conn))

freeStmt :: StmtHandle -> IO ()
freeStmt stmt = freeHandle sqlHTypeStmt (castPtr (stmtHdl stmt))

int2Ptr :: SqlInteger -> Ptr ()
int2Ptr i = plusPtr nullPtr (fromIntegral i)

setOdbcVer :: EnvHandle -> IO ()
setOdbcVer env = do
  rc <- sqlSetEnvAttr env sqlAttrOdbcVersion (int2Ptr sqlOvOdbc3) 0
  checkError rc sqlHTypeEnv (castPtr env)

connect :: ConnHandle -> String -> IO String
connect conn connstr = do
  myWithCStringLen connstr $ \(cstr, clen) -> do
  allocaBytes 1000 $ \outConnStr -> do
  alloca $ \ptrOutLen -> do
  rc <- sqlDriverConnect (connHdl conn) nullPtr cstr (fromIntegral clen)
    outConnStr 1000 ptrOutLen sqlDriverNoPrompt
  checkError rc sqlHTypeConn (castPtr (connHdl conn))
  outLen <- peek ptrOutLen
  myPeekCStringLen (outConnStr, fromIntegral outLen)

disconnect :: ConnHandle -> IO ()
disconnect conn = do
  rc <- sqlDisconnect (connHdl conn)
  checkError rc sqlHTypeConn (castPtr (connHdl conn))


prepareStmt :: StmtHandle -> String -> IO ()
prepareStmt stmt sqltext = do
  myWithCString sqltext $ \cstr -> do
  rc <- sqlPrepare (stmtHdl stmt) cstr sqlNullTermedString
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))

executeStmt :: StmtHandle -> IO ()
executeStmt stmt = do
  rc <- sqlExecute (stmtHdl stmt)
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))

closeCursor :: StmtHandle -> IO ()
closeCursor stmt = do
  rc <- sqlCloseCursor (stmtHdl stmt)
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))

rowCount :: StmtHandle -> IO Int
rowCount stmt = do
  alloca $ \rcptr -> do
  rc <- sqlRowCount (stmtHdl stmt) rcptr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
  liftM fromIntegral (peek rcptr)

-- | Return 'True' if there are more rows, 'False' if end-of-data.
fetch :: StmtHandle -> IO Bool
fetch stmt = do
  rc <- sqlFetch (stmtHdl stmt)
  when (rc /= sqlRcNoData)
    (checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt)))
  return (rc /= sqlRcNoData)

-- | Return 'True' if there is another result-set to process.
-- Presumably the 'StmtHandle' is modified to reference the
-- new result-set.
moreResults :: StmtHandle -> IO Bool
moreResults stmt = do
  rc <- sqlMoreResults (stmtHdl stmt)
  when (rc /= sqlRcNoData)
    (checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt)))
  return (rc /= sqlRcNoData)


commit :: ConnHandle -> IO ()
commit conn = do
  rc <- sqlEndTran sqlHTypeConn (castPtr (connHdl conn)) sqlTransCommit
  checkError rc sqlHTypeConn (castPtr (connHdl conn))

rollback :: ConnHandle -> IO ()
rollback conn = do
  rc <- sqlEndTran sqlHTypeConn (castPtr (connHdl conn)) sqlTransRollback
  checkError rc sqlHTypeConn (castPtr (connHdl conn))

setAutoCommitOn :: ConnHandle -> IO ()
setAutoCommitOn conn = do
  rc <- sqlSetConnectAttr (connHdl conn) sqlAttrAutoCommit (int2Ptr sqlAutoCommitOn) 0
  checkError rc sqlHTypeConn (castPtr (connHdl conn))

setAutoCommitOff :: ConnHandle -> IO ()
setAutoCommitOff conn = do
  rc <- sqlSetConnectAttr (connHdl conn) sqlAttrAutoCommit (int2Ptr sqlAutoCommitOff) 0
  checkError rc sqlHTypeConn (castPtr (connHdl conn))

setTxnIsolation :: ConnHandle -> SqlInteger -> IO ()
setTxnIsolation conn level = do
  rc <- sqlSetConnectAttr (connHdl conn) sqlAttrTxnIsolation (int2Ptr level) 0
  checkError rc sqlHTypeConn (castPtr (connHdl conn))

getInfoString :: ConnHandle -> SqlInfoType -> IO String
getInfoString conn infotype = do
  let bufsize = 10000
  alloca $ \outsizeptr -> do
  allocaBytes bufsize $ \buffer -> do
  rc <- sqlGetInfo (connHdl conn) infotype buffer (fromIntegral bufsize) outsizeptr
  checkError rc sqlHTypeConn (castPtr (connHdl conn))
  outsize <- peek outsizeptr
  myPeekCStringLen (castPtr buffer, fromIntegral outsize)

getInfoDbmsName :: ConnHandle -> IO String
getInfoDbmsName conn = getInfoString conn sqlInfoDbmsName

getInfoDbmsVer :: ConnHandle -> IO String
getInfoDbmsVer conn = getInfoString conn sqlInfoDbmsVer

getInfoDatabaseName :: ConnHandle -> IO String
getInfoDatabaseName conn = getInfoString conn sqlInfoDatabaseName

getInfoDriverName :: ConnHandle -> IO String
getInfoDriverName conn = getInfoString conn sqlInfoDriverName

getInfoDriverVer :: ConnHandle -> IO String
getInfoDriverVer conn = getInfoString conn sqlInfoDriverVer

getNativeSql :: ConnHandle -> String -> IO String
getNativeSql conn sqltext = do
  let bufsize = 100000
  alloca $ \outsizeptr -> do
  allocaBytes bufsize $ \buffer -> do
  myWithCStringLen sqltext $ \(cstr,clen) -> do
  rc <- sqlNativeSql (connHdl conn) cstr (fromIntegral clen) buffer (fromIntegral bufsize) outsizeptr
  checkError rc sqlHTypeConn (castPtr (connHdl conn))
  outsize <- peek outsizeptr
  myPeekCStringLen (castPtr buffer, fromIntegral outsize)
  


---------------------------------------------------------------------
-- Get column values with SQLGetData.
-- These functions will probably not be used much,
-- but we'll keep them in because the ODBC API has them
-- (i.e. for completeness).
-- The OdbcBindBuffer class has a getData function which uses these,
-- if you'd rather.

getMaybeFromBuffer :: Storable a => Ptr SqlLen -> Ptr a -> (Ptr a -> SqlLen -> IO b) -> IO (Maybe b)
getMaybeFromBuffer szptr bptr action = do
  len <- peek szptr
  if len < 0 then return Nothing
    else action bptr len >>= return . Just

getDataStorable :: Storable a => StmtHandle -> Int -> SqlDataType -> Int -> (a -> b) -> IO (Maybe b)
getDataStorable stmt pos sqltype buffersize convert = do
  allocaBytes buffersize $ \bptr -> do
  alloca $ \szptr -> do
  rc <- sqlGetData (stmtHdl stmt) (fromIntegral pos) sqltype (castPtr bptr) 0 szptr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
  getMaybeFromBuffer szptr bptr (\buffer len -> peek buffer >>= return . convert )

getDataUtcTime :: StmtHandle -> Int -> IO (Maybe UTCTime)
getDataUtcTime stmt pos = do
  allocaBytes #{size TIMESTAMP_STRUCT} $ \bptr -> do
  alloca $ \szptr -> do
  rc <- sqlGetData (stmtHdl stmt) (fromIntegral pos) sqlDTypeTimestamp (castPtr bptr) 50 szptr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
  getMaybeFromBuffer szptr bptr (\buffer len -> readUtcTimeFromMemory buffer >>= return )

getDataCStringLen :: StmtHandle -> Int -> IO (Maybe CStringLen)
getDataCStringLen stmt pos = do
  alloca $ \szptr -> do
  allocaBytes 16 $ \dummyptr -> do
  -- Call GetData with 0-sized buffer to get size information.
  rc <- sqlGetData (stmtHdl stmt) (fromIntegral pos) sqlDTypeString (castPtr dummyptr) 0 szptr
  when (rc /= sqlRcSuccessWithInfo)
    (checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt)))
  bufSize <- peek szptr
  let bufSize' = 1 + if bufSize < 0 then 0 else bufSize
  -- Use size information to allocate perfectly-sized buffer.
  allocaBytes (fromIntegral bufSize') $ \bptr -> do
  rc <- sqlGetData (stmtHdl stmt) (fromIntegral pos) sqlDTypeString (castPtr bptr) bufSize' szptr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
  len <- peek szptr
  if len < 0 then return Nothing
    else return (Just (castPtr bptr, fromIntegral len))

getDataUTF8String :: StmtHandle -> Int -> IO (Maybe String)
getDataUTF8String stmt pos = do
  mbcstrlen <- getDataCStringLen stmt pos
  case mbcstrlen of
    Nothing -> return Nothing
    Just cstrlen -> peekUTF8StringLen cstrlen >>= return . Just

getDataCString :: StmtHandle -> Int -> IO (Maybe String)
getDataCString stmt pos = do
  mbcstrlen <- getDataCStringLen stmt pos
  case mbcstrlen of
    Nothing -> return Nothing
    Just cstrlen -> peekCStringLen cstrlen >>= return . Just

{- from sqltypes.h. Struct size depends on size of SmallInt etc,
but is 16 bytes on a 32-bit platform. 32 bytes on 64-bit?
typedef struct tagTIMESTAMP_STRUCT {
    SQLSMALLINT year;
    SQLUSMALLINT month;
    SQLUSMALLINT day;
    SQLUSMALLINT hour;
    SQLUSMALLINT minute;
    SQLUSMALLINT second;
    SQLUINTEGER fraction;
} TIMESTAMP_STRUCT;
-}

peekSmallInt :: Ptr a -> Int -> IO SqlSmallInt
peekSmallInt buffer offset = peekByteOff buffer offset
peekUSmallInt :: Ptr a -> Int -> IO SqlUSmallInt
peekUSmallInt buffer offset = peekByteOff buffer offset
peekUInteger :: Ptr a -> Int -> IO SqlUInteger
peekUInteger buffer offset = peekByteOff buffer offset

-- We have to give the Ptr a concrete type, to keep the type-checker
-- happy, but it can be anything. It has to be a Storable type, though.

readUtcTimeFromMemory :: Ptr Word8 -> IO UTCTime
readUtcTimeFromMemory buffer = do
  year <- peekSmallInt buffer #{offset TIMESTAMP_STRUCT, year}
  month <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, month}
  day <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, day}
  hour <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour}
  minute <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute}
  second <- peekUSmallInt buffer #{offset TIMESTAMP_STRUCT, second}
  -- Fraction ranges from 0 - 999,999,999,
  frac <- peekUInteger buffer #{offset TIMESTAMP_STRUCT, fraction}
  let secs :: Double; secs = fromIntegral second + (fromIntegral frac / 1000000000.0)
  return (mkUTCTime (fromIntegral year) month day hour minute second)

---------------------------------------------------------------------
-- Return-set column binding.
-- Apparently this is faster than SQLGetData for larger result-sets,
-- because the output buffers do not need to be rebound with
-- every call.
-- Dunno how much difference this'll make in practice. Suck 'n' see.

bindColumnBuffer :: StmtHandle -> Int -> SqlDataType -> SqlLen -> IO BindBuffer
bindColumnBuffer stmt pos dtype size = do
  alloca $ \colPtr -> do
  rc <- sqlNumResultCols (stmtHdl stmt) colPtr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
  nc <- peek colPtr
  if (fromIntegral nc) < pos || pos < 1
    then throwOdbc (OdbcException (-1) "01000"
      ("Attempted fetch from invalid column number " ++ show pos) [])
    else do
      buffer <- createEmptyBuffer (fromIntegral size)
      withForeignPtr (bindBufPtr buffer) $ \bptr -> do
      withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do
      rc <- sqlBindCol (stmtHdl stmt) (fromIntegral pos) dtype bptr size szptr
      checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))
      return buffer

createEmptyBuffer :: SqlLen -> IO BindBuffer
createEmptyBuffer size = do
  szfptr <- mallocForeignPtr
  bfptr <- mallocForeignPtrBytes (fromIntegral size)
  return (BindBuffer bfptr szfptr size)


testForNull :: BindBuffer -> (Ptr Buffer -> SqlLen -> IO a) -> IO (Maybe a)
testForNull buffer action = do
  withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do
  len <- peek szptr
  -- sqlNullData = -1, so anthing less than zero could
  -- be treated as null.
  if len < 0 then return Nothing
    else withForeignPtr (bindBufPtr buffer) $ \bptr ->
      action bptr len >>= return . Just

getStorableFromBuffer :: Storable a => BindBuffer -> IO (Maybe a)
getStorableFromBuffer buffer =
  testForNull buffer (\bptr _ -> peek (castPtr bptr))

getCAStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCAStringFromBuffer buffer =
  testForNull buffer (\ptr len -> peekCAStringLen (castPtr ptr, fromIntegral len))

getCWStringFromBuffer :: BindBuffer -> IO (Maybe String)
getCWStringFromBuffer buffer =
  testForNull buffer (\ptr len -> peekCWStringLen (castPtr ptr, fromIntegral len))

getUTF8StringFromBuffer :: BindBuffer -> IO (Maybe String)
getUTF8StringFromBuffer buffer =
  testForNull buffer (\ptr len -> peekUTF8StringLen (castPtr ptr, fromIntegral len))

getUtcTimeFromBuffer :: BindBuffer -> IO (Maybe UTCTime)
getUtcTimeFromBuffer bindbuffer = do
  testForNull bindbuffer $ \buffer _ -> do
  readUtcTimeFromMemory (castPtr buffer)


---------------------------------------------------------------------
-- Parameter binding

createBufferForStorable :: Storable a => Maybe a -> IO BindBuffer
createBufferForStorable Nothing =
  let zero :: Int; zero = 0; in createBufferHelper zero (fromIntegral (sizeOf zero)) (sizeOf zero)
createBufferForStorable (Just val) = createBufferHelper val (fromIntegral (sizeOf val)) (sizeOf val)

createBufferHelper :: Storable a => a -> SqlLen -> Int -> IO BindBuffer
createBufferHelper val valsize bufsize = do
  -- alloc space for size parameter
  szfptr <- mallocForeignPtr
  withForeignPtr szfptr (\szptr -> poke szptr valsize)
  -- alloc buffer for storable value
  bfptr <- mallocForeignPtr
  withForeignPtr bfptr (\bptr -> poke bptr val)
  return (BindBuffer (castForeignPtr bfptr) szfptr (fromIntegral bufsize))

wrapSizedBuffer :: Ptr a -> SqlLen -> Int -> IO BindBuffer
wrapSizedBuffer valptr valsize bufsize = do
  szfptr <- mallocForeignPtr
  withForeignPtr szfptr (\szptr -> poke szptr valsize)
  bfptr <- newForeignPtr finalizerFree valptr
  let size2 = if valsize > (fromIntegral bufsize) then valsize else (fromIntegral bufsize)
  return (BindBuffer (castForeignPtr bfptr) szfptr size2)

bindParam ::
  StmtHandle
  -> Int
  -> SqlParamDirection
  -> SqlCDataType
  -> SqlDataType
  -> SqlULen
  -> SqlSmallInt
  -> BindBuffer
  -> IO ()
bindParam stmt pos direction ctype sqltype precision scale buffer =
  withForeignPtr (bindBufPtr buffer) $ \bptr -> do
  withForeignPtr (bindBufSzPtr buffer) $ \valszptr -> do
  let bufsize = bindBufSize buffer
  rc <- sqlBindParameter (stmtHdl stmt) (fromIntegral pos) direction ctype sqltype precision scale bptr bufsize valszptr
  checkError rc sqlHTypeStmt (castPtr (stmtHdl stmt))

bindNull :: StmtHandle -> Int -> SqlParamDirection -> SqlCDataType -> SqlDataType -> IO BindBuffer
bindNull stmt pos direction ctype dtype = do
  let val :: Maybe Int; val = Nothing
  buffer <- createBufferForStorable val
  bindParam stmt pos direction ctype dtype 0 0 buffer
  return buffer

bindParamCStringLen :: StmtHandle -> Int -> SqlParamDirection -> Maybe CStringLen -> Int -> IO BindBuffer
bindParamCStringLen stmt pos direction Nothing bufsize = do
  let bufsz = if bufsize < 8 then 8 else (fromIntegral bufsize)
  ptr <- mallocBytes bufsz
  buffer <- wrapSizedBuffer ptr (-1) bufsz
  bindParam stmt pos direction sqlCTypeString sqlDTypeString 0 0 buffer
  return buffer
bindParamCStringLen stmt pos direction (Just (cstr, clen)) bufsize = do
  let bufsz = 1 + if clen > bufsize then (fromIntegral clen) else (fromIntegral bufsize)
  mem <- mallocBytes bufsz
  copyBytes mem cstr (fromIntegral clen)
  pokeByteOff mem (fromIntegral clen) (0 :: Word8)
  buffer <- wrapSizedBuffer mem (fromIntegral clen) bufsz
  bindParam stmt pos direction sqlCTypeString sqlDTypeString (fromIntegral clen) 0 buffer
  return buffer

bindEncodedString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> (String -> ((Ptr a, Int) -> IO BindBuffer) -> IO BindBuffer) -> Int -> IO BindBuffer
bindEncodedString stmt pos direction Nothing withEncoder bufsz =
  --bindNull stmt pos direction sqlCTypeString sqlDTypeString
  bindParamCStringLen stmt pos direction Nothing bufsz
bindEncodedString stmt pos direction (Just s) withEncoder bufsz =
  withEncoder s (\(cs, cl) -> bindParamCStringLen stmt pos direction (Just (castPtr cs, cl)) bufsz)

bindParamUTF8String :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamUTF8String stmt pos direction val sz =
  bindEncodedString stmt pos direction val withUTF8StringLen sz

bindParamCAString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCAString stmt pos direction val sz =
  bindEncodedString stmt pos direction val withCAStringLen sz

bindParamCWString :: StmtHandle -> Int -> SqlParamDirection -> Maybe String -> Int -> IO BindBuffer
bindParamCWString stmt pos direction val sz =
  bindEncodedString stmt pos direction val withCWStringLen sz

pokeSmallInt :: Ptr a -> Int -> SqlSmallInt -> IO ()
pokeSmallInt buffer offset val = pokeByteOff buffer offset val
pokeUSmallInt :: Ptr a -> Int -> SqlUSmallInt -> IO ()
pokeUSmallInt buffer offset val = pokeByteOff buffer offset val
pokeUInteger :: Ptr a -> Int -> SqlUInteger -> IO ()
pokeUInteger buffer offset val = pokeByteOff buffer offset val

writeUTCTimeToMemory :: Ptr Word8 -> UTCTime -> IO ()
writeUTCTimeToMemory buffer utc = do
  let
    (LocalTime ltday time) = utcToLocalTime (hoursToTimeZone 0) utc
    (TimeOfDay hour minute second) = time
    (year, month, day) = toGregorian ltday
  pokeSmallInt buffer #{offset TIMESTAMP_STRUCT, year} (fromIntegral year)
  pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, month} (fromIntegral month)
  pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, day} (fromIntegral day)
  pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, hour} (fromIntegral hour)
  pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, minute} (fromIntegral minute)
  -- what do we do with fraction? What sort of fraction is it?
  -- apparently can range from 0 - 999,999,999,
  -- but MS SQL Server only handles milliseconds (0 - 999) i.e. precision 3
  let (secs, frac) = properFraction second
  let fraction :: SqlUInteger; fraction = round (frac * 1000000000.0)
  pokeUSmallInt buffer #{offset TIMESTAMP_STRUCT, second} secs
  pokeUInteger buffer #{offset TIMESTAMP_STRUCT, fraction} fraction

-- writeUTCTimeToMemory and makeUtcTimeBuffer don't work with MS SQL Server;
-- it always returns 22008 "Datetime field overflow".
-- They do work with PostgreSQL and Oracle ODBC drivers.

makeUtcTimeBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeBuffer utc = do
  mem <- mallocBytes #{size TIMESTAMP_STRUCT}
  writeUTCTimeToMemory (castPtr mem) utc
  wrapSizedBuffer mem #{size TIMESTAMP_STRUCT} (-1)

-- Marshal via String, for MS SQL Server.
-- We have to drop the last 6 chars (nnn+nn) from the ISO datetime,
-- because MS SQL Server can only cope with "yyyy-mm-dd hh:mi:ss.fff".

makeUtcTimeStringBuffer :: UTCTime -> IO BindBuffer
makeUtcTimeStringBuffer utc = do
  let buffersize = 32  -- Allow extra space for output values
  mem <- mallocBytes buffersize
  let s = take 23 (utcTimeToOdbcDatetime utc)
  withCStringLen s $ \(cstr, clen) -> do
    copyBytes mem cstr (fromIntegral clen)
    pokeByteOff mem (fromIntegral clen) (0 :: Word8)
    wrapSizedBuffer mem (fromIntegral clen) buffersize

bindParamUtcTime :: StmtHandle -> Int -> SqlParamDirection -> Maybe UTCTime -> IO BindBuffer
bindParamUtcTime stmt pos direction Nothing = do
  bindNull stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp
bindParamUtcTime stmt pos direction (Just utc) = do
  case (stmtDbms stmt) of
    "microsoft sql server" -> do
      -- I cannot get TIMESTAMP_STRUCT to work with MS SQL Server;
      -- it always returns 22008 "Datetime field overflow".
      -- We have to pass in a String, rather than a TIMESTAMP_STRUCT,
      -- and let the ODBC driver do the conversion.
      buffer <- makeUtcTimeStringBuffer utc
      withForeignPtr (bindBufSzPtr buffer) $ \szptr -> do
        -- 23 is the largest precision value allowed by MS SQL Server.
        -- That gives us "yyyy-mm-dd hh:mm:ss.fff"
        bindParam stmt pos direction sqlCTypeString sqlDTypeTimestamp 23 0 buffer
        return buffer
    otherwise -> do
      -- For TimeStamp:
      --   Size/Length should be 16 bytes.
      --   Precision should be 8 (or 16?).
      --   Scale is the number of digits in the fraction component (SQL Server only allows 0-3).
      buffer <- makeUtcTimeBuffer utc
      bindParam stmt pos direction sqlCTypeTimestamp sqlDTypeTimestamp #{size TIMESTAMP_STRUCT} 9 buffer
      return buffer


---------------------------------------------------------------------
-- Binding with class...

sizeOfMaybe :: forall a. Storable a => Maybe a -> Int
sizeOfMaybe _ = sizeOf ( undefined :: a )
-- H98 stylee...
--sizeOfMaybe v@Nothing = sizeOfMaybe (asTypeOf (Just undefined) v)
--sizeOfMaybe (Just v) = sizeOf v

newtype OutParam a = OutParam a
newtype InOutParam a = InOutParam a

{-
Separate out the two different types of binding: parameter and column.

Both types use the same BindBuffer object, but bind parameters
can send and receive values from the buffer, whereas
column binds only receive values.

So we have class OdbcBindBuffer for result set column binds
(data coming out only), and class OdbcBindParam for bind
parameters that can be both input and output.

We'll have instances for OdbcBindBuffer that are of the form (Maybe a),
where a is one of the normal database types e.g. Int, Double,
String, UTCTime.

The instances for OdbcBindParam will include the (Maybe a) set,
and also (OutParam (Maybe a)), and (InOutParam (Maybe a)),
to indicate Out and In/Out paramaters.

When we do a column buffer bind, we require a dummy value
of the column data type, so that we know which instance to use.
-}

class OdbcBindBuffer a where
  bindColBuffer
    :: StmtHandle  -- ^ stmt handle
    -> Int  -- ^ column position (1-indexed)
    -> Int  -- ^ size of result buffer (ignored when it can be inferred from type of a)
    -> a  -- ^ dummy value of the appropriate type (just to ensure we get the right class instance)
    -> IO BindBuffer  -- ^ returns a 'BindBuffer' object
  getFromBuffer :: BindBuffer -> IO a
  getData :: StmtHandle -> Int -> IO a

instance OdbcBindBuffer (Maybe Int) where
  bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeInt (fromIntegral (sizeOfMaybe val))
  getFromBuffer buffer = getStorableFromBuffer buffer
  getData stmt pos = getDataStorable stmt pos sqlDTypeInt (sizeOf cint) convert
    where convert :: CInt -> Int; convert = fromIntegral
          cint :: CInt; cint = 0

instance OdbcBindBuffer (Maybe Double) where
  bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeDouble (fromIntegral (sizeOfMaybe val))
  getFromBuffer buffer = getStorableFromBuffer buffer
  getData stmt pos = getDataStorable stmt pos sqlDTypeDouble (sizeOf cdbl) convert
    where convert :: CDouble -> Double; convert = realToFrac
          cdbl :: CDouble; cdbl = 0

instance OdbcBindBuffer (Maybe String) where
  bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeString (fromIntegral size)
  getFromBuffer buffer = getUTF8StringFromBuffer buffer
  getData stmt pos = getDataUTF8String stmt pos

instance OdbcBindBuffer (Maybe UTCTime) where
  bindColBuffer stmt pos size val = bindColumnBuffer stmt pos sqlDTypeTimestamp #{size TIMESTAMP_STRUCT}
  getFromBuffer buffer = getUtcTimeFromBuffer buffer
  getData stmt pos = getDataUtcTime stmt pos


class OdbcBindParam a where
  bindParamBuffer
    :: StmtHandle  -- ^ stmt handle
    -> Int  -- ^ parameter position (1-indexed)
    -> a  -- ^ value to write to buffer
    -> Int -- ^ size of buffer, for output.
           -- Value is ignored if input only (buffer will be sized to exactly hold input only)
           -- or size is fixed by type (e.g. Int, Double)
    -> IO BindBuffer  -- ^ returns a 'BindBuffer' object

bindParamStorable stmt pos val dir ctype dtype precn scale = do
  buffer <- createBufferForStorable val
  bindParam stmt pos dir ctype dtype precn scale buffer
  return buffer

instance OdbcBindParam (Maybe Int) where
  bindParamBuffer stmt pos val _ =
    bindParamStorable stmt pos val sqlParamInput sqlCTypeInt sqlDTypeInt 30 0

instance OdbcBindParam (OutParam (Maybe Int)) where
  bindParamBuffer stmt pos (OutParam val) _ =
    bindParamStorable stmt pos val sqlParamOutput sqlCTypeInt sqlDTypeInt 30 0

instance OdbcBindParam (InOutParam (Maybe Int)) where
  bindParamBuffer stmt pos (InOutParam val) _ =
    bindParamStorable stmt pos val sqlParamInputOutput sqlCTypeInt sqlDTypeInt 30 0

instance OdbcBindParam (Maybe Double) where
  bindParamBuffer stmt pos val _ =
    bindParamStorable stmt pos val sqlParamInput sqlCTypeDouble sqlDTypeDouble 50 50

instance OdbcBindParam (OutParam (Maybe Double)) where
  bindParamBuffer stmt pos (OutParam val) _ =
    bindParamStorable stmt pos val sqlParamOutput sqlCTypeDouble sqlDTypeDouble 50 50

instance OdbcBindParam (InOutParam (Maybe Double)) where
  bindParamBuffer stmt pos (InOutParam val) _ =
    bindParamStorable stmt pos val sqlParamInputOutput sqlCTypeDouble sqlDTypeDouble 50 50

instance OdbcBindParam (Maybe String) where
  bindParamBuffer stmt pos val sz =
    bindParamUTF8String stmt pos sqlParamInput val 0

instance OdbcBindParam (OutParam (Maybe String)) where
  bindParamBuffer stmt pos (OutParam val) sz =
    bindParamUTF8String stmt pos sqlParamOutput val sz

instance OdbcBindParam (InOutParam (Maybe String)) where
  bindParamBuffer stmt pos (InOutParam val) sz =
    bindParamUTF8String stmt pos sqlParamInputOutput val sz

instance OdbcBindParam (Maybe UTCTime) where
  bindParamBuffer stmt pos val _ =
    bindParamUtcTime stmt pos sqlParamInput val

instance OdbcBindParam (OutParam (Maybe UTCTime)) where
  bindParamBuffer stmt pos (OutParam val) _ =
    bindParamUtcTime stmt pos sqlParamOutput val

instance OdbcBindParam (InOutParam (Maybe UTCTime)) where
  bindParamBuffer stmt pos (InOutParam val) _ =
    bindParamUtcTime stmt pos sqlParamInputOutput val


---------------------------------------------------------------------
-- FFI

-- From sql.h:
-- SQLRETURN SQL_API SQLAllocHandle(SQLSMALLINT,SQLHANDLE,SQLHANDLE*);
foreign import #{CALLCONV} unsafe "sql.h SQLAllocHandle" sqlAllocHandle ::
  SqlHandleType -> Handle -> Ptr Handle -> IO SqlReturn

-- SQLRETURN SQL_API SQLFreeHandle(SQLSMALLINT,SQLHANDLE);
foreign import #{CALLCONV} unsafe "sql.h SQLFreeHandle" sqlFreeHandle ::
  SqlSmallInt -> Handle -> IO SqlReturn

-- SQLRETURN SQL_API SQLGetDiagRec(SQLSMALLINT,SQLHANDLE,SQLSMALLINT,SQLCHAR*,SQLINTEGER*,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*); 
foreign import #{CALLCONV} unsafe "sql.h SQLGetDiagRec" sqlGetDiagRec ::
  SqlHandleType  -- ^ enum: which handle type is the next parameter?
  -> Handle  -- ^ generic handle ptr
  -> SqlSmallInt  -- ^ row (or message) number
  -> MyCString  -- ^ OUT: state
  -> Ptr SqlInteger  -- ^ OUT: error number
  -> MyCString  -- ^ OUT: error message
  -> SqlSmallInt  -- ^ IN: message buffer size
  -> Ptr SqlSmallInt  -- ^ OUT: message length
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLDriverConnect(SQLHDBC,SQLHWND,SQLCHAR*,SQLSMALLINT,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*,SQLUSMALLINT);
foreign import #{CALLCONV} unsafe "sql.h SQLDriverConnect" sqlDriverConnect ::
  ConnHdl
  -> WindowHandle  -- ^ just pass nullPtr
  -> MyCString  -- ^ connection string
  -> SqlSmallInt  -- ^ connection string size
  -> MyCString  -- ^ OUT: buffer for normalised connection string
  -> SqlSmallInt  -- ^ buffer size
  -> Ptr SqlSmallInt  -- ^ OUT: length of returned string
  -> SqlUSmallInt  -- ^ enum: should driver prompt user for missing info?
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLDisconnect(SQLHDBC);
foreign import #{CALLCONV} unsafe "sql.h SQLDisconnect" sqlDisconnect ::
  ConnHdl -> IO SqlReturn

-- SQLRETURN SQL_API SQLSetEnvAttr(SQLHENV,SQLINTEGER,SQLPOINTER,SQLINTEGER);
foreign import #{CALLCONV} unsafe "sql.h SQLSetEnvAttr" sqlSetEnvAttr ::
  EnvHandle  -- ^ Env Handle
  -> SqlInteger  -- ^ Attribute (enumeration)
  -> Ptr ()  -- ^ value (cast to void*)
  -> SqlInteger  -- ^ ? - set to 0
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLSetConnectAttr(SQLHDBC,SQLINTEGER,SQLPOINTER,SQLINTEGER);
foreign import #{CALLCONV} unsafe "sql.h SQLSetConnectAttr" sqlSetConnectAttr ::
  ConnHdl  -- ^ Connection Handle
  -> SqlInteger  -- ^ Attribute (enumeration)
  -> Ptr ()  -- ^ value (cast to void*)
  -> SqlInteger  -- ^ ? - set to 0
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLPrepare(SQLHSTMT,SQLCHAR*,SQLINTEGER);
foreign import #{CALLCONV} unsafe "sql.h SQLPrepare" sqlPrepare ::
  StmtHdl -> MyCString -> SqlInteger -> IO SqlReturn

-- SQLRETURN SQL_API SQLBindParameter(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLSMALLINT,SQLULEN,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*);
foreign import #{CALLCONV} unsafe "sql.h SQLBindParameter" sqlBindParameter ::
  StmtHdl
  -> SqlUSmallInt  -- ^ position, 1-indexed
  -> SqlParamDirection  -- ^ direction: IN, OUT
  -> SqlCDataType  -- ^ C data type: char, int, long, float, etc
  -> SqlDataType  -- ^ SQL data type: string, int, long, date, etc
  -> SqlULen  -- ^ col size (precision)
  -> SqlSmallInt  -- ^ decimal digits (scale)
  -> Ptr Buffer  -- ^ input+output buffer
  -> SqlLen  -- ^ buffer size
  -> Ptr SqlLen -- ^ input+output data size, or -1 (SQL_NULL_DATA) for null
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLExecute(SQLHSTMT);
foreign import #{CALLCONV} unsafe "sql.h SQLExecute" sqlExecute ::
  StmtHdl -> IO SqlReturn

-- SQLRETURN SQL_API SQLNumResultCols(SQLHSTMT,SQLSMALLINT*);
foreign import #{CALLCONV} unsafe "sql.h SQLNumResultCols" sqlNumResultCols ::
  StmtHdl -> Ptr SqlSmallInt -> IO SqlReturn

-- SQLRETURN SQL_API SQLRowCount(SQLHSTMT,SQLLEN*);
foreign import #{CALLCONV} unsafe "sql.h SQLRowCount" sqlRowCount ::
  StmtHdl -> Ptr SqlLen -> IO SqlReturn

-- SQLRETURN SQL_API SQLDescribeCol(SQLHSTMT,SQLUSMALLINT,SQLCHAR*,SQLSMALLINT,SQLSMALLINT*,SQLSMALLINT*,SQLULEN*,SQLSMALLINT*,SQLSMALLINT*);
foreign import #{CALLCONV} unsafe "sql.h SQLDescribeCol" sqlDescribeCol ::
  StmtHdl
  -> SqlUSmallInt  -- ^ position, 1-indexed
  -> MyCString  -- ^ buffer for column name
  -> SqlSmallInt  -- ^ size of column name buffer
  -> Ptr SqlSmallInt  -- ^ size of column name output string
  -> Ptr SqlDataType  -- ^ SQL data type: string, int, long, date, etc
  -> Ptr SqlULen  -- ^ col size (precision)
  -> Ptr SqlSmallInt  -- ^ decimal digits (scale)
  -> Ptr SqlSmallInt  -- ^ nullable: SQL_NO_NULLS, SQL_NULLABLE, or SQL_NULLABLE_UNKNOWN
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLBindCol(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*);
foreign import #{CALLCONV} unsafe "sql.h SQLBindCol" sqlBindCol ::
  StmtHdl
  -> SqlUSmallInt  -- ^ column position, 1-indexed
  -> SqlDataType  -- ^ SQL data type: string, int, long, date, etc
  -> Ptr Buffer  -- ^ output buffer
  -> SqlLen  -- ^ output buffer size
  -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLFetch(SQLHSTMT);
foreign import #{CALLCONV} unsafe "sql.h SQLFetch" sqlFetch ::
  StmtHdl -> IO SqlReturn

-- SQLRETURN SQL_API SQLGetData(SQLHSTMT,SQLUSMALLINT,SQLSMALLINT,SQLPOINTER,SQLLEN,SQLLEN*);
foreign import #{CALLCONV} unsafe "sql.h SQLGetData" sqlGetData ::
  StmtHdl
  -> SqlUSmallInt  -- ^ column position, 1-indexed
  -> SqlDataType  -- ^ SQL data type: string, int, long, date, etc
  -> Ptr Buffer  -- ^ output buffer
  -> SqlLen  -- ^ output buffer size
  -> Ptr SqlLen -- ^ output data size, or -1 (SQL_NULL_DATA) for null
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLCloseCursor(SQLHSTMT); 
foreign import #{CALLCONV} unsafe "sql.h SQLCloseCursor" sqlCloseCursor ::
  StmtHdl -> IO SqlReturn

-- SQLRETURN SQL_API SQLMoreResults(SQLHSTMT);
foreign import #{CALLCONV} unsafe "sql.h SQLMoreResults" sqlMoreResults ::
  StmtHdl -> IO SqlReturn

-- There's no beginTrans - transactions are started implicitly.
-- SQLRETURN SQL_API SQLEndTran(SQLSMALLINT,SQLHANDLE,SQLSMALLINT);
foreign import #{CALLCONV} unsafe "sql.h SQLEndTran" sqlEndTran ::
  SqlSmallInt -> Handle -> SqlSmallInt -> IO SqlReturn

-- SQLRETURN SQL_API SQLGetInfo(SQLHDBC,SQLUSMALLINT,SQLPOINTER,SQLSMALLINT,SQLSMALLINT*);
foreign import #{CALLCONV} unsafe "sql.h SQLGetInfo" sqlGetInfo ::
  ConnHdl
  -> SqlInfoType  -- ^ information type
  -> Ptr Buffer  -- ^ output buffer
  -> SqlSmallInt  -- ^ output buffer size
  -> Ptr SqlSmallInt -- ^ output data size, or -1 (SQL_NULL_DATA) for null
  -> IO SqlReturn

-- SQLRETURN SQL_API SQLNativeSql(SQLHDBC,SQLCHAR*,SQLINTEGER,SQLCHAR*,SQLINTEGER,SQLINTEGER*);
foreign import #{CALLCONV} unsafe "sql.h SQLNativeSql" sqlNativeSql ::
  ConnHdl
  -> MyCString  -- ^ sql text in
  -> SqlInteger  -- ^ size of sql text
  -> MyCString  -- ^ buffer for output text
  -> SqlInteger  -- ^ size of output buffer
  -> Ptr SqlInteger  -- ^ size of text in output buffer
  -> IO SqlReturn