{-# LINE 1 "Database/HDBC/ODBC/Utils.hsc" #-}
{- -*- mode: haskell; -*- 
{-# LINE 2 "Database/HDBC/ODBC/Utils.hsc" #-}
-}

module Database.HDBC.ODBC.Utils where
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Ptr
import Data.Int
import Database.HDBC(throwSqlError)
import Database.HDBC.Types
import Database.HDBC.ODBC.Types
import Foreign.C.Types
import Control.Exception
import Foreign.Storable
import Foreign.Marshal.Array
import Foreign.Marshal.Alloc
import Data.Word
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8


{-# LINE 24 "Database/HDBC/ODBC/Utils.hsc" #-}

{-# LINE 25 "Database/HDBC/ODBC/Utils.hsc" #-}


{-# LINE 29 "Database/HDBC/ODBC/Utils.hsc" #-}

{-# LINE 30 "Database/HDBC/ODBC/Utils.hsc" #-}

{-# LINE 31 "Database/HDBC/ODBC/Utils.hsc" #-}

data SqlHandleT = EnvHandle (Ptr CEnv)
               | DbcHandle (Ptr CConn)
               | StmtHandle (Ptr CStmt)

checkError :: String -> SqlHandleT -> Int16 -> IO ()
{-# LINE 37 "Database/HDBC/ODBC/Utils.hsc" #-}
checkError msg o res =
        do let rc = sqlSucceeded res
           if rc == 0
               then raiseError msg res o
               else return ()

raiseError :: String -> Int16 -> SqlHandleT -> IO a
{-# LINE 44 "Database/HDBC/ODBC/Utils.hsc" #-}
raiseError msg code cconn =
    do info <- getdiag ht hp 1 
       throwSqlError $ SqlError {seState = show (map fst info),
                                 seNativeError = fromIntegral code,
                                 seErrorMsg = msg ++ ": " ++  
                                         show (map snd info)}
       where (ht, hp::(Ptr ())) = case cconn of
                          EnvHandle c -> (1, castPtr c)
{-# LINE 52 "Database/HDBC/ODBC/Utils.hsc" #-}
                          DbcHandle c -> (2, castPtr c)
{-# LINE 53 "Database/HDBC/ODBC/Utils.hsc" #-}
                          StmtHandle c -> (3, castPtr c)
{-# LINE 54 "Database/HDBC/ODBC/Utils.hsc" #-}
             getdiag ht hp irow = allocaBytes 6 $ \csstate ->
                                  alloca $ \pnaterr ->
                                  allocaBytes 1025 $ \csmsg ->
                                  alloca $ \pmsglen ->
                 do ret <- sqlGetDiagRec ht hp irow csstate pnaterr
                           csmsg 1024 pmsglen
                    if sqlSucceeded ret == 0
                       then return []
                       else do state <- peekCStringLen (csstate, 5)
                               nat <- peek pnaterr
                               msglen <- peek pmsglen
                               msgbs <- B.packCStringLen (csmsg,
                                                          fromIntegral msglen)
                               let msg = BUTF8.toString msgbs
                               next <- getdiag ht hp (irow + 1)
                               return $ (state, 
                                         (show nat) ++ ": " ++ msg) : next

{- This is a little hairy.

We have a Conn object that is actually a finalizeonce wrapper around
the real object.  We use withConn to dereference the foreign pointer,
and then extract the pointer to the real object from the finalizeonce struct.

But, when we close the connection, we need the finalizeonce struct, so that's
done by withRawConn.

Ditto for statements. -}

withConn :: Conn -> (Ptr CConn -> IO b) -> IO b
withConn = genericUnwrap

withRawConn :: Conn -> (Ptr WrappedCConn -> IO b) -> IO b
withRawConn = withForeignPtr

withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b
withStmt = genericUnwrap

withRawStmt :: Stmt -> (Ptr WrappedCStmt -> IO b) -> IO b
withRawStmt = withForeignPtr

withEnv :: Env -> (Ptr CEnv -> IO b) -> IO b
withEnv = genericUnwrap

withRawEnv :: Env -> (Ptr WrappedCEnv -> IO b) -> IO b
withRawEnv = withForeignPtr

withAnyArr0 :: (a -> IO (Ptr b)) -- ^ Function that transforms input data into pointer
            -> (Ptr b -> IO ())  -- ^ Function that frees generated data
            -> [a]               -- ^ List of input data
            -> (Ptr (Ptr b) -> IO c) -- ^ Action to run with the C array
            -> IO c             -- ^ Return value
withAnyArr0 input2ptract freeact inp action =
    bracket (mapM input2ptract inp)
            (\clist -> mapM_ freeact clist)
            (\clist -> withArray0 nullPtr clist action)


genericUnwrap :: ForeignPtr (Ptr a) -> (Ptr a -> IO b) -> IO b
genericUnwrap fptr action = withForeignPtr fptr (\structptr ->
    do objptr <- (\hsc_ptr -> peekByteOff hsc_ptr 0) structptr
{-# LINE 115 "Database/HDBC/ODBC/Utils.hsc" #-}
       action objptr
                                                )
isOK :: Int16 -> Bool
{-# LINE 118 "Database/HDBC/ODBC/Utils.hsc" #-}
isOK r = sqlSucceeded r /= 0

foreign import ccall safe "sqlSucceeded"
  sqlSucceeded :: Int16 -> CInt
{-# LINE 122 "Database/HDBC/ODBC/Utils.hsc" #-}

foreign import ccall safe "sql.h SQLGetDiagRec"
{-# LINE 124 "Database/HDBC/ODBC/Utils.hsc" #-}
  sqlGetDiagRec :: Int16 -> Ptr () -> 
{-# LINE 125 "Database/HDBC/ODBC/Utils.hsc" #-}
                   Int16 -> CString -> Ptr (Int32)
{-# LINE 126 "Database/HDBC/ODBC/Utils.hsc" #-}
                   -> CString -> Int16 
{-# LINE 127 "Database/HDBC/ODBC/Utils.hsc" #-}
                   -> Ptr (Int16) -> IO Int16
{-# LINE 128 "Database/HDBC/ODBC/Utils.hsc" #-}