{-# LINE 1 "DB/HSQL/MySQL/Functions.hsc" #-}
module DB.HSQL.MySQL.Functions where
{-# LINE 2 "DB/HSQL/MySQL/Functions.hsc" #-}

import Foreign((.&.),peekByteOff,nullPtr,peekElemOff)
import Foreign.C(CInt(..),CString,peekCString)
import Control.Concurrent.MVar(MVar,newMVar,modifyMVar,readMVar)
import Control.Exception (throw)
import Control.Monad(when)

import Database.HSQL.Types(ColDef,Statement(..),Connection(..),SqlError(..))
import DB.HSQL.MySQL.Type(MYSQL,MYSQL_RES,MYSQL_FIELD,MYSQL_ROW,MYSQL_LENGTHS
                         ,mkSqlType)


{-# LINE 14 "DB/HSQL/MySQL/Functions.hsc" #-}


{-# LINE 18 "DB/HSQL/MySQL/Functions.hsc" #-}

{-# LINE 19 "DB/HSQL/MySQL/Functions.hsc" #-}

{-# LINE 20 "DB/HSQL/MySQL/Functions.hsc" #-}

-- |
foreign import ccall "HsMySQL.h mysql_init"
{-# LINE 23 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_init :: MYSQL -> IO MYSQL

foreign import ccall "HsMySQL.h mysql_real_connect"
{-# LINE 26 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_real_connect :: MYSQL -> CString -> CString -> CString -> CString -> CInt -> CString -> CInt -> IO MYSQL

foreign import ccall "HsMySQL.h mysql_close"
{-# LINE 29 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_close :: MYSQL -> IO ()

foreign import ccall "HsMySQL.h mysql_errno"
{-# LINE 32 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_errno :: MYSQL -> IO CInt

foreign import ccall "HsMySQL.h mysql_error"
{-# LINE 35 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_error :: MYSQL -> IO CString

foreign import ccall "HsMySQL.h mysql_query"
{-# LINE 38 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_query :: MYSQL -> CString -> IO CInt

foreign import ccall "HsMySQL.h mysql_use_result"
{-# LINE 41 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_use_result :: MYSQL -> IO MYSQL_RES

foreign import ccall "HsMySQL.h mysql_fetch_field"
{-# LINE 44 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_fetch_field :: MYSQL_RES -> IO MYSQL_FIELD

foreign import ccall "HsMySQL.h mysql_free_result"
{-# LINE 47 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_free_result :: MYSQL_RES -> IO ()

foreign import ccall "HsMySQL.h mysql_fetch_row"
{-# LINE 50 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_fetch_row :: MYSQL_RES -> IO MYSQL_ROW

foreign import ccall "HsMySQL.h mysql_fetch_lengths"
{-# LINE 53 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_fetch_lengths :: MYSQL_RES -> IO MYSQL_LENGTHS

foreign import ccall "HsMySQL.h mysql_list_tables"
{-# LINE 56 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_list_tables :: MYSQL -> CString -> IO MYSQL_RES

foreign import ccall "HsMySQL.h mysql_list_fields"
{-# LINE 59 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_list_fields :: MYSQL -> CString -> CString -> IO MYSQL_RES

foreign import ccall "HsMySQL.h mysql_next_result"
{-# LINE 62 "DB/HSQL/MySQL/Functions.hsc" #-}
  mysql_next_result :: MYSQL -> IO CInt

-- |
withStatement :: Connection -> MYSQL -> MYSQL_RES -> IO Statement
withStatement conn pMYSQL pRes = do
  currRow  <- newMVar (nullPtr, nullPtr)
  refFalse <- newMVar False
  if (pRes == nullPtr)
    then do
      errno <- mysql_errno pMYSQL
      when (errno /= 0) (handleSqlError pMYSQL)
      return Statement { stmtConn   = conn
		       , stmtClose  = return ()
		       , stmtFetch  = fetch pRes currRow
		       , stmtGetCol = getColValue currRow
		       , stmtFields = []
		       , stmtClosed = refFalse }
    else do
      fieldDefs <- getFieldDefs pRes
      return Statement { stmtConn   = conn
		       , stmtClose  = mysql_free_result pRes
		       , stmtFetch  = fetch pRes currRow
		       , stmtGetCol = getColValue currRow
		       , stmtFields = fieldDefs
		       , stmtClosed = refFalse }

-- |
getColValue :: MVar (MYSQL_ROW, MYSQL_LENGTHS) 
            -> Int 
            -> ColDef 
            -> (ColDef -> CString -> Int -> IO a) 
            -> IO a
getColValue currRow colNumber fieldDef f = do
  (row, lengths) <- readMVar currRow
  pValue <- peekElemOff row colNumber
  len <- fmap fromIntegral (peekElemOff lengths colNumber)
  f fieldDef pValue len

-- |
getFieldDefs pRes = do
  pField <- mysql_fetch_field pRes
  if pField == nullPtr
    then return []
    else do
      name <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) pField >>= peekCString
{-# LINE 107 "DB/HSQL/MySQL/Functions.hsc" #-}
      dataType <-  ((\hsc_ptr -> peekByteOff hsc_ptr 112)) pField
{-# LINE 108 "DB/HSQL/MySQL/Functions.hsc" #-}
      columnSize <-  ((\hsc_ptr -> peekByteOff hsc_ptr 56)) pField
{-# LINE 109 "DB/HSQL/MySQL/Functions.hsc" #-}
      flags <-  ((\hsc_ptr -> peekByteOff hsc_ptr 100)) pField
{-# LINE 110 "DB/HSQL/MySQL/Functions.hsc" #-}
      decimalDigits <-  ((\hsc_ptr -> peekByteOff hsc_ptr 104)) pField
{-# LINE 111 "DB/HSQL/MySQL/Functions.hsc" #-}
      let sqlType = mkSqlType dataType columnSize decimalDigits
      defs <- getFieldDefs pRes
      return ( (name,sqlType,((flags :: Int) .&. (1)) == 0)
{-# LINE 114 "DB/HSQL/MySQL/Functions.hsc" #-}
             : defs )

-- |
fetch :: MYSQL_RES 
      -> MVar (MYSQL_ROW, MYSQL_LENGTHS) 
      -> IO Bool
fetch pRes currRow
    | pRes == nullPtr = return False
    | otherwise = modifyMVar currRow $ \(pRow, pLengths) -> do
	pRow <- mysql_fetch_row pRes
	pLengths <- mysql_fetch_lengths pRes
	return ((pRow, pLengths), pRow /= nullPtr)

-- |
mysqlDefaultConnectFlags:: CInt
mysqlDefaultConnectFlags = 65536
{-# LINE 130 "DB/HSQL/MySQL/Functions.hsc" #-}

------------------------------------------------------------------------------
-- routines for handling exceptions
------------------------------------------------------------------------------
-- |
handleSqlError :: MYSQL -> IO a
handleSqlError pMYSQL = do
	errno <- mysql_errno pMYSQL
	errMsg <- mysql_error pMYSQL >>= peekCString
	throw (SqlError "" (fromIntegral errno) errMsg)

