{-# LANGUAGE DeriveDataTypeable, ForeignFunctionInterface, RecordWildCards #-}

-- |
-- Module:      Database.MySQL.Base
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Paul Rouse <[email protected]>
-- Stability:   experimental
-- Portability: portable
--
-- A low-level client library for the MySQL database, implemented as
-- bindings to the C @mysqlclient@ API.
--
-- The C library is thread-safe, but uses thread-local state.  Therefore,
-- if these bindings are used in a multi-threaded program, "bound" threads
-- should be used (see "Control.Concurrent").  In addition, explicit calls
-- to 'initLibrary', and possibly 'initThread' and 'endThread' may be needed
-- in a multi-threaded program.

module Database.MySQL.Base
    (
    -- * Licensing
    -- $license
    -- * Resource management
    -- $mgmt
    -- * Types
      ConnectInfo(..)
    , SSLInfo(..)
    , Seconds
    , Protocol(..)
    , Option(..)
    , defaultConnectInfo
    , defaultSSLInfo
    , Connection
    , Result
    , Type(..)
    , Row
    , MySQLError(errFunction, errNumber, errMessage)
    -- * Connection management
    , connect
    , close
    , autocommit
    , ping
    , changeUser
    , selectDB
    , setCharacterSet
    -- ** Connection information
    , threadId
    , serverInfo
    , hostInfo
    , protocolInfo
    , characterSet
    , sslCipher
    , serverStatus
    -- * Querying
    , query
    , insertID
    -- ** Escaping
    , escape
    -- ** Results
    , fieldCount
    , affectedRows
    -- * Working with results
    , isResultValid
    , freeResult
    , storeResult
    , useResult
    , fetchRow
    , fetchFields
    , dataSeek
    , rowSeek
    , rowTell
    -- ** Multiple results
    , nextResult
    -- * Transactions
    , commit
    , rollback
    -- * General information
    , clientInfo
    , clientVersion
    -- * Concurrency
    , initLibrary
    , initThread
    , endThread
    ) where

import Control.Applicative ((<$>), (<*>))
import Control.Concurrent (rtsSupportsBoundThreads, runInBoundThread)
import Control.Exception (Exception, throw)
import Control.Monad (forM_, unless, when)
import Data.ByteString.Char8 ()
import Data.ByteString.Internal (ByteString, create, createAndTrim, memcpy)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Data.IORef (IORef, atomicModifyIORef, newIORef, readIORef, writeIORef)
import Data.Int (Int64)
import Data.List (foldl')
import Data.Typeable (Typeable)
import Data.Word (Word, Word16, Word64)
import Database.MySQL.Base.C
import Database.MySQL.Base.Types
import Foreign.C.String (CString, peekCString, withCString)
import Foreign.C.Types (CULong)
import Foreign.Concurrent (newForeignPtr)
import Foreign.ForeignPtr hiding (newForeignPtr)
import Foreign.Marshal.Array (peekArray)
import Foreign.Ptr (Ptr, castPtr, nullPtr)
import System.IO.Unsafe (unsafePerformIO)
import System.Mem.Weak (Weak, deRefWeak, mkWeakPtr)

-- $license
--
-- /Important licensing note/: This library is BSD-licensed under the
-- terms of the MySQL FOSS License Exception
-- <http://www.mysql.com/about/legal/licensing/foss-exception/>.
--
-- Since this library links against the GPL-licensed @mysqlclient@
-- library, a non-open-source application that uses it /may/ be
-- subject to the terms of the GPL.

-- $mgmt
--
-- Our rules for managing 'Connection' and 'Result' values are
-- unfortunately complicated, thanks to MySQL's lifetime rules.
--
-- At the C @libmysqlclient@ level, a single @MYSQL@ connection may
-- cause multiple @MYSQL_RES@ result values to be created over the
-- course of multiple queries, but only one of these @MYSQL_RES@
-- values may be alive at a time.  The programmer is responsible for
-- knowing when to call @mysql_free_result@.
--
-- Meanwhile, up in Haskell-land, we'd like both 'Connection' and
-- 'Result' values to be managed either manually or automatically. In
-- particular, we want finalizers to tidy up after a messy programmer,
-- and we'd prefer it if people didn't need to be mindful of calling
-- @mysql_free_result@. This means that we must wrestle with the
-- lifetime rules. An obvious approach would be to use some monad and
-- type magic to enforce those rules, but then we'd end up with an
-- awkward API.
--
-- Instead, we allow 'Result' values to stay alive for arbitrarily
-- long times, while preserving the right to mark them as
-- invalid. When a @Result@ is marked invalid, its associated
-- @MYSQL_RES@ is freed, and can no longer be used.
--
-- Since all functions over @Result@ values are in the 'IO' monad, we
-- don't risk disrupting pure code by introducing this notion of
-- invalidity. If code tries to use an invalid @Result@, a
-- 'MySQLError' will be thrown. This should /not/ occur in normal
-- code, so there should be no need to use 'isResultValid' to test a
-- @Result@ for validity.
--
-- Each of the following functions will invalidate a 'Result':
--
-- * 'close'
--
-- * 'freeResult'
--
-- * 'nextResult'
--
-- * 'storeResult'
--
-- * 'useResult'
--
-- A 'Result' must be able to keep a 'Connection' alive so that a
-- streaming @Result@ constructed by 'useResult' can continue to pull
-- data from the server, but a @Connection@ must (a) be able to cause
-- the @MYSQL_RES@ behind a @Result@ to be deleted at a moment's notice,
-- while (b) not artificially prolonging the life of either the @Result@
-- or its @MYSQL_RES@.

data ConnectInfo = ConnectInfo {
      ConnectInfo -> String
connectHost :: String
    , ConnectInfo -> Word16
connectPort :: Word16
    , ConnectInfo -> String
connectUser :: String
    , ConnectInfo -> String
connectPassword :: String
    , ConnectInfo -> String
connectDatabase :: String
    , ConnectInfo -> [Option]
connectOptions :: [Option]
    , ConnectInfo -> String
connectPath :: FilePath
    , ConnectInfo -> Maybe SSLInfo
connectSSL :: Maybe SSLInfo
    } deriving (ConnectInfo -> ConnectInfo -> Bool
(ConnectInfo -> ConnectInfo -> Bool)
-> (ConnectInfo -> ConnectInfo -> Bool) -> Eq ConnectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectInfo -> ConnectInfo -> Bool
== :: ConnectInfo -> ConnectInfo -> Bool
$c/= :: ConnectInfo -> ConnectInfo -> Bool
/= :: ConnectInfo -> ConnectInfo -> Bool
Eq, ReadPrec [ConnectInfo]
ReadPrec ConnectInfo
Int -> ReadS ConnectInfo
ReadS [ConnectInfo]
(Int -> ReadS ConnectInfo)
-> ReadS [ConnectInfo]
-> ReadPrec ConnectInfo
-> ReadPrec [ConnectInfo]
-> Read ConnectInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ConnectInfo
readsPrec :: Int -> ReadS ConnectInfo
$creadList :: ReadS [ConnectInfo]
readList :: ReadS [ConnectInfo]
$creadPrec :: ReadPrec ConnectInfo
readPrec :: ReadPrec ConnectInfo
$creadListPrec :: ReadPrec [ConnectInfo]
readListPrec :: ReadPrec [ConnectInfo]
Read, Int -> ConnectInfo -> ShowS
[ConnectInfo] -> ShowS
ConnectInfo -> String
(Int -> ConnectInfo -> ShowS)
-> (ConnectInfo -> String)
-> ([ConnectInfo] -> ShowS)
-> Show ConnectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectInfo -> ShowS
showsPrec :: Int -> ConnectInfo -> ShowS
$cshow :: ConnectInfo -> String
show :: ConnectInfo -> String
$cshowList :: [ConnectInfo] -> ShowS
showList :: [ConnectInfo] -> ShowS
Show, Typeable)

data SSLInfo = SSLInfo {
      SSLInfo -> String
sslKey :: FilePath
    , SSLInfo -> String
sslCert :: FilePath
    , SSLInfo -> String
sslCA :: FilePath
    , SSLInfo -> String
sslCAPath :: FilePath
    , SSLInfo -> String
sslCiphers :: String -- ^ Comma-separated list of cipher names.
    } deriving (SSLInfo -> SSLInfo -> Bool
(SSLInfo -> SSLInfo -> Bool)
-> (SSLInfo -> SSLInfo -> Bool) -> Eq SSLInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SSLInfo -> SSLInfo -> Bool
== :: SSLInfo -> SSLInfo -> Bool
$c/= :: SSLInfo -> SSLInfo -> Bool
/= :: SSLInfo -> SSLInfo -> Bool
Eq, ReadPrec [SSLInfo]
ReadPrec SSLInfo
Int -> ReadS SSLInfo
ReadS [SSLInfo]
(Int -> ReadS SSLInfo)
-> ReadS [SSLInfo]
-> ReadPrec SSLInfo
-> ReadPrec [SSLInfo]
-> Read SSLInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SSLInfo
readsPrec :: Int -> ReadS SSLInfo
$creadList :: ReadS [SSLInfo]
readList :: ReadS [SSLInfo]
$creadPrec :: ReadPrec SSLInfo
readPrec :: ReadPrec SSLInfo
$creadListPrec :: ReadPrec [SSLInfo]
readListPrec :: ReadPrec [SSLInfo]
Read, Int -> SSLInfo -> ShowS
[SSLInfo] -> ShowS
SSLInfo -> String
(Int -> SSLInfo -> ShowS)
-> (SSLInfo -> String) -> ([SSLInfo] -> ShowS) -> Show SSLInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SSLInfo -> ShowS
showsPrec :: Int -> SSLInfo -> ShowS
$cshow :: SSLInfo -> String
show :: SSLInfo -> String
$cshowList :: [SSLInfo] -> ShowS
showList :: [SSLInfo] -> ShowS
Show, Typeable)

-- | The constructors of @MySQLError@ are not currently exported, but they
--   have a consistent set of field names which are exported.  These fields are:
--
--   >  errFunction :: String
--   >  errNumber   :: Int
--   >  errMessage  :: String
--
data MySQLError = ConnectionError {
      MySQLError -> String
errFunction :: String
    , MySQLError -> Int
errNumber :: Int
    , MySQLError -> String
errMessage :: String
    } | ResultError {
      errFunction :: String
    , errNumber :: Int
    , errMessage :: String
    } deriving (MySQLError -> MySQLError -> Bool
(MySQLError -> MySQLError -> Bool)
-> (MySQLError -> MySQLError -> Bool) -> Eq MySQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MySQLError -> MySQLError -> Bool
== :: MySQLError -> MySQLError -> Bool
$c/= :: MySQLError -> MySQLError -> Bool
/= :: MySQLError -> MySQLError -> Bool
Eq, Int -> MySQLError -> ShowS
[MySQLError] -> ShowS
MySQLError -> String
(Int -> MySQLError -> ShowS)
-> (MySQLError -> String)
-> ([MySQLError] -> ShowS)
-> Show MySQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MySQLError -> ShowS
showsPrec :: Int -> MySQLError -> ShowS
$cshow :: MySQLError -> String
show :: MySQLError -> String
$cshowList :: [MySQLError] -> ShowS
showList :: [MySQLError] -> ShowS
Show, Typeable)

instance Exception MySQLError

-- | Connection to a MySQL database.
data Connection = Connection {
      Connection -> ForeignPtr MYSQL
connFP :: ForeignPtr MYSQL
    , Connection -> IO ()
connClose :: IO ()
    , Connection -> IORef (Maybe (Weak Result))
connResult :: IORef (Maybe (Weak Result))
    } deriving (Typeable)

-- | Result of a database query.
data Result = Result {
      Result -> ForeignPtr MYSQL_RES
resFP :: ForeignPtr MYSQL_RES
    , Result -> Int
resFields :: {-# UNPACK #-} !Int
    , Result -> Connection
resConnection :: Connection
    , Result -> IORef Bool
resValid :: IORef Bool
    , Result -> Ptr MYSQL_RES -> IO (Ptr Field)
resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
    , Result -> Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
    , Result -> Ptr MYSQL_RES -> IO (Ptr CULong)
resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
    , Result -> Ptr MYSQL_RES -> IO ()
resFreeResult :: Ptr MYSQL_RES -> IO ()
    } | EmptyResult
  deriving (Typeable)

-- | A row cursor, used by 'rowSeek' and 'rowTell'.
newtype Row = Row MYSQL_ROW_OFFSET
  deriving (Typeable)

-- | Default information for setting up a connection.
--
-- Defaults are as follows:
--
-- * Server on @localhost@
--
-- * User @root@
--
-- * No password
--
-- * Database @test@
--
-- * Character set @utf8@
--
-- Use as in the following example:
--
-- > connect defaultConnectInfo { connectHost = "db.example.com" }
defaultConnectInfo :: ConnectInfo
defaultConnectInfo :: ConnectInfo
defaultConnectInfo = ConnectInfo {
                       connectHost :: String
connectHost = String
"localhost"
                     , connectPort :: Word16
connectPort = Word16
3306
                     , connectUser :: String
connectUser = String
"root"
                     , connectPassword :: String
connectPassword = String
""
                     , connectDatabase :: String
connectDatabase = String
"test"
                     , connectOptions :: [Option]
connectOptions = [String -> Option
CharsetName String
"utf8"]
                     , connectPath :: String
connectPath = String
""
                     , connectSSL :: Maybe SSLInfo
connectSSL = Maybe SSLInfo
forall a. Maybe a
Nothing
                     }

-- | Default (empty) information for setting up an SSL connection.
defaultSSLInfo :: SSLInfo
defaultSSLInfo :: SSLInfo
defaultSSLInfo = SSLInfo {
                   sslKey :: String
sslKey = String
""
                 , sslCert :: String
sslCert = String
""
                 , sslCA :: String
sslCA = String
""
                 , sslCAPath :: String
sslCAPath = String
""
                 , sslCiphers :: String
sslCiphers = String
""
                 }

-- | Connect to a database.
connect :: ConnectInfo -> IO Connection
connect :: ConnectInfo -> IO Connection
connect ConnectInfo{String
[Option]
Maybe SSLInfo
Word16
connectHost :: ConnectInfo -> String
connectPort :: ConnectInfo -> Word16
connectUser :: ConnectInfo -> String
connectPassword :: ConnectInfo -> String
connectDatabase :: ConnectInfo -> String
connectOptions :: ConnectInfo -> [Option]
connectPath :: ConnectInfo -> String
connectSSL :: ConnectInfo -> Maybe SSLInfo
connectHost :: String
connectPort :: Word16
connectUser :: String
connectPassword :: String
connectDatabase :: String
connectOptions :: [Option]
connectPath :: String
connectSSL :: Maybe SSLInfo
..} = do
  closed <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
  ptr0 <- mysql_init nullPtr
  case connectSSL of
    Maybe SSLInfo
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just SSLInfo{String
sslKey :: SSLInfo -> String
sslCert :: SSLInfo -> String
sslCA :: SSLInfo -> String
sslCAPath :: SSLInfo -> String
sslCiphers :: SSLInfo -> String
sslKey :: String
sslCert :: String
sslCA :: String
sslCAPath :: String
sslCiphers :: String
..} -> String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
sslKey ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
ckey ->
                         String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
sslCert ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
ccert ->
                          String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
sslCA ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cca ->
                           String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
sslCAPath ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
ccapath ->
                            String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
sslCiphers ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
ccipher ->
                             Ptr MYSQL
-> Ptr MyBool
-> Ptr MyBool
-> Ptr MyBool
-> Ptr MyBool
-> Ptr MyBool
-> IO MyBool
mysql_ssl_set Ptr MYSQL
ptr0 Ptr MyBool
ckey Ptr MyBool
ccert Ptr MyBool
cca Ptr MyBool
ccapath Ptr MyBool
ccipher
                             IO MyBool -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forM_ connectOptions $ \Option
opt -> do
    r <- Ptr MYSQL -> Option -> IO CInt
mysql_options Ptr MYSQL
ptr0 Option
opt
    unless (r == 0) $ connectionError_ "connect" ptr0
  let flags = (CULong -> CULong -> CULong) -> CULong -> [CULong] -> CULong
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CULong -> CULong -> CULong
forall a. Num a => a -> a -> a
(+) CULong
0 ([CULong] -> CULong)
-> ([Option] -> [CULong]) -> [Option] -> CULong
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Option -> CULong) -> [Option] -> [CULong]
forall a b. (a -> b) -> [a] -> [b]
map Option -> CULong
toConnectFlag ([Option] -> CULong) -> [Option] -> CULong
forall a b. (a -> b) -> a -> b
$ [Option]
connectOptions
  ptr <- withString connectHost $ \Ptr MyBool
chost ->
          String -> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
connectUser ((Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL))
-> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cuser ->
           String -> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
connectPassword ((Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL))
-> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cpass ->
            String -> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
connectDatabase ((Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL))
-> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cdb ->
             String -> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString String
connectPath ((Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL))
-> (Ptr MyBool -> IO (Ptr MYSQL)) -> IO (Ptr MYSQL)
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cpath ->
               Ptr MYSQL
-> Ptr MyBool
-> Ptr MyBool
-> Ptr MyBool
-> Ptr MyBool
-> CInt
-> Ptr MyBool
-> CULong
-> IO (Ptr MYSQL)
mysql_real_connect Ptr MYSQL
ptr0 Ptr MyBool
chost Ptr MyBool
cuser Ptr MyBool
cpass Ptr MyBool
cdb
                                  (Word16 -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
connectPort) Ptr MyBool
cpath CULong
flags
  when (ptr == nullPtr) $
    connectionError_ "connect" ptr0
  res <- newIORef Nothing
  let realClose = do
        IORef (Maybe (Weak Result)) -> IO ()
cleanupConnResult IORef (Maybe (Weak Result))
res
        wasClosed <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
closed ((Bool -> (Bool, Bool)) -> IO Bool)
-> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Bool
prev -> (Bool
True, Bool
prev)
        unless wasClosed $ mysql_close ptr
  -- In general, the user of this library is responsible for dealing with thread
  -- safety. However, the programmer has no control over the OS thread
  -- finalizers are run from so we use 'runInBoundThread' and 'initThread' here.
  let myRunInBoundThread = if Bool
rtsSupportsBoundThreads then IO a -> IO a
forall a. IO a -> IO a
runInBoundThread else IO a -> IO a
forall a. a -> a
id
  fp <- newForeignPtr ptr (myRunInBoundThread $ initThread >> realClose)
  return Connection {
               connFP = fp
             , connClose = realClose
             , connResult = res
             }

-- | Delete the 'MYSQL_RES' behind a 'Result' immediately, and mark
-- the 'Result' as invalid.
cleanupConnResult :: IORef (Maybe (Weak Result)) -> IO ()
cleanupConnResult :: IORef (Maybe (Weak Result)) -> IO ()
cleanupConnResult IORef (Maybe (Weak Result))
res = do
  prev <- IORef (Maybe (Weak Result)) -> IO (Maybe (Weak Result))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Weak Result))
res
  case prev of
    Maybe (Weak Result)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just Weak Result
w -> IO () -> (Result -> IO ()) -> Maybe Result -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Result -> IO ()
freeResult (Maybe Result -> IO ()) -> IO (Maybe Result) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Weak Result -> IO (Maybe Result)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak Result
w

-- | Close a connection, and mark any outstanding 'Result' as
-- invalid.
close :: Connection -> IO ()
close :: Connection -> IO ()
close = Connection -> IO ()
connClose
{-# INLINE close #-}

ping :: Connection -> IO ()
ping :: Connection -> IO ()
ping Connection
conn = Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr -> Ptr MYSQL -> IO CInt
mysql_ping Ptr MYSQL
ptr IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> CInt -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"ping" Connection
conn

threadId :: Connection -> IO Word
threadId :: Connection -> IO Word
threadId Connection
conn = CULong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULong -> Word) -> IO CULong -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> (Ptr MYSQL -> IO CULong) -> IO CULong
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn Ptr MYSQL -> IO CULong
mysql_thread_id

serverInfo :: Connection -> IO String
serverInfo :: Connection -> IO String
serverInfo Connection
conn = Connection -> (Ptr MYSQL -> IO String) -> IO String
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO String) -> IO String)
-> (Ptr MYSQL -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
                  Ptr MyBool -> IO String
peekCString (Ptr MyBool -> IO String) -> IO (Ptr MyBool) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MYSQL -> IO (Ptr MyBool)
mysql_get_server_info Ptr MYSQL
ptr

hostInfo :: Connection -> IO String
hostInfo :: Connection -> IO String
hostInfo Connection
conn = Connection -> (Ptr MYSQL -> IO String) -> IO String
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO String) -> IO String)
-> (Ptr MYSQL -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
                Ptr MyBool -> IO String
peekCString (Ptr MyBool -> IO String) -> IO (Ptr MyBool) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MYSQL -> IO (Ptr MyBool)
mysql_get_host_info Ptr MYSQL
ptr

protocolInfo :: Connection -> IO Word
protocolInfo :: Connection -> IO Word
protocolInfo Connection
conn = Connection -> (Ptr MYSQL -> IO Word) -> IO Word
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO Word) -> IO Word)
-> (Ptr MYSQL -> IO Word) -> IO Word
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
                    CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Word) -> IO CUInt -> IO Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MYSQL -> IO CUInt
mysql_get_proto_info Ptr MYSQL
ptr

setCharacterSet :: Connection -> String -> IO ()
setCharacterSet :: Connection -> String -> IO ()
setCharacterSet Connection
conn String
cs =
  String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
cs ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
ccs ->
    Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
        Ptr MYSQL -> Ptr MyBool -> IO CInt
mysql_set_character_set Ptr MYSQL
ptr Ptr MyBool
ccs IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> CInt -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"setCharacterSet" Connection
conn

characterSet :: Connection -> IO String
characterSet :: Connection -> IO String
characterSet Connection
conn = Connection -> (Ptr MYSQL -> IO String) -> IO String
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO String) -> IO String)
-> (Ptr MYSQL -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
  Ptr MyBool -> IO String
peekCString (Ptr MyBool -> IO String) -> IO (Ptr MyBool) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MYSQL -> IO (Ptr MyBool)
mysql_character_set_name Ptr MYSQL
ptr

sslCipher :: Connection -> IO (Maybe String)
sslCipher :: Connection -> IO (Maybe String)
sslCipher Connection
conn = Connection -> (Ptr MYSQL -> IO (Maybe String)) -> IO (Maybe String)
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO (Maybe String)) -> IO (Maybe String))
-> (Ptr MYSQL -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
  (Ptr MyBool -> IO String) -> Ptr MyBool -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
withPtr Ptr MyBool -> IO String
peekCString (Ptr MyBool -> IO (Maybe String))
-> IO (Ptr MyBool) -> IO (Maybe String)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MYSQL -> IO (Ptr MyBool)
mysql_get_ssl_cipher Ptr MYSQL
ptr

serverStatus :: Connection -> IO String
serverStatus :: Connection -> IO String
serverStatus Connection
conn = Connection -> (Ptr MYSQL -> IO String) -> IO String
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO String) -> IO String)
-> (Ptr MYSQL -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr -> do
  st <- Ptr MYSQL -> IO (Ptr MyBool)
mysql_stat Ptr MYSQL
ptr
  checkNull "serverStatus" conn st
  peekCString st

clientInfo :: String
clientInfo :: String
clientInfo = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ Ptr MyBool -> IO String
peekCString Ptr MyBool
mysql_get_client_info
{-# NOINLINE clientInfo #-}

clientVersion :: Word
clientVersion :: Word
clientVersion = CULong -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULong
mysql_get_client_version
{-# NOINLINE clientVersion #-}

-- | Turn autocommit on or off.
--
-- By default, MySQL runs with autocommit mode enabled. In this mode,
-- as soon as you modify a table, MySQL stores your modification
-- permanently.
autocommit :: Connection -> Bool -> IO ()
autocommit :: Connection -> Bool -> IO ()
autocommit Connection
conn Bool
onOff = Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
   Ptr MYSQL -> MyBool -> IO MyBool
mysql_autocommit Ptr MYSQL
ptr MyBool
b IO MyBool -> (MyBool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> MyBool -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"autocommit" Connection
conn
 where b :: MyBool
b = if Bool
onOff then MyBool
1 else MyBool
0

changeUser :: Connection -> String -> String -> Maybe String -> IO ()
changeUser :: Connection -> String -> String -> Maybe String -> IO ()
changeUser Connection
conn String
user String
pass Maybe String
mdb =
  String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
user ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cuser ->
   String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
pass ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cpass ->
    Maybe String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. Maybe String -> (Ptr MyBool -> IO a) -> IO a
withMaybeString Maybe String
mdb ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cdb ->
     Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
      Ptr MYSQL -> Ptr MyBool -> Ptr MyBool -> Ptr MyBool -> IO MyBool
mysql_change_user Ptr MYSQL
ptr Ptr MyBool
cuser Ptr MyBool
cpass Ptr MyBool
cdb IO MyBool -> (MyBool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> MyBool -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"changeUser" Connection
conn

selectDB :: Connection -> String -> IO ()
selectDB :: Connection -> String -> IO ()
selectDB Connection
conn String
db =
  String -> (Ptr MyBool -> IO ()) -> IO ()
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
db ((Ptr MyBool -> IO ()) -> IO ()) -> (Ptr MyBool -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MyBool
cdb ->
    Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
      Ptr MYSQL -> Ptr MyBool -> IO CInt
mysql_select_db Ptr MYSQL
ptr Ptr MyBool
cdb IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> CInt -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"selectDB" Connection
conn

query :: Connection -> ByteString -> IO ()
query :: Connection -> ByteString -> IO ()
query Connection
conn ByteString
q = Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
q ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr MyBool
p,Int
l) ->
  Ptr MYSQL -> Ptr MyBool -> CULong -> IO CInt
mysql_real_query Ptr MYSQL
ptr Ptr MyBool
p (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> CInt -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"query" Connection
conn

-- | Return the value generated for an @AUTO_INCREMENT@ column by the
-- previous @INSERT@ or @UPDATE@ statement.
--
-- See <http://dev.mysql.com/doc/refman/5.5/en/mysql-insert-id.html>
insertID :: Connection -> IO Word64
insertID :: Connection -> IO Word64
insertID Connection
conn = CULLong -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULLong -> Word64) -> IO CULLong -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Connection -> (Ptr MYSQL -> IO CULLong) -> IO CULLong
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO CULLong) -> IO CULLong)
-> (Ptr MYSQL -> IO CULLong) -> IO CULLong
forall a b. (a -> b) -> a -> b
$ Ptr MYSQL -> IO CULLong
mysql_insert_id)

-- | Return the number of fields (columns) in a result.
--
-- * If 'Left' 'Connection', returns the number of columns for the most
--   recent query on the connection.
--
-- * For 'Right' 'Result', returns the number of columns in each row
--   of this result.
--
-- The number of columns may legitimately be zero.
fieldCount :: Either Connection Result -> IO Int
fieldCount :: Either Connection Result -> IO Int
fieldCount (Right Result
EmptyResult) = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
fieldCount (Right Result
res)         = Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> Int
resFields Result
res)
fieldCount (Left Connection
conn)         =
    Connection -> (Ptr MYSQL -> IO Int) -> IO Int
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO Int) -> IO Int)
-> (Ptr MYSQL -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ (CUInt -> Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int)
-> (Ptr MYSQL -> IO CUInt) -> Ptr MYSQL -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr MYSQL -> IO CUInt
mysql_field_count

affectedRows :: Connection -> IO Int64
affectedRows :: Connection -> IO Int64
affectedRows Connection
conn = Connection -> (Ptr MYSQL -> IO Int64) -> IO Int64
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO Int64) -> IO Int64)
-> (Ptr MYSQL -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ (CULLong -> Int64) -> IO CULLong -> IO Int64
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CULLong -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CULLong -> IO Int64)
-> (Ptr MYSQL -> IO CULLong) -> Ptr MYSQL -> IO Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr MYSQL -> IO CULLong
mysql_affected_rows

-- | Retrieve a complete result.
--
-- Any previous outstanding 'Result' is first marked as invalid.
storeResult :: Connection -> IO Result
storeResult :: Connection -> IO Result
storeResult = String
-> (Ptr MYSQL -> IO (Ptr MYSQL_RES))
-> (Ptr MYSQL_RES -> IO (Ptr Field))
-> (Ptr MYSQL_RES -> IO MYSQL_ROW)
-> (Ptr MYSQL_RES -> IO (Ptr CULong))
-> (Ptr MYSQL_RES -> IO ())
-> Connection
-> IO Result
frobResult String
"storeResult" Ptr MYSQL -> IO (Ptr MYSQL_RES)
mysql_store_result
              Ptr MYSQL_RES -> IO (Ptr Field)
mysql_fetch_fields_nonblock
              Ptr MYSQL_RES -> IO MYSQL_ROW
mysql_fetch_row_nonblock
              Ptr MYSQL_RES -> IO (Ptr CULong)
mysql_fetch_lengths_nonblock
              Ptr MYSQL_RES -> IO ()
mysql_free_result_nonblock

-- | Initiate a row-by-row retrieval of a result.
--
-- Any previous outstanding 'Result' is first marked as invalid.
useResult :: Connection -> IO Result
useResult :: Connection -> IO Result
useResult = String
-> (Ptr MYSQL -> IO (Ptr MYSQL_RES))
-> (Ptr MYSQL_RES -> IO (Ptr Field))
-> (Ptr MYSQL_RES -> IO MYSQL_ROW)
-> (Ptr MYSQL_RES -> IO (Ptr CULong))
-> (Ptr MYSQL_RES -> IO ())
-> Connection
-> IO Result
frobResult String
"useResult" Ptr MYSQL -> IO (Ptr MYSQL_RES)
mysql_use_result
            Ptr MYSQL_RES -> IO (Ptr Field)
mysql_fetch_fields
            Ptr MYSQL_RES -> IO MYSQL_ROW
mysql_fetch_row
            Ptr MYSQL_RES -> IO (Ptr CULong)
mysql_fetch_lengths
            Ptr MYSQL_RES -> IO ()
mysql_free_result

frobResult :: String
           -> (Ptr MYSQL -> IO (Ptr MYSQL_RES))
           -> (Ptr MYSQL_RES -> IO (Ptr Field))
           -> (Ptr MYSQL_RES -> IO MYSQL_ROW)
           -> (Ptr MYSQL_RES -> IO (Ptr CULong))
           -> (Ptr MYSQL_RES -> IO ())
           -> Connection -> IO Result
frobResult :: String
-> (Ptr MYSQL -> IO (Ptr MYSQL_RES))
-> (Ptr MYSQL_RES -> IO (Ptr Field))
-> (Ptr MYSQL_RES -> IO MYSQL_ROW)
-> (Ptr MYSQL_RES -> IO (Ptr CULong))
-> (Ptr MYSQL_RES -> IO ())
-> Connection
-> IO Result
frobResult String
func Ptr MYSQL -> IO (Ptr MYSQL_RES)
frob Ptr MYSQL_RES -> IO (Ptr Field)
fetchFieldsFunc Ptr MYSQL_RES -> IO MYSQL_ROW
fetchRowFunc Ptr MYSQL_RES -> IO (Ptr CULong)
fetchLengthsFunc
           Ptr MYSQL_RES -> IO ()
myFreeResult Connection
conn =
  Connection -> (Ptr MYSQL -> IO Result) -> IO Result
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO Result) -> IO Result)
-> (Ptr MYSQL -> IO Result) -> IO Result
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr -> do
    IORef (Maybe (Weak Result)) -> IO ()
cleanupConnResult (Connection -> IORef (Maybe (Weak Result))
connResult Connection
conn)
    res <- Ptr MYSQL -> IO (Ptr MYSQL_RES)
frob Ptr MYSQL
ptr
    fields <- mysql_field_count ptr
    valid <- newIORef True
    if res == nullPtr
      then if fields == 0
           then return EmptyResult
           else connectionError func conn
      else do
        fp <- newForeignPtr res $ freeResult_ valid myFreeResult res
        let ret = Result {
                    resFP :: ForeignPtr MYSQL_RES
resFP = ForeignPtr MYSQL_RES
fp
                  , resFields :: Int
resFields = CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
fields
                  , resConnection :: Connection
resConnection = Connection
conn
                  , resValid :: IORef Bool
resValid = IORef Bool
valid
                  , resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
resFetchFields = Ptr MYSQL_RES -> IO (Ptr Field)
fetchFieldsFunc
                  , resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchRow = Ptr MYSQL_RES -> IO MYSQL_ROW
fetchRowFunc
                  , resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
resFetchLengths = Ptr MYSQL_RES -> IO (Ptr CULong)
fetchLengthsFunc
                  , resFreeResult :: Ptr MYSQL_RES -> IO ()
resFreeResult = Ptr MYSQL_RES -> IO ()
myFreeResult
                  }
        weak <- mkWeakPtr ret (Just (freeResult_ valid myFreeResult res))
        writeIORef (connResult conn) (Just weak)
        return ret

-- | Immediately free the @MYSQL_RES@ value associated with this
-- 'Result', and mark the @Result@ as invalid.
freeResult :: Result -> IO ()
freeResult :: Result -> IO ()
freeResult Result{Int
ForeignPtr MYSQL_RES
IORef Bool
Connection
Ptr MYSQL_RES -> IO MYSQL_ROW
Ptr MYSQL_RES -> IO (Ptr CULong)
Ptr MYSQL_RES -> IO (Ptr Field)
Ptr MYSQL_RES -> IO ()
resFP :: Result -> ForeignPtr MYSQL_RES
resFields :: Result -> Int
resConnection :: Result -> Connection
resValid :: Result -> IORef Bool
resFetchFields :: Result -> Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Result -> Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Result -> Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Result -> Ptr MYSQL_RES -> IO ()
resFP :: ForeignPtr MYSQL_RES
resFields :: Int
resConnection :: Connection
resValid :: IORef Bool
resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Ptr MYSQL_RES -> IO ()
..}  = ForeignPtr MYSQL_RES -> (Ptr MYSQL_RES -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr MYSQL_RES
resFP ((Ptr MYSQL_RES -> IO ()) -> IO ())
-> (Ptr MYSQL_RES -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
                         IORef Bool -> (Ptr MYSQL_RES -> IO ()) -> Ptr MYSQL_RES -> IO ()
freeResult_ IORef Bool
resValid Ptr MYSQL_RES -> IO ()
resFreeResult
freeResult Result
EmptyResult = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Check whether a 'Result' is still valid, i.e. backed by a live
-- @MYSQL_RES@ value.
isResultValid :: Result -> IO Bool
isResultValid :: Result -> IO Bool
isResultValid Result{Int
ForeignPtr MYSQL_RES
IORef Bool
Connection
Ptr MYSQL_RES -> IO MYSQL_ROW
Ptr MYSQL_RES -> IO (Ptr CULong)
Ptr MYSQL_RES -> IO (Ptr Field)
Ptr MYSQL_RES -> IO ()
resFP :: Result -> ForeignPtr MYSQL_RES
resFields :: Result -> Int
resConnection :: Result -> Connection
resValid :: Result -> IORef Bool
resFetchFields :: Result -> Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Result -> Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Result -> Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Result -> Ptr MYSQL_RES -> IO ()
resFP :: ForeignPtr MYSQL_RES
resFields :: Int
resConnection :: Connection
resValid :: IORef Bool
resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Ptr MYSQL_RES -> IO ()
..}  = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
resValid
isResultValid Result
EmptyResult = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

freeResult_ :: IORef Bool -> (Ptr MYSQL_RES -> IO ()) -> Ptr MYSQL_RES -> IO ()
freeResult_ :: IORef Bool -> (Ptr MYSQL_RES -> IO ()) -> Ptr MYSQL_RES -> IO ()
freeResult_ IORef Bool
valid Ptr MYSQL_RES -> IO ()
free Ptr MYSQL_RES
ptr = do
  wasValid <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Bool
valid ((Bool -> (Bool, Bool)) -> IO Bool)
-> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Bool
prev -> (Bool
False, Bool
prev)
  when wasValid $ free ptr

fetchRow :: Result -> IO [Maybe ByteString]
fetchRow :: Result -> IO [Maybe ByteString]
fetchRow res :: Result
res@Result{Int
ForeignPtr MYSQL_RES
IORef Bool
Connection
Ptr MYSQL_RES -> IO MYSQL_ROW
Ptr MYSQL_RES -> IO (Ptr CULong)
Ptr MYSQL_RES -> IO (Ptr Field)
Ptr MYSQL_RES -> IO ()
resFP :: Result -> ForeignPtr MYSQL_RES
resFields :: Result -> Int
resConnection :: Result -> Connection
resValid :: Result -> IORef Bool
resFetchFields :: Result -> Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Result -> Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Result -> Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Result -> Ptr MYSQL_RES -> IO ()
resFP :: ForeignPtr MYSQL_RES
resFields :: Int
resConnection :: Connection
resValid :: IORef Bool
resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Ptr MYSQL_RES -> IO ()
..}  = String
-> Result
-> (Ptr MYSQL_RES -> IO [Maybe ByteString])
-> IO [Maybe ByteString]
forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
"fetchRow" Result
res ((Ptr MYSQL_RES -> IO [Maybe ByteString]) -> IO [Maybe ByteString])
-> (Ptr MYSQL_RES -> IO [Maybe ByteString])
-> IO [Maybe ByteString]
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL_RES
ptr -> do
  rowPtr <- Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchRow Ptr MYSQL_RES
ptr
  if rowPtr == nullPtr
    then return []
    else do
      lenPtr <- resFetchLengths ptr
      checkNull "fetchRow" resConnection lenPtr
      let go a
len = (Ptr a -> IO ByteString) -> Ptr a -> IO (Maybe ByteString)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
withPtr ((Ptr a -> IO ByteString) -> Ptr a -> IO (Maybe ByteString))
-> (Ptr a -> IO ByteString) -> Ptr a -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr a
colPtr ->
                   Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d ->
                   Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
d (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
colPtr) (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len)
      sequence =<< zipWith go <$> peekArray resFields lenPtr
                              <*> peekArray resFields rowPtr
fetchRow Result
EmptyResult = [Maybe ByteString] -> IO [Maybe ByteString]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

fetchFields :: Result -> IO [Field]
fetchFields :: Result -> IO [Field]
fetchFields res :: Result
res@Result{Int
ForeignPtr MYSQL_RES
IORef Bool
Connection
Ptr MYSQL_RES -> IO MYSQL_ROW
Ptr MYSQL_RES -> IO (Ptr CULong)
Ptr MYSQL_RES -> IO (Ptr Field)
Ptr MYSQL_RES -> IO ()
resFP :: Result -> ForeignPtr MYSQL_RES
resFields :: Result -> Int
resConnection :: Result -> Connection
resValid :: Result -> IORef Bool
resFetchFields :: Result -> Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Result -> Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Result -> Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Result -> Ptr MYSQL_RES -> IO ()
resFP :: ForeignPtr MYSQL_RES
resFields :: Int
resConnection :: Connection
resValid :: IORef Bool
resFetchFields :: Ptr MYSQL_RES -> IO (Ptr Field)
resFetchRow :: Ptr MYSQL_RES -> IO MYSQL_ROW
resFetchLengths :: Ptr MYSQL_RES -> IO (Ptr CULong)
resFreeResult :: Ptr MYSQL_RES -> IO ()
..} = String -> Result -> (Ptr MYSQL_RES -> IO [Field]) -> IO [Field]
forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
"fetchFields" Result
res ((Ptr MYSQL_RES -> IO [Field]) -> IO [Field])
-> (Ptr MYSQL_RES -> IO [Field]) -> IO [Field]
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL_RES
ptr -> do
  Int -> Ptr Field -> IO [Field]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
resFields (Ptr Field -> IO [Field]) -> IO (Ptr Field) -> IO [Field]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MYSQL_RES -> IO (Ptr Field)
resFetchFields Ptr MYSQL_RES
ptr
fetchFields Result
EmptyResult    = [Field] -> IO [Field]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

dataSeek :: Result -> Int64 -> IO ()
dataSeek :: Result -> Int64 -> IO ()
dataSeek Result
res Int64
row = String -> Result -> (Ptr MYSQL_RES -> IO ()) -> IO ()
forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
"dataSeek" Result
res ((Ptr MYSQL_RES -> IO ()) -> IO ())
-> (Ptr MYSQL_RES -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL_RES
ptr ->
  Ptr MYSQL_RES -> CULLong -> IO ()
mysql_data_seek Ptr MYSQL_RES
ptr (Int64 -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
row)

rowTell :: Result -> IO Row
rowTell :: Result -> IO Row
rowTell Result
res = String -> Result -> (Ptr MYSQL_RES -> IO Row) -> IO Row
forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
"rowTell" Result
res ((Ptr MYSQL_RES -> IO Row) -> IO Row)
-> (Ptr MYSQL_RES -> IO Row) -> IO Row
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL_RES
ptr ->
  MYSQL_ROW_OFFSET -> Row
Row (MYSQL_ROW_OFFSET -> Row) -> IO MYSQL_ROW_OFFSET -> IO Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MYSQL_RES -> IO MYSQL_ROW_OFFSET
mysql_row_tell Ptr MYSQL_RES
ptr

rowSeek :: Result -> Row -> IO Row
rowSeek :: Result -> Row -> IO Row
rowSeek Result
res (Row MYSQL_ROW_OFFSET
row) = String -> Result -> (Ptr MYSQL_RES -> IO Row) -> IO Row
forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
"rowSeek" Result
res ((Ptr MYSQL_RES -> IO Row) -> IO Row)
-> (Ptr MYSQL_RES -> IO Row) -> IO Row
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL_RES
ptr ->
  MYSQL_ROW_OFFSET -> Row
Row (MYSQL_ROW_OFFSET -> Row) -> IO MYSQL_ROW_OFFSET -> IO Row
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MYSQL_RES -> MYSQL_ROW_OFFSET -> IO MYSQL_ROW_OFFSET
mysql_row_seek Ptr MYSQL_RES
ptr MYSQL_ROW_OFFSET
row

-- | Read the next statement result. Returns 'True' if another result
-- is available, 'False' otherwise.
--
-- This function marks the current 'Result' as invalid, if one exists.
nextResult :: Connection -> IO Bool
nextResult :: Connection -> IO Bool
nextResult Connection
conn = Connection -> (Ptr MYSQL -> IO Bool) -> IO Bool
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO Bool) -> IO Bool)
-> (Ptr MYSQL -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr -> do
  IORef (Maybe (Weak Result)) -> IO ()
cleanupConnResult (Connection -> IORef (Maybe (Weak Result))
connResult Connection
conn)
  i <- Ptr MYSQL -> IO CInt
mysql_next_result Ptr MYSQL
ptr
  case i of
    CInt
0  -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    -1 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    CInt
_  -> String -> Connection -> IO Bool
forall a. String -> Connection -> IO a
connectionError String
"nextResult" Connection
conn

-- | Commit the current transaction.
commit :: Connection -> IO ()
commit :: Connection -> IO ()
commit Connection
conn = Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
              Ptr MYSQL -> IO MyBool
mysql_commit Ptr MYSQL
ptr IO MyBool -> (MyBool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> MyBool -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"commit" Connection
conn

-- | Roll back the current transaction.
rollback :: Connection -> IO ()
rollback :: Connection -> IO ()
rollback Connection
conn = Connection -> (Ptr MYSQL -> IO ()) -> IO ()
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ()) -> IO ()) -> (Ptr MYSQL -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
                Ptr MYSQL -> IO MyBool
mysql_rollback Ptr MYSQL
ptr IO MyBool -> (MyBool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Connection -> MyBool -> IO ()
forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
"rollback" Connection
conn

escape :: Connection -> ByteString -> IO ByteString
escape :: Connection -> ByteString -> IO ByteString
escape Connection
conn ByteString
bs = Connection -> (Ptr MYSQL -> IO ByteString) -> IO ByteString
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO ByteString) -> IO ByteString)
-> (Ptr MYSQL -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr MYSQL
ptr ->
  ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(Ptr MyBool
p,Int
l) ->
    Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((Ptr Word8 -> IO Int) -> IO ByteString)
-> (Ptr Word8 -> IO Int) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
to ->
      CULong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CULong -> Int) -> IO CULong -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr MYSQL -> Ptr MyBool -> Ptr MyBool -> CULong -> IO CULong
mysql_real_escape_string Ptr MYSQL
ptr (Ptr Word8 -> Ptr MyBool
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
to) Ptr MyBool
p
                                                (Int -> CULong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)

withConn :: Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn :: forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn = ForeignPtr MYSQL -> (Ptr MYSQL -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (Connection -> ForeignPtr MYSQL
connFP Connection
conn)

-- | Call @mysql_library_init@
--
-- A single-threaded program can rely on an implicit initialisation done
-- when making the first connection, but a multi-threaded one should call
-- 'initLibrary' separately, and it should be done before other threads
-- might call into this library, since this function is not thread-safe.
-- See <https://ro-che.info/articles/2015-04-17-safe-concurrent-mysql-haskell>
-- and <https://dev.mysql.com/doc/refman/5.7/en/c-api-threaded-clients.html>
-- for details.
initLibrary :: IO ()
initLibrary :: IO ()
initLibrary = do
  r <- CInt -> Ptr (Ptr Char) -> Ptr (Ptr Char) -> IO CInt
mysql_library_init CInt
0 Ptr (Ptr Char)
forall a. Ptr a
nullPtr Ptr (Ptr Char)
forall a. Ptr a
nullPtr
  if r == 0
    then return ()
    else throw $ ConnectionError "initLibrary" (-1)
      "mysql_library_init failed"

-- | Call @mysql_thread_init@
--
-- Again a single-threaded program does not need to call this explicitly.  Even
-- in a multi-threaded one, if each connection is made, used, and destroyed
-- in a single thread, it is sufficient to rely on the 'connect' call to do
-- an implicit thread initialisation.  But in other cases, for example when
-- using a connection pool, each thread requires explicit initialisation.
-- See <https://ro-che.info/articles/2015-04-17-safe-concurrent-mysql-haskell>
-- and <https://dev.mysql.com/doc/refman/5.7/en/c-api-threaded-clients.html>
-- for details.
initThread :: IO ()
initThread :: IO ()
initThread = do
  r <- IO MyBool
mysql_thread_init
  if r == 0
    then return ()
    else throw $ ConnectionError "initThread" (-1)
      "mysql_thread_init failed"

-- | Call @mysql_thread_end@
--
-- This is needed at thread exit to avoid a memory leak, except when using
-- a non-debug build of at least version 5.7.9 of the MySQL library.
-- See <https://dev.mysql.com/doc/refman/5.7/en/mysql-thread-end.html>.
-- The threads in question are the /OS threads/, so calling this function
-- is likely to be important when using large numbers of bound threads (see
-- "Control.Concurrent").  Unbound threads - those created with 'forkIO' and
-- friends - share a small number of OS threads, so in those it is hard to
-- call this function safely, and there is little benefit in doing so, but in
-- any case using this library in unbound threads is not recommended  (see
-- <https://ro-che.info/articles/2015-04-17-safe-concurrent-mysql-haskell>).
endThread :: IO ()
endThread :: IO ()
endThread = IO ()
mysql_thread_end

withRes :: String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes :: forall a. String -> Result -> (Ptr MYSQL_RES -> IO a) -> IO a
withRes String
func Result
res Ptr MYSQL_RES -> IO a
act = do
  valid <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (Result -> IORef Bool
resValid Result
res)
  unless valid . throw $ ResultError func 0 "result is no longer usable"
  withForeignPtr (resFP res) act

withString :: String -> (CString -> IO a) -> IO a
withString :: forall a. String -> (Ptr MyBool -> IO a) -> IO a
withString [] Ptr MyBool -> IO a
act = Ptr MyBool -> IO a
act Ptr MyBool
forall a. Ptr a
nullPtr
withString String
xs Ptr MyBool -> IO a
act = String -> (Ptr MyBool -> IO a) -> IO a
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
xs Ptr MyBool -> IO a
act

withMaybeString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeString :: forall a. Maybe String -> (Ptr MyBool -> IO a) -> IO a
withMaybeString Maybe String
Nothing Ptr MyBool -> IO a
act = Ptr MyBool -> IO a
act Ptr MyBool
forall a. Ptr a
nullPtr
withMaybeString (Just String
xs) Ptr MyBool -> IO a
act = String -> (Ptr MyBool -> IO a) -> IO a
forall a. String -> (Ptr MyBool -> IO a) -> IO a
withCString String
xs Ptr MyBool -> IO a
act

check :: (Eq a, Num a) => String -> Connection -> a -> IO ()
check :: forall a. (Eq a, Num a) => String -> Connection -> a -> IO ()
check String
func Connection
conn a
r = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
r a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Connection -> IO ()
forall a. String -> Connection -> IO a
connectionError String
func Connection
conn
{-# INLINE check #-}

checkNull :: String -> Connection -> Ptr a -> IO ()
checkNull :: forall a. String -> Connection -> Ptr a -> IO ()
checkNull String
func Connection
conn Ptr a
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Connection -> IO ()
forall a. String -> Connection -> IO a
connectionError String
func Connection
conn
{-# INLINE checkNull #-}

withPtr :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
withPtr :: forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
withPtr Ptr a -> IO b
act Ptr a
p | Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr = Maybe b -> IO (Maybe b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
              | Bool
otherwise    = b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO b
act Ptr a
p

connectionError :: String -> Connection -> IO a
connectionError :: forall a. String -> Connection -> IO a
connectionError String
func Connection
conn = Connection -> (Ptr MYSQL -> IO a) -> IO a
forall a. Connection -> (Ptr MYSQL -> IO a) -> IO a
withConn Connection
conn ((Ptr MYSQL -> IO a) -> IO a) -> (Ptr MYSQL -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ String -> Ptr MYSQL -> IO a
forall a. String -> Ptr MYSQL -> IO a
connectionError_ String
func

connectionError_ :: String -> Ptr MYSQL -> IO a
connectionError_ :: forall a. String -> Ptr MYSQL -> IO a
connectionError_ String
func Ptr MYSQL
ptr =do
  errno <- Ptr MYSQL -> IO CInt
mysql_errno Ptr MYSQL
ptr
  msg <- peekCString =<< mysql_error ptr
  throw $ ConnectionError func (fromIntegral errno) msg