{-# LINE 1 "Database/HDBC/ODBC/Statement.hsc" #-}
-- -*- mode: haskell; -*-
{-# LINE 2 "Database/HDBC/ODBC/Statement.hsc" #-}
{-# CFILES hdbc-odbc-helper.c #-}
-- Above line for hugs
{-# LANGUAGE EmptyDataDecls #-}

module Database.HDBC.ODBC.Statement (
   fGetQueryInfo,
   newSth,
   fgettables,
   fdescribetable
 ) where

import Database.HDBC.Types
import Database.HDBC
import Database.HDBC.DriverUtils
import Database.HDBC.ODBC.Api.Errors
import Database.HDBC.ODBC.Api.Imports
import Database.HDBC.ODBC.Api.Types
import Database.HDBC.ODBC.Utils
import Database.HDBC.ODBC.Log
import Database.HDBC.ODBC.TypeConv
import Database.HDBC.ODBC.Wrappers

import Foreign.C.String (castCUCharToChar)
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Control.Applicative
import Control.Concurrent.MVar
import Foreign.C.String
import Foreign.Marshal
import Foreign.Storable
import Control.Monad
import Data.Word
import Data.Time.Calendar (fromGregorian)
import Data.Time.LocalTime (TimeOfDay(TimeOfDay), LocalTime(LocalTime))
import Data.Int
import Data.Maybe (catMaybes, fromMaybe)
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8
import qualified Data.ByteString.Unsafe as B
import Unsafe.Coerce (unsafeCoerce)

import System.IO (hPutStrLn, stderr)
import Debug.Trace

import qualified Data.Foldable as F


{-# LINE 52 "Database/HDBC/ODBC/Statement.hsc" #-}

{-# LINE 53 "Database/HDBC/ODBC/Statement.hsc" #-}

{-# LINE 54 "Database/HDBC/ODBC/Statement.hsc" #-}


{-# LINE 58 "Database/HDBC/ODBC/Statement.hsc" #-}

{-# LINE 59 "Database/HDBC/ODBC/Statement.hsc" #-}

{-# LINE 60 "Database/HDBC/ODBC/Statement.hsc" #-}

fGetQueryInfo :: DbcWrapper -> ChildList -> String
              -> IO ([SqlColDesc], [(String, SqlColDesc)])
fGetQueryInfo iconn children query =
    do hdbcTrace "in fGetQueryInfo"
       sstate <- newSState iconn query
       addChild children (wrapStmt sstate)   -- We get error if we forget this one. Not sure why.
       fakeExecute' sstate

fakeExecute' :: SState -> IO ([SqlColDesc], [(String, SqlColDesc)])
fakeExecute' sstate = do
  hdbcTrace "fakeExecute'"
  withStmtOrDie (sstmt sstate) $ \hStmt ->
    withCStringLen (squery sstate) $ \(cquery, cqlen) -> do
      hdbcTrace "fakeExecute' got stmt handle"
      sqlPrepare hStmt cquery (fromIntegral cqlen) >>=
        checkError "fakeExecute' prepare" (StmtHandle hStmt)

      -- parmCount <- getNumParams sthptr
      parmInfo <- fgetparminfo hStmt

      -- rc <- getNumResultCols sthptr
      colInfo <- fgetcolinfo hStmt
      return (parmInfo, colInfo)

-- | The Stament State
data SState = SState
  { sstmt        :: StmtWrapper
  , squery       :: String
  , stmtPrepared :: MVar Bool
  , colinfomv    :: MVar [(String, SqlColDesc)]
  , bindColsMV   :: MVar (Maybe [(BindCol, Ptr Int64)])
{-# LINE 92 "Database/HDBC/ODBC/Statement.hsc" #-}
  }

-- FIXME: we currently do no prepare optimization whatsoever.

newSState :: DbcWrapper -> String -> IO SState
newSState indbo query = SState
  <$> sqlAllocStmt indbo
  <*> pure query
  <*> newMVar False
  <*> newMVar []
  <*> newMVar Nothing

wrapStmt :: SState -> Statement
wrapStmt sstate = Statement
  { execute        = fexecute sstate
  , executeRaw     = return ()
  , executeMany    = fexecutemany sstate
  , finish         = ffinish sstate
  , fetchRow       = ffetchrow sstate
  , originalQuery  = (squery sstate)
  , getColumnNames = readMVar (colinfomv sstate) >>= (return . map fst)
  , describeResult = readMVar (colinfomv sstate)
  }

newSth :: DbcWrapper -> ChildList -> String -> IO Statement
newSth indbo mchildren query =
    do hdbcTrace "in newSth"
       sstate <- newSState indbo query
       let retval = wrapStmt sstate
       addChild mchildren retval
       return retval

fgettables :: DbcWrapper -> IO [String]
fgettables iconn = do
  hdbcTrace "fgettables"
  sstate <- newSState iconn ""
  withStmtOrDie (sstmt sstate) $ \hStmt -> do
    hdbcTrace "fgettables got stmt handle"
    simpleSqlTables hStmt >>= checkError "gettables simpleSqlTables" (StmtHandle hStmt)
    fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)
  results <- fetchAllRows' $ wrapStmt sstate
  return $ map (\x -> fromSql (x !! 2)) results

fdescribetable :: DbcWrapper -> String -> IO [(String, SqlColDesc)]
fdescribetable iconn tablename = do
  hdbcTrace "fdescribetable"
  B.useAsCStringLen (BUTF8.fromString tablename) $ \(cs, csl) -> do
    sstate <- newSState iconn tablename
    withStmtOrDie (sstmt sstate) $ \hStmt -> do
      hdbcTrace "fdescribetable got stmt handle"
      simpleSqlColumns hStmt cs (fromIntegral csl) >>= checkError "fdescribetable simpleSqlColumns" (StmtHandle hStmt)
      fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)
    results <- fetchAllRows' $ wrapStmt sstate
    hdbcTrace $ show results
    return $ map fromOTypeCol results

{- For now, we try to just  handle things as simply as possible.
FIXME lots of room for improvement here (types, etc). -}
fexecute :: SState -> [SqlValue] -> IO Integer
fexecute sstate args = do
  hdbcTrace $ "fexecute: " ++ show (squery sstate) ++ show args
  (finish, result) <- withStmtOrDie (sstmt sstate) $ \hStmt -> do
    hdbcTrace "fexecute got stmt handle"
    -- Realloc the statement
    modifyMVar_ (stmtPrepared sstate) $ \prep -> do
      unless prep $
        B.useAsCStringLen (BUTF8.fromString (squery sstate)) $ \(cquery, cqlen) -> do
          sqlPrepare hStmt cquery (fromIntegral cqlen) >>= checkError "execute prepare" (StmtHandle hStmt)
      return True -- Statement is always prepared after this block completes.

    bindArgs <- zipWithM (bindParam hStmt) args [1..]
    hdbcTrace $ "Ready for sqlExecute: " ++ show (squery sstate) ++ show args
    r <- sqlExecute hStmt
    mapM_ (\(x, y) -> free x >> free y) (catMaybes bindArgs)

    case r of
      100 -> return () -- Update that did nothing
{-# LINE 169 "Database/HDBC/ODBC/Statement.hsc" #-}
      x -> checkError "execute execute" (StmtHandle hStmt) x

    rc <- getNumResultCols hStmt

    case rc of
      0 -> do rowcount <- getSqlRowCount hStmt
              return (True, fromIntegral rowcount)
      colcount -> do fgetcolinfo hStmt >>= swapMVar (colinfomv sstate)
                     return (False, 0)
  when finish $ ffinish sstate
  return result

getNumResultCols :: SQLHSTMT -> IO Int16
{-# LINE 182 "Database/HDBC/ODBC/Statement.hsc" #-}
getNumResultCols sthptr = alloca $ \pcount ->
    do sqlNumResultCols sthptr pcount >>= checkError "SQLNumResultCols"
                                          (StmtHandle sthptr)
       peek pcount

-- Bind a parameter column before execution.
bindParam :: SQLHSTMT -> SqlValue -> Word16
        -> IO (Maybe (Ptr Int64, Ptr CChar))
{-# LINE 190 "Database/HDBC/ODBC/Statement.hsc" #-}
bindParam sthptr arg icol =  alloca $ \pdtype ->
                           alloca $ \pcolsize ->
                           alloca $ \pdecdigits ->
                           alloca $ \pnullable ->
{- We have to start by getting the SQL type of the column so we can
   send the correct type back to the server.  Sigh.  If the ODBC
   backend won't tell us the type, we fake it.

   We've got an annoying situation with error handling.  Must make
   sure that all data is freed, but if there's an error, we have to raise
   it and the caller never gets to freed the allocated data to-date.
   So, make sure we either free of have foreignized everything before
   control passes out of this function. -}

    do hdbcTrace $ "Binding col " ++ show icol ++ ": " ++ show arg
       rc1 <- sqlDescribeParam sthptr icol pdtype pcolsize pdecdigits pnullable
       hdbcTrace $ "rc1 is " ++ show (sqlSucceeded rc1)
       coltype <- if sqlSucceeded rc1 then Just <$> peek pdtype else return Nothing
       colsize <- if sqlSucceeded rc1 then Just <$> peek pcolsize else return Nothing
       decdigits <- if sqlSucceeded rc1 then Just <$> peek pdecdigits else return Nothing
       hdbcTrace $ "Results: " ++ show (coltype, colsize, decdigits)
       case arg of
         SqlNull -> -- NULL parameter, bind it as such.
                    do hdbcTrace "Binding null"
                       rc2 <- sqlBindParameter sthptr (fromIntegral icol)
                              1
{-# LINE 216 "Database/HDBC/ODBC/Statement.hsc" #-}
                              1
{-# LINE 217 "Database/HDBC/ODBC/Statement.hsc" #-}
                              (fromMaybe 1 coltype)
{-# LINE 218 "Database/HDBC/ODBC/Statement.hsc" #-}
                              (fromMaybe 0 colsize)
                              (fromMaybe 0 decdigits)
                              nullPtr 0 nullDataHDBC
                       checkError ("bindparameter NULL " ++ show icol)
                                      (StmtHandle sthptr) rc2
                       return Nothing
         x -> do -- Otherwise, we have to allocate RAM, make sure it's
                 -- not freed now, and pass it along...
                  boundValue <- bindSqlValue x
                  do pcslen <- malloc
                     poke pcslen . fromIntegral $ bvBufferSize boundValue
                     rc2 <- sqlBindParameter sthptr (fromIntegral icol)
                       1
{-# LINE 231 "Database/HDBC/ODBC/Statement.hsc" #-}
                       (bvValueType boundValue)
                       (fromMaybe (bvDefaultColumnType boundValue) coltype)
                       (fromMaybe (bvDefaultColumnSize boundValue) colsize)
                       (fromMaybe (bvDefaultDecDigits boundValue) decdigits)
                       (castPtr $ bvBuffer boundValue)
                       (bvBufferSize boundValue)
                       pcslen
                     if sqlSucceeded rc2
                        then do -- We bound it.  Make foreignPtrs and return.
                                return $ Just (pcslen, castPtr $ bvBuffer boundValue)
                        else do -- Binding failed.  Free the data and raise
                                -- error.
                                free pcslen
                                free (bvBuffer boundValue)
                                checkError ("bindparameter " ++ show icol)
                                               (StmtHandle sthptr) rc2
                                return Nothing -- will never get hit

getSqlRowCount :: SQLHSTMT -> IO Int32
getSqlRowCount cstmt = alloca $ \prows ->
     do sqlRowCount cstmt prows >>= checkError "SQLRowCount" (StmtHandle cstmt)
        peek prows
        --note: As of ODBC-3.52, the row count is only a C int, ie 32bit.

data BoundValue = BoundValue {
  -- | Type of the value in the buffer
    bvValueType         :: !(Int16)
{-# LINE 258 "Database/HDBC/ODBC/Statement.hsc" #-}
  -- | Type of the SQL value to use if ODBC driver doesn't report one
  , bvDefaultColumnType :: !(Int16)
{-# LINE 260 "Database/HDBC/ODBC/Statement.hsc" #-}
  , bvDefaultColumnSize :: !(Word64)
{-# LINE 261 "Database/HDBC/ODBC/Statement.hsc" #-}
  , bvDefaultDecDigits  :: !(Int16)
{-# LINE 262 "Database/HDBC/ODBC/Statement.hsc" #-}
  , bvBuffer            :: !(Ptr ())
  , bvBufferSize        :: !(Int64)
{-# LINE 264 "Database/HDBC/ODBC/Statement.hsc" #-}
  } deriving (Show)

-- | Marshals given SqlValue returning intended ValueType, default ColumnType,
-- and a CStringLen with a buffer containing bound value. Pointer in the CStringLen
-- structure must be freed by caller
bindSqlValue :: SqlValue -> IO BoundValue
bindSqlValue sqlValue = case sqlValue of
  SqlString s -> do
-- GHC for Windows strings are implemented with wchar_t symbols, which are 16-bit UCS-2 and ODBC
-- driver expects exactly that type. On Linux machines things get harder because wchar_t is 32-bit
-- (UTF-32) while ODBC WCHAR might be either 16 or 32 bit. So on Linux we convert our string to
-- UTF-8 and pass it to the driver telling it that we are passing SQL_C_CHAR data for a SQL_WCHAR
-- column and hoping that the driver will convert back from UTF-8 to appropriate representation.

{-# LINE 290 "Database/HDBC/ODBC/Statement.hsc" #-}
    let utf8ByteString = BUTF8.fromString s
    B.unsafeUseAsCStringLen utf8ByteString $ \(unsafeStrPtr, strLen) -> do
      safeStrPtr <- mallocBytes strLen
      copyBytes safeStrPtr unsafeStrPtr strLen
      let result = BoundValue
            { bvValueType         = 1
{-# LINE 296 "Database/HDBC/ODBC/Statement.hsc" #-}
            , bvDefaultColumnType = -8
{-# LINE 297 "Database/HDBC/ODBC/Statement.hsc" #-}
            , bvDefaultColumnSize = fromIntegral strLen
            , bvDefaultDecDigits  = 0
            , bvBuffer            = castPtr safeStrPtr
            , bvBufferSize        = fromIntegral strLen
            }
      hdbcTrace $ "bind SqlString " ++ s ++ ": " ++ show result
      return result

{-# LINE 305 "Database/HDBC/ODBC/Statement.hsc" #-}
  SqlByteString bs -> B.unsafeUseAsCStringLen bs $ \(s,len) -> do
    res <- mallocBytes len
    copyBytes res s len
    let result = BoundValue
          { bvValueType         = -2
{-# LINE 310 "Database/HDBC/ODBC/Statement.hsc" #-}
          , bvDefaultColumnType = -2
{-# LINE 311 "Database/HDBC/ODBC/Statement.hsc" #-}
          , bvDefaultColumnSize = fromIntegral len
          , bvDefaultDecDigits  = 0
          , bvBuffer            = castPtr res
          , bvBufferSize        = fromIntegral len
          }
    hdbcTrace $ "bind SqlByteString " ++ show bs ++ ": " ++ show result
    return $! result
  -- This is rather hacky, I just replicate the behaviour of a previous version
  x -> do
    hdbcTrace $ "bind other " ++ show x
    bsResult <- bindSqlValue $ SqlByteString (fromSql x)
    let result = bsResult
          { bvValueType         = 1
{-# LINE 324 "Database/HDBC/ODBC/Statement.hsc" #-}
          , bvDefaultColumnType = 1
{-# LINE 325 "Database/HDBC/ODBC/Statement.hsc" #-}
          }
    hdbcTrace $ "bound other " ++ show x ++ ": " ++ show result
    return $! result

ffetchrow :: SState -> IO (Maybe [SqlValue])
ffetchrow sstate = do
  result <- withMaybeStmt (sstmt sstate) $ \maybeStmt ->
    case maybeStmt of
      Nothing -> do
        hdbcTrace "ffetchrow: no statement"
        return Nothing
      Just hStmt -> do
        hdbcTrace "ffetchrow"
        bindCols <- getBindCols sstate hStmt
        hdbcTrace "ffetchrow: fetching"
        rc <- sqlFetch hStmt
        if rc == 100
{-# LINE 342 "Database/HDBC/ODBC/Statement.hsc" #-}
          then do
            hdbcTrace "ffetchrow: no more rows"
            return Nothing
          else do
            hdbcTrace "ffetchrow: fetching data"
            checkError "sqlFetch" (StmtHandle hStmt) rc
            sqlValues <- if rc == 0 || rc == 1
{-# LINE 349 "Database/HDBC/ODBC/Statement.hsc" #-}
              then mapM (bindColToSqlValue hStmt) bindCols
              else raiseError "sqlGetData" rc (StmtHandle hStmt)
            return $ Just sqlValues
  case result of
    Just x -> return $ Just x
    Nothing -> do
      ffinish sstate
      return Nothing

getBindCols :: SState -> SQLHSTMT -> IO [(BindCol, Ptr Int64)]
{-# LINE 359 "Database/HDBC/ODBC/Statement.hsc" #-}
getBindCols sstate cstmt = do
  hdbcTrace "getBindCols"
  modifyMVar (bindColsMV sstate) $ \mBindCols ->
    case mBindCols of
      Nothing -> do
        cols <- getNumResultCols cstmt
        pBindCols <- mapM (mkBindCol sstate cstmt) [1 .. cols]
        return (Just pBindCols, pBindCols)
      Just bindCols -> do
        return (mBindCols, bindCols)

-- This is only for String data. For binary fix should be very easy. Just check the column type and use buflen instead of buflen - 1
getLongColData cstmt bindCol = do
   let (BindColString buf bufLen col) = bindCol
   hdbcTrace $ "buflen: " ++ show bufLen
   bs <- B.packCStringLen (buf, fromIntegral (bufLen - 1))
   hdbcTrace $ "sql_no_total col " ++ show (BUTF8.toString bs)
   bs2 <- getRestLongColData cstmt 1 col bs
{-# LINE 377 "Database/HDBC/ODBC/Statement.hsc" #-}
   return $ SqlByteString bs2


getRestLongColData cstmt cBinding icol acc = do
  hdbcTrace "getLongColData"
  alloca $ \plen ->
   allocaBytes colBufSizeMaximum $ \buf ->
     do res <- sqlGetData cstmt (fromIntegral icol) cBinding
                          buf (fromIntegral colBufSizeMaximum) plen
        if res == 0 || res == 1
{-# LINE 387 "Database/HDBC/ODBC/Statement.hsc" #-}
           then do
                len <- peek plen
                if len == 100
{-# LINE 390 "Database/HDBC/ODBC/Statement.hsc" #-}
                   then return acc
                   else do
                        let bufmax = fromIntegral $ colBufSizeMaximum - 1
                        bs <- B.packCStringLen (buf, fromIntegral (if len == -4 || len > bufmax then bufmax else len))
{-# LINE 394 "Database/HDBC/ODBC/Statement.hsc" #-}
                        hdbcTrace $ "sql_no_total col is: " ++ show (BUTF8.toString bs)
                        let newacc = B.append acc bs
                        if len /= -4 && len <= bufmax
{-# LINE 397 "Database/HDBC/ODBC/Statement.hsc" #-}
                           then return newacc
                           else getRestLongColData cstmt cBinding icol newacc
           else  raiseError "sqlGetData" res (StmtHandle cstmt)

-- TODO: This code does not deal well with data that is extremely large,
-- where multiple fetches are required.
getColData cstmt cBinding icol = do
  alloca $ \plen ->
   allocaBytes colBufSizeDefault $ \buf ->
     do res <- sqlGetData cstmt (fromIntegral icol) cBinding
                          buf (fromIntegral colBufSizeDefault) plen
        case res of
          0 ->
{-# LINE 410 "Database/HDBC/ODBC/Statement.hsc" #-}
              do len <- peek plen
                 case len of
                   -1 -> return SqlNull
{-# LINE 413 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -4 -> fail $ "Unexpected SQL_NO_TOTAL"
{-# LINE 414 "Database/HDBC/ODBC/Statement.hsc" #-}
                   _ -> do bs <- B.packCStringLen (buf, fromIntegral len)
                           hdbcTrace $ "col is: " ++ show (BUTF8.toString bs)
                           return (SqlByteString bs)
          1 ->
{-# LINE 418 "Database/HDBC/ODBC/Statement.hsc" #-}
              do len <- peek plen
                 allocaBytes (fromIntegral len + 1) $ \buf2 ->
                   do sqlGetData cstmt (fromIntegral icol) cBinding
                                 buf2 (fromIntegral len + 1) plen
                                 >>= checkError "sqlGetData" (StmtHandle cstmt)
                      len2 <- peek plen
                      let firstbuf = case cBinding of
                                       -2 -> colBufSizeDefault
{-# LINE 426 "Database/HDBC/ODBC/Statement.hsc" #-}
                                       _ -> colBufSizeDefault - 1 -- strip off NUL
                      bs <- liftM2 (B.append) (B.packCStringLen (buf, firstbuf))
                            (B.packCStringLen (buf2, fromIntegral len2))
                      hdbcTrace $ "col is: " ++ (BUTF8.toString bs)
                      return (SqlByteString bs)
          _ -> raiseError "sqlGetData" res (StmtHandle cstmt)

-- | ffetchrowBaseline is used for benchmarking fetches without the
-- overhead of marshalling values.
ffetchrowBaseline sstate = do
  hdbcTrace "ffetchrowBaseline"
  result <- withStmtOrDie (sstmt sstate) $ \hStmt -> do
    hdbcTrace "ffetchrowBaseline got stmt handle"
    rc <- sqlFetch hStmt
    if rc == 100
{-# LINE 441 "Database/HDBC/ODBC/Statement.hsc" #-}
      then return Nothing
      else return (Just [])
  case result of
    Just x -> return $ Just x
    Nothing -> do
      ffinish sstate
      return Nothing

data ColBuf

-- These correspond to the C type identifiers found here:
--     http://msdn.microsoft.com/en-us/library/ms714556(v=VS.85).aspx
-- The Ptr values point to the appropriate C types
data BindCol
  = BindColString  (Ptr CChar) Int64 Word16
{-# LINE 456 "Database/HDBC/ODBC/Statement.hsc" #-}
  | BindColWString (Ptr CWchar) Int64 Word16
{-# LINE 457 "Database/HDBC/ODBC/Statement.hsc" #-}
  | BindColBit     (Ptr CUChar)
  | BindColTinyInt (Ptr CChar)
  | BindColShort   (Ptr CShort)
  | BindColLong    (Ptr CLong)
  | BindColBigInt  (Ptr Int64)
{-# LINE 462 "Database/HDBC/ODBC/Statement.hsc" #-}
  | BindColFloat   (Ptr CFloat)
  | BindColDouble  (Ptr CDouble)
  | BindColBinary  (Ptr CUChar) Int64 Word16
{-# LINE 465 "Database/HDBC/ODBC/Statement.hsc" #-}
  | BindColDate    (Ptr StructDate)
  | BindColTime    (Ptr StructTime)
  | BindColTimestamp (Ptr StructTimestamp)
  | BindColGetData Word16
{-# LINE 469 "Database/HDBC/ODBC/Statement.hsc" #-}


-- Intervals and GUIDs have not been implemented, since there is no
-- equivalent SqlValue for these.
--
--  | BindColInterval
--      typedef struct tagSQL_INTERVAL_STRUCT
--      {
--         SQLINTERVAL interval_type;
--         SQLSMALLINT interval_sign;
--         union {
--               SQL_YEAR_MONTH_STRUCT   year_month;
--               SQL_DAY_SECOND_STRUCT   day_second;
--               } intval;
--      } SQL_INTERVAL_STRUCT;
--      typedef enum
--      {
--         SQL_IS_YEAR = 1,
--         SQL_IS_MONTH = 2,
--         SQL_IS_DAY = 3,
--         SQL_IS_HOUR = 4,
--         SQL_IS_MINUTE = 5,
--         SQL_IS_SECOND = 6,
--         SQL_IS_YEAR_TO_MONTH = 7,
--         SQL_IS_DAY_TO_HOUR = 8,
--         SQL_IS_DAY_TO_MINUTE = 9,
--         SQL_IS_DAY_TO_SECOND = 10,
--         SQL_IS_HOUR_TO_MINUTE = 11,
--         SQL_IS_HOUR_TO_SECOND = 12,
--         SQL_IS_MINUTE_TO_SECOND = 13
--      } SQLINTERVAL;
--
--      typedef struct tagSQL_YEAR_MONTH
--      {
--         SQLUINTEGER year;
--         SQLUINTEGER month;
--      } SQL_YEAR_MONTH_STRUCT;
--
--      typedef struct tagSQL_DAY_SECOND
--      {
--         SQLUINTEGER day;
--         SQLUINTEGER hour;
--         SQLUINTEGER minute;
--         SQLUINTEGER second;
--         SQLUINTEGER fraction;
--      } SQL_DAY_SECOND_STRUCT;
-- | BindColGUID (Ptr StructGUID)


-- | StructDate is used to marshal the DATE_STRUCT
-- This struct, and the ones which follow, are described here:
--     http://msdn.microsoft.com/en-us/library/ms714556(v=VS.85).aspx
data StructDate = StructDate
  Int16   -- year
{-# LINE 523 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- month
{-# LINE 524 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- day
{-# LINE 525 "Database/HDBC/ODBC/Statement.hsc" #-}
 deriving Show

instance Storable StructDate where
  sizeOf _    = (6)
{-# LINE 529 "Database/HDBC/ODBC/Statement.hsc" #-}
  alignment _ = alignment (undefined :: CLong)
  poke p (StructDate year month day) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)  p year
{-# LINE 532 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 2) p month
{-# LINE 533 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4)   p day
{-# LINE 534 "Database/HDBC/ODBC/Statement.hsc" #-}
  peek p = return StructDate
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0)  p)
{-# LINE 536 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 2) p)
{-# LINE 537 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4)   p)
{-# LINE 538 "Database/HDBC/ODBC/Statement.hsc" #-}


-- | StructTime is used to marshals the TIME_STRUCT:
data StructTime = StructTime
  Word16 -- hour
{-# LINE 543 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16 -- minute
{-# LINE 544 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16 -- second
{-# LINE 545 "Database/HDBC/ODBC/Statement.hsc" #-}

instance Storable StructTime where
  sizeOf _    = (6)
{-# LINE 548 "Database/HDBC/ODBC/Statement.hsc" #-}
  alignment _ = alignment (undefined :: CLong)
  poke p (StructTime hour minute second) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)   p hour
{-# LINE 551 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 2) p minute
{-# LINE 552 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) p second
{-# LINE 553 "Database/HDBC/ODBC/Statement.hsc" #-}
  peek p = return StructTime
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0)  p)
{-# LINE 555 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 2) p)
{-# LINE 556 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4)   p)
{-# LINE 557 "Database/HDBC/ODBC/Statement.hsc" #-}

-- | StructTimestamp is used to marshal the TIMESTAMP_STRUCT;
data StructTimestamp = StructTimestamp
  Int16   -- year
{-# LINE 561 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- month
{-# LINE 562 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- day
{-# LINE 563 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- hour
{-# LINE 564 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- minute
{-# LINE 565 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word16  -- second
{-# LINE 566 "Database/HDBC/ODBC/Statement.hsc" #-}
  Word32   -- fraction
{-# LINE 567 "Database/HDBC/ODBC/Statement.hsc" #-}

instance Storable StructTimestamp where
  sizeOf _    = (16)
{-# LINE 570 "Database/HDBC/ODBC/Statement.hsc" #-}
  alignment _ = alignment (undefined :: CLong)
  poke p (StructTimestamp year month day hour minute second fraction) = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)      p year
{-# LINE 573 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 2)     p month
{-# LINE 574 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4)       p day
{-# LINE 575 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 6)      p hour
{-# LINE 576 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8)    p minute
{-# LINE 577 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 10)    p second
{-# LINE 578 "Database/HDBC/ODBC/Statement.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 12)  p fraction
{-# LINE 579 "Database/HDBC/ODBC/Statement.hsc" #-}
  peek p = return StructTimestamp
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 0)     p)
{-# LINE 581 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 2)    p)
{-# LINE 582 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 4)      p)
{-# LINE 583 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 6)     p)
{-# LINE 584 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 8)   p)
{-# LINE 585 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 10)   p)
{-# LINE 586 "Database/HDBC/ODBC/Statement.hsc" #-}
    `ap` ((\hsc_ptr -> peekByteOff hsc_ptr 12) p)
{-# LINE 587 "Database/HDBC/ODBC/Statement.hsc" #-}

-- | StructGUID
-- data StructGUID = StructGUID
--   #{type DWORD}     -- ^ Data1
--   #{type WORD}      -- ^ Data2
--   #{type WORD}      -- ^ Data3
--   [#{type BYTE}]    -- ^ Data4[8]
--
-- instance Storable StructGUID where
--   sizeOf _ = #{size SQLGUID}
--   alignment _ = alignment (undefined :: CLong)
--   poke p (StructGUID data1 data2 data3 data4) = do
--     #{poke SQLGUID, Data1} p data1
--     #{poke SQLGUID, Data2} p data2
--     #{poke SQLGUID, Data3} p data3
--     pokeArray (p `plusPtr` #{offset SQLGUID, Data4}) data4
--   peek p = return StructGUID
--     `ap` (#{peek SQLGUID, Data1} p)
--     `ap` (#{peek SQLGUID, Data2} p)
--     `ap` (#{peek SQLGUID, Data3} p)
--     `ap` (peekArray 8 (p `plusPtr` #{offset SQLGUID, Data4}))


-- | This function binds the data in a column to a value of type
-- BindCol, using the default conversion scheme described here:
--     http://msdn.microsoft.com/en-us/library/ms716298(v=VS.85).aspx
-- The corresponding C types are here:
--     http://msdn.microsoft.com/en-us/library/ms714556(v=VS.85).aspx
-- These values are then ready for fetching.
-- Documentation about SQLBindCol can be found here:
--     http://msdn.microsoft.com/en-us/library/ms711010(v=vs.85).aspx
--
-- Our implementation follows this code:
--     http://publib.boulder.ibm.com/infocenter/iseries/v5r3/index.jsp?topic=%2Fcli%2Frzadpfndecol.htm
-- We have to make use of the column type and length information.
-- These are given by SQLDescribeCol, which is stored in colinfomv.
-- SQLDescribeCol can tell use the data type, and the size of a column (in
-- characters, so add 1 for the null terminator), or the number of decimal
-- digits that can be held.
-- To find out type, and how much memory to allocate, we could also use:
--    SQLColAttribute( ..., SQL_DESC_TYPE , ... )
--    SQLColAttribute( ..., SQL_DESC_OCTET_LENGTH , ... )
--
-- Further examples of how to use SQLBindCol are here, though these make use
-- of SQLDescribeCol:
--     http://msdn.microsoft.com/en-us/library/ms710118(v=vs.85).aspx
-- This implementation makes use of Column-Wise binding. Further improvements
-- might be had by using Row-Wise binding.
mkBindCol :: SState -> SQLHSTMT -> Int16 -> IO (BindCol, Ptr Int64)
{-# LINE 636 "Database/HDBC/ODBC/Statement.hsc" #-}
mkBindCol sstate cstmt col = do
  hdbcTrace "mkBindCol"
  colInfo <- readMVar (colinfomv sstate)
  let colDesc = (snd (colInfo !! ((fromIntegral col) -1)))
  case colType colDesc of
    SqlCharT          -> mkBindColStringEC  cstmt col' (colSize colDesc)
    SqlVarCharT       -> mkBindColStringEC  cstmt col' (colSize colDesc)
    SqlLongVarCharT   -> mkBindColString    cstmt col' (colSize colDesc)
    SqlWCharT         -> mkBindColWStringEC cstmt col' (colSize colDesc)
    SqlWVarCharT      -> mkBindColWStringEC cstmt col' (colSize colDesc)
    SqlWLongVarCharT  -> mkBindColWString   cstmt col' (colSize colDesc)
    SqlDecimalT       -> mkBindColString    cstmt col' (colSize colDesc)
    SqlNumericT       -> mkBindColString    cstmt col' (colSize colDesc)
    SqlBitT           -> mkBindColBit       cstmt col' (colSize colDesc)
    SqlTinyIntT       -> mkBindColTinyInt   cstmt col' (colSize colDesc)
    SqlSmallIntT      -> mkBindColShort     cstmt col' (colSize colDesc)
    SqlIntegerT       -> mkBindColLong      cstmt col' (colSize colDesc)
    SqlBigIntT        -> mkBindColBigInt    cstmt col' (colSize colDesc)
    SqlRealT          -> mkBindColFloat     cstmt col' (colSize colDesc)
    SqlFloatT         -> mkBindColDouble    cstmt col' (colSize colDesc)
    SqlDoubleT        -> mkBindColDouble    cstmt col' (colSize colDesc)
    SqlBinaryT        -> mkBindColBinary    cstmt col' (colSize colDesc)
    SqlVarBinaryT     -> mkBindColBinary    cstmt col' (colSize colDesc)
    SqlLongVarBinaryT -> mkBindColBinary    cstmt col' (colSize colDesc)
    SqlDateT          -> mkBindColDate      cstmt col' (colSize colDesc)
    SqlTimeT          -> mkBindColTime      cstmt col' (colSize colDesc)
    SqlTimestampT     -> mkBindColTimestamp cstmt col' (colSize colDesc)
--    SqlIntervalT i    -> mkBindColInterval  cstmt col' (colSize colDesc) i
--    SqlGUIDT          -> mkBindColGUID      cstmt col' (colSize colDesc)
    _                 -> mkBindColGetData   col'
-- The following are not supported by ODBC:
--    SqlUTCDateTimeT
--    SqlUTCTimeT
--    SqlTimeWithZoneT
--    SqlTimestampWithZoneT
 where
  col' = fromIntegral col

colBufSizeDefault = 1024
colBufSizeMaximum = 4096

utf8EncodingMaximum = 6
wcSize = 2

-- The functions that follow do the marshalling from C into a Haskell type
mkBindColString cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColString"
  let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize
  let bufLen  = sizeOf (undefined :: CChar) * (colSize + 1)
  buf     <- mallocBytes bufLen
  pStrLen <- malloc
  sqlBindCol cstmt col (1) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 688 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColString buf (fromIntegral bufLen) col, pStrLen)
mkBindColStringEC cstmt col = mkBindColString cstmt col . fmap (* utf8EncodingMaximum)
mkBindColWString cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColWString"
  let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize
  let bufLen  = sizeOf (undefined :: CWchar) * (colSize + 1)
  buf     <- mallocBytes bufLen
  pStrLen <- malloc
  sqlBindCol cstmt col (1) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 697 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColWString buf (fromIntegral bufLen) col, pStrLen)
mkBindColWStringEC cstmt col = mkBindColString cstmt col . fmap extendFactor  where
  extendFactor sz = sz * ((utf8EncodingMaximum + wcSize - 1) `quot` wcSize)
mkBindColBit cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColBit"
  let bufLen  = sizeOf (undefined :: CChar)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (-7) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 706 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColBit buf, pStrLen)
mkBindColTinyInt cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColTinyInt"
  let bufLen  = sizeOf (undefined :: CUChar)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (-26) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 713 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColTinyInt buf, pStrLen)
mkBindColShort cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColShort"
  let bufLen  = sizeOf (undefined :: CShort)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (-15) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 720 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColShort buf, pStrLen)
mkBindColLong cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColSize"
  let bufLen  = sizeOf (undefined :: CLong)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (-16) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 727 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColLong buf, pStrLen)
mkBindColBigInt cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColBigInt"
  let bufLen  = sizeOf (undefined :: CInt)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (-25) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 734 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColBigInt buf, pStrLen)
mkBindColFloat cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColFloat"
  let bufLen  = sizeOf (undefined :: CFloat)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (7) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 741 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColFloat buf, pStrLen)
mkBindColDouble cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColDouble"
  let bufLen  = sizeOf (undefined :: CDouble)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (8) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 748 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColDouble buf, pStrLen)
mkBindColBinary cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColBinary"
  let colSize = min colBufSizeMaximum $ fromMaybe colBufSizeDefault mColSize
  let bufLen  = sizeOf (undefined :: CUChar) * (colSize + 1)
  buf     <- mallocBytes bufLen
  pStrLen <- malloc
  sqlBindCol cstmt col (-2) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 756 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColBinary buf (fromIntegral bufLen) col, pStrLen)
mkBindColDate cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColDate"
  let bufLen = sizeOf (undefined :: StructDate)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (91) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 763 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColDate buf, pStrLen)
mkBindColTime cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColTime"
  let bufLen = sizeOf (undefined :: StructTime)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (92) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 770 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColTime buf, pStrLen)
mkBindColTimestamp cstmt col mColSize = do
  hdbcTrace "mkBindCol: BindColTimestamp"
  let bufLen = sizeOf (undefined :: StructTimestamp)
  buf     <- malloc
  pStrLen <- malloc
  sqlBindCol cstmt col (93) (castPtr buf) (fromIntegral bufLen) pStrLen
{-# LINE 777 "Database/HDBC/ODBC/Statement.hsc" #-}
  return (BindColTimestamp buf, pStrLen)
mkBindColGetData col = do
  hdbcTrace "mkBindCol: BindColGetData"
  return (BindColGetData col, nullPtr)

freeBindCol :: BindCol -> IO ()
freeBindCol (BindColString   buf _ _) = free buf
freeBindCol (BindColWString  buf _ _) = free buf
freeBindCol (BindColBit      buf) = free buf
freeBindCol (BindColTinyInt  buf) = free buf
freeBindCol (BindColShort    buf) = free buf
freeBindCol (BindColLong     buf) = free buf
freeBindCol (BindColBigInt   buf) = free buf
freeBindCol (BindColFloat    buf) = free buf
freeBindCol (BindColDouble   buf) = free buf
freeBindCol (BindColBinary   buf _ _) = free buf
freeBindCol (BindColDate     buf) = free buf
freeBindCol (BindColTime     buf) = free buf
freeBindCol (BindColTimestamp buf) = free buf
freeBindCol (BindColGetData  _ )   = return ()

-- | This assumes that SQL_ATTR_MAX_LENGTH is set to zero, otherwise, we
-- cannot detect truncated columns. See "returning Data in Bound Columns":
--     http://msdn.microsoft.com/en-us/library/ms712424(v=vs.85).aspx
-- Also note that the strLen value of SQL_NTS denotes a null terminated string,
-- but is only valid as input, so we don't make use of it here:
--     http://msdn.microsoft.com/en-us/library/ms713532(v=VS.85).aspx
bindColToSqlValue :: SQLHSTMT -> (BindCol, Ptr Int64) -> IO SqlValue
{-# LINE 805 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue pcstmt (BindColGetData col, _) = do
  hdbcTrace "bindColToSqlValue: BindColGetData"
  getColData pcstmt 1 col
{-# LINE 808 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue pcstmt (bindCol, pStrLen) = do
  hdbcTrace "bindColToSqlValue"
  strLen <- peek pStrLen
  case strLen of
    -1 -> return SqlNull
{-# LINE 813 "Database/HDBC/ODBC/Statement.hsc" #-}
    -4  -> getLongColData pcstmt bindCol
{-# LINE 814 "Database/HDBC/ODBC/Statement.hsc" #-}
    _                      -> bindColToSqlValue' pcstmt bindCol strLen

-- | This is a worker function for `bindcolToSqlValue`. Note that the case
-- where the data is null should already be handled by this stage.
bindColToSqlValue' :: SQLHSTMT -> BindCol -> Int64 -> IO SqlValue
{-# LINE 819 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue' pcstmt (BindColString buf bufLen col) strLen
  | bufLen >= strLen = do
      bs <- B.packCStringLen (buf, fromIntegral strLen)
      hdbcTrace $ "bindColToSqlValue BindColString " ++ show bs ++ " " ++ show strLen
      return $ SqlByteString bs
  | otherwise = getColData pcstmt 1 col
{-# LINE 825 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue' pcstmt (BindColWString buf bufLen col) strLen
  | bufLen >= strLen = do
      bs <- B.packCStringLen (castPtr buf, fromIntegral strLen)
      hdbcTrace $ "bindColToSqlValue BindColWString " ++ show bs ++ " " ++ show strLen
      return $ SqlByteString bs
  | otherwise = getColData pcstmt 1 col
{-# LINE 831 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue' _ (BindColBit     buf) strLen = do
  bit <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColBit " ++ show bit
  return $ SqlChar (castCUCharToChar bit)
bindColToSqlValue' _ (BindColTinyInt buf) strLen = do
  tinyInt <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColTinyInt " ++ show tinyInt
  return $ SqlChar (castCCharToChar tinyInt)
bindColToSqlValue' _ (BindColShort   buf) strLen = do
  short <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColShort" ++ show short
  return $ SqlInt32 (fromIntegral short)
bindColToSqlValue' _ (BindColLong    buf) strLen = do
  long <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColLong " ++ show long
  return $ SqlInt32 (fromIntegral long)
bindColToSqlValue' _ (BindColBigInt  buf) strLen = do
  bigInt <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColBigInt " ++ show bigInt
  return $ SqlInt64 (fromIntegral bigInt)
bindColToSqlValue' _ (BindColFloat   buf) strLen = do
  float <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColFloat " ++ show float
  return $ SqlDouble (realToFrac float)
bindColToSqlValue' _ (BindColDouble  buf) strLen = do
  double <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColDouble " ++ show double
  return $ SqlDouble (realToFrac double)
bindColToSqlValue' pcstmt (BindColBinary  buf bufLen col) strLen
  | bufLen >= strLen = do
      bs <- B.packCStringLen (castPtr buf, fromIntegral strLen)
      hdbcTrace $ "bindColToSqlValue BindColBinary " ++ show bs
      return $ SqlByteString bs
  | otherwise = getColData pcstmt (-2) col
{-# LINE 865 "Database/HDBC/ODBC/Statement.hsc" #-}
bindColToSqlValue' _ (BindColDate buf) strLen = do
  StructDate year month day <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColDate"
  return $ SqlLocalDate $ fromGregorian
    (fromIntegral year) (fromIntegral month) (fromIntegral day)
bindColToSqlValue' _ (BindColTime buf) strLen = do
  StructTime hour minute second <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColTime"
  return $ SqlLocalTimeOfDay $ TimeOfDay
    (fromIntegral hour) (fromIntegral minute) (fromIntegral second)
bindColToSqlValue' _ (BindColTimestamp buf) strLen = do
  StructTimestamp year month day hour minute second nanosecond <- peek buf
  hdbcTrace $ "bindColToSqlValue BindColTimestamp"
  return $ SqlLocalTime $ LocalTime
    (fromGregorian (fromIntegral year) (fromIntegral month) (fromIntegral day))
    (TimeOfDay (fromIntegral hour) (fromIntegral minute)
    (fromIntegral second + (fromIntegral nanosecond / 1000000000)))
bindColToSqlValue' _ (BindColGetData _) _ =
  error "bindColToSqlValue': unexpected BindColGetData!"

fgetcolinfo :: SQLHSTMT -> IO [(String, SqlColDesc)]
fgetcolinfo cstmt =
    do ncols <- getNumResultCols cstmt
       mapM getname [1..ncols]
    where getname icol = alloca $ \colnamelp ->
                         allocaBytes 128 $ \cscolname ->
                         alloca $ \datatypeptr ->
                         alloca $ \colsizeptr ->
                         alloca $ \nullableptr ->
              do sqlDescribeCol cstmt icol cscolname 127 colnamelp
                                datatypeptr colsizeptr nullPtr nullableptr
                 colnamelen <- peek colnamelp
                 colnamebs <- B.packCStringLen (cscolname, fromIntegral colnamelen)
                 let colname = BUTF8.toString colnamebs
                 datatype <- peek datatypeptr
                 colsize <- peek colsizeptr
                 nullable <- peek nullableptr
                 return $ fromOTypeInfo colname datatype colsize nullable

-- FIXME: needs a faster algorithm.
fexecutemany :: SState -> [[SqlValue]] -> IO ()
fexecutemany sstate arglist =
    mapM_ (fexecute sstate) arglist >> return ()

freeBoundCols :: SState -> IO ()
freeBoundCols sstate = modifyMVar_ (bindColsMV sstate) $ \maybeBindCols -> do
    F.mapM_ go maybeBindCols
    return Nothing
  where
    go bindCols = do
      hdbcTrace "freeBoundCols"
      mapM_ (\(bindCol, pSqlLen) -> freeBindCol bindCol >> free pSqlLen) bindCols

ffinish :: SState -> IO ()
ffinish sstate = do
  hdbcTrace "ffinish"
  withMaybeStmt (sstmt sstate) $ F.mapM_ $ \hStmt -> do
    c_sqlFreeStmt hStmt sQL_CLOSE >>= checkError "fexecute c_sqlFreeStmt sQL_CLOSE" (StmtHandle hStmt)
    c_sqlFreeStmt hStmt sQL_UNBIND >>= checkError "fexecute c_sqlFreeStmt sQL_UNBIND" (StmtHandle hStmt)
    c_sqlFreeStmt hStmt sQL_RESET_PARAMS >>= checkError "fexecute c_sqlFreeStmt sQL_RESET_PARAMS" (StmtHandle hStmt)
  freeBoundCols sstate

ffinalize :: SState -> IO ()
ffinalize sstate = do
  ffinish sstate
  freeStmtIfNotAlready $ sstmt sstate

foreign import ccall safe "sql.h SQLDescribeCol"
{-# LINE 933 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlDescribeCol :: SQLHSTMT
                 -> Int16 -- ^ Column number
{-# LINE 935 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> CString     -- ^ Column name
                 -> Int16 -- ^ Buffer length
{-# LINE 937 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> Ptr (Int16) -- ^ name length ptr
{-# LINE 938 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> Ptr (Int16) -- ^ data type ptr
{-# LINE 939 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> Ptr (Word64) -- ^ column size ptr
{-# LINE 940 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> Ptr (Int16) -- ^ decimal digits ptr
{-# LINE 941 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> Ptr (Int16) -- ^ nullable ptr
{-# LINE 942 "Database/HDBC/ODBC/Statement.hsc" #-}
                 -> IO Int16
{-# LINE 943 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLGetData"
{-# LINE 945 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlGetData :: SQLHSTMT       -- ^ statement handle
             -> Word16 -- ^ Column number
{-# LINE 947 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> Int16 -- ^ target type
{-# LINE 948 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> CString -- ^ target value pointer (void * in C)
             -> Int64 -- ^ buffer len
{-# LINE 950 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> Ptr (Int64)
{-# LINE 951 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> IO Int16
{-# LINE 952 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLBindCol"
{-# LINE 954 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlBindCol :: SQLHSTMT            -- ^ statement handle
             -> Word16 -- ^ Column number
{-# LINE 956 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> Int16  -- ^ target type
{-# LINE 957 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> Ptr ColBuf           -- ^ target value pointer (void * in C)
             -> Int64       -- ^ buffer len
{-# LINE 959 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> Ptr (Int64) -- ^ strlen_or_indptr
{-# LINE 960 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> IO Int16
{-# LINE 961 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLPrepare"
{-# LINE 963 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlPrepare :: SQLHSTMT -> CString -> Int32
{-# LINE 964 "Database/HDBC/ODBC/Statement.hsc" #-}
             -> IO Int16
{-# LINE 965 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLExecute"
{-# LINE 967 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlExecute :: SQLHSTMT -> IO Int16
{-# LINE 968 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLNumResultCols"
{-# LINE 970 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlNumResultCols :: SQLHSTMT -> Ptr Int16
{-# LINE 971 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> IO Int16
{-# LINE 972 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLRowCount"
{-# LINE 974 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlRowCount :: SQLHSTMT -> Ptr Int32 -> IO Int16
{-# LINE 975 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLBindParameter"
{-# LINE 977 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlBindParameter :: SQLHSTMT -- ^ Statement handle
                   -> Word16 -- ^ Parameter Number
{-# LINE 979 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Int16 -- ^ Input or output
{-# LINE 980 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Int16 -- ^ Value type
{-# LINE 981 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Int16 -- ^ Parameter type
{-# LINE 982 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Word64 -- ^ column size
{-# LINE 983 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Int16 -- ^ decimal digits
{-# LINE 984 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> CString   -- ^ Parameter value pointer
                   -> Int64 -- ^ buffer length
{-# LINE 986 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Ptr Int64 -- ^ strlen_or_indptr
{-# LINE 987 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> IO Int16
{-# LINE 988 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "hdbc-odbc-helper.h &nullDataHDBC"
  nullDataHDBC :: Ptr Int64
{-# LINE 991 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLDescribeParam"
{-# LINE 993 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlDescribeParam :: SQLHSTMT
                   -> Word16 -- ^ parameter number
{-# LINE 995 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Ptr Int16 -- ^ data type ptr
{-# LINE 996 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Ptr Word64 -- ^ parameter size ptr
{-# LINE 997 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Ptr Int16 -- ^ dec digits ptr
{-# LINE 998 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> Ptr Int16 -- ^ nullable ptr
{-# LINE 999 "Database/HDBC/ODBC/Statement.hsc" #-}
                   -> IO Int16
{-# LINE 1000 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "sql.h SQLFetch"
{-# LINE 1002 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlFetch :: SQLHSTMT -> IO Int16
{-# LINE 1003 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "hdbc-odbc-helper.h simpleSqlTables"
  simpleSqlTables :: SQLHSTMT -> IO Int16
{-# LINE 1006 "Database/HDBC/ODBC/Statement.hsc" #-}

foreign import ccall safe "hdbc-odbc-helper.h simpleSqlColumns"
  simpleSqlColumns :: SQLHSTMT -> Ptr CChar ->
                      Int16 -> IO Int16
{-# LINE 1010 "Database/HDBC/ODBC/Statement.hsc" #-}

fgetparminfo :: SQLHSTMT -> IO [SqlColDesc]
fgetparminfo cstmt =
    do ncols <- getNumParams cstmt
       mapM getname [1..ncols]
    where getname icol = -- alloca $ \colnamelp ->
                         -- allocaBytes 128 $ \cscolname ->
                         alloca $ \datatypeptr ->
                         alloca $ \colsizeptr ->
                         alloca $ \nullableptr ->
              do poke datatypeptr 127 -- to test if sqlDescribeParam actually writes something to the area
                 res <- sqlDescribeParam cstmt (fromInteger $ toInteger icol) -- cscolname 127 colnamelp
                                  datatypeptr colsizeptr nullPtr nullableptr
                 putStrLn $ show res
                 -- We need proper error handling here. Not all ODBC drivers supports SQLDescribeParam.
                 -- Not supporting SQLDescribeParam is quite allright according to the ODBC standard.
                 datatype <- peek datatypeptr
                 colsize  <- peek colsizeptr
                 nullable <- peek nullableptr
                 return $ snd $ fromOTypeInfo "" datatype colsize nullable

getNumParams :: SQLHSTMT -> IO Int16
getNumParams sthptr = alloca $ \pcount ->
    do sqlNumParams sthptr pcount >>= checkError "SQLNumResultCols"
                                          (StmtHandle sthptr)
       peek pcount

foreign import ccall safe "sql.h SQLNumParams"
{-# LINE 1038 "Database/HDBC/ODBC/Statement.hsc" #-}
  sqlNumParams :: SQLHSTMT -> Ptr Int16
{-# LINE 1039 "Database/HDBC/ODBC/Statement.hsc" #-}
               -> IO Int16
{-# LINE 1040 "Database/HDBC/ODBC/Statement.hsc" #-}