{-# LINE 1 "Database/HDBC/PostgreSQL/Connection.hsc" #-}
{-# LANGUAGE FlexibleContexts #-}
module Database.HDBC.PostgreSQL.Connection
(connectPostgreSQL, withPostgreSQL,
connectPostgreSQL', withPostgreSQL',
Impl.begin, Impl.Connection())
where
import Database.HDBC
import Database.HDBC.DriverUtils
import qualified Database.HDBC.PostgreSQL.ConnectionImpl as Impl
import Database.HDBC.PostgreSQL.Types
import Database.HDBC.PostgreSQL.Statement
import Database.HDBC.PostgreSQL.PTypeConv
import Foreign.C.Types
import Foreign.C.String
import Database.HDBC.PostgreSQL.Utils
import Foreign.ForeignPtr
import Foreign.Ptr
import Data.Word
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as BUTF8
import Control.Monad (when)
import Control.Concurrent.MVar
import System.IO (stderr, hPutStrLn)
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception(bracket)
import Data.Convertible (Convertible)
globalConnLock :: MVar ()
{-# NOINLINE globalConnLock #-}
globalConnLock :: MVar ()
globalConnLock = IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO (IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$ () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
connectPostgreSQL :: String -> IO Impl.Connection
connectPostgreSQL :: String -> IO Connection
connectPostgreSQL = Bool -> String -> IO Connection
connectPostgreSQL_helper Bool
True
connectPostgreSQL' :: String -> IO Impl.Connection
connectPostgreSQL' :: String -> IO Connection
connectPostgreSQL' = Bool -> String -> IO Connection
connectPostgreSQL_helper Bool
False
connectPostgreSQL_helper :: Bool -> String -> IO Impl.Connection
connectPostgreSQL_helper :: Bool -> String -> IO Connection
connectPostgreSQL_helper Bool
auto_transaction String
args =
ByteString -> (CString -> IO Connection) -> IO Connection
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (String -> ByteString
BUTF8.fromString String
args) ((CString -> IO Connection) -> IO Connection)
-> (CString -> IO Connection) -> IO Connection
forall a b. (a -> b) -> a -> b
$
\CString
cs -> do Ptr CConn
ptr <- CString -> IO (Ptr CConn)
pqconnectdb CString
cs
Int
threadSafe <- Ptr CConn -> IO Int
pqisThreadSafe Ptr CConn
ptr
MVar ()
connLock <- if Int
threadSafeInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0
then do Handle -> String -> IO ()
hPutStrLn Handle
stderr String
"WARNING: libpq is not threadsafe, \
\serializing all libpq FFI calls. \
\(Consider recompiling libpq with \
\--enable-thread-safety.\n"
MVar () -> IO (MVar ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MVar ()
globalConnLock
else () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
Word32
status <- Ptr CConn -> IO Word32
pqstatus Ptr CConn
ptr
ForeignPtr CConn
fptr <- FinalizerPtr CConn -> Ptr CConn -> IO (ForeignPtr CConn)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr CConn
pqfinish Ptr CConn
ptr
case Word32
status of
Word32
0 -> Bool -> String -> Conn -> IO Connection
mkConn Bool
auto_transaction String
args (MVar ()
connLock,ForeignPtr CConn
fptr)
{-# LINE 69 "Database/HDBC/PostgreSQL/Connection.hsc" #-}
Word32
_ -> String -> Word32 -> Ptr CConn -> IO Connection
forall a. String -> Word32 -> Ptr CConn -> IO a
raiseError String
"connectPostgreSQL" Word32
status Ptr CConn
ptr
mkConn :: Bool -> String -> Conn -> IO Impl.Connection
mkConn :: Bool -> String -> Conn -> IO Connection
mkConn Bool
auto_transaction String
args Conn
conn = Conn -> (Ptr CConn -> IO Connection) -> IO Connection
forall b. Conn -> (Ptr CConn -> IO b) -> IO b
withConn Conn
conn ((Ptr CConn -> IO Connection) -> IO Connection)
-> (Ptr CConn -> IO Connection) -> IO Connection
forall a b. (a -> b) -> a -> b
$
\Ptr CConn
cconn ->
do MVar [Weak Statement]
children <- [Weak Statement] -> IO (MVar [Weak Statement])
forall a. a -> IO (MVar a)
newMVar []
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
auto_transaction (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Conn -> MVar [Weak Statement] -> IO ()
begin_transaction Conn
conn MVar [Weak Statement]
children
CInt
protover <- Ptr CConn -> IO CInt
pqprotocolVersion Ptr CConn
cconn
CInt
serverver <- Ptr CConn -> IO CInt
pqserverVersion Ptr CConn
cconn
let clientver :: String
clientver = String
"15.4 (Debian 15.4-1)"
{-# LINE 81 "Database/HDBC/PostgreSQL/Connection.hsc" #-}
let rconn = Impl.Connection {
Impl.disconnect = fdisconnect conn children,
Impl.begin = if auto_transaction
then return ()
else begin_transaction conn children,
Impl.commit = fcommit auto_transaction conn children,
Impl.rollback = frollback auto_transaction conn children,
Impl.runRaw = frunRaw conn children,
Impl.run = frun conn children,
Impl.prepare = newSth conn children,
Impl.clone = connectPostgreSQL args,
Impl.hdbcDriverName = "postgresql",
Impl.hdbcClientVer = clientver,
Impl.proxiedClientName = "postgresql",
Impl.proxiedClientVer = show protover,
Impl.dbServerVer = show serverver,
Impl.dbTransactionSupport = True,
Impl.getTables = fgetTables conn children,
Impl.describeTable = fdescribeTable conn children}
[[SqlValue]]
_ <- Connection -> String -> [SqlValue] -> IO [[SqlValue]]
forall conn.
IConnection conn =>
conn -> String -> [SqlValue] -> IO [[SqlValue]]
quickQuery Connection
rconn String
"SET client_encoding TO utf8;" []
Connection -> IO Connection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
rconn
withPostgreSQL :: String -> (Impl.Connection -> IO a) -> IO a
withPostgreSQL :: forall a. String -> (Connection -> IO a) -> IO a
withPostgreSQL String
connstr = IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO Connection
connectPostgreSQL String
connstr) (Connection -> IO ()
forall conn. IConnection conn => conn -> IO ()
disconnect)
withPostgreSQL' :: String -> (Impl.Connection -> IO a) -> IO a
withPostgreSQL' :: forall a. String -> (Connection -> IO a) -> IO a
withPostgreSQL' String
connstr = IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO Connection
connectPostgreSQL' String
connstr) (Connection -> IO ()
forall conn. IConnection conn => conn -> IO ()
disconnect)
begin_transaction :: Conn -> ChildList -> IO ()
begin_transaction :: Conn -> MVar [Weak Statement] -> IO ()
begin_transaction Conn
o MVar [Weak Statement]
children = Conn -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
frun Conn
o MVar [Weak Statement]
children String
"BEGIN" [] IO Integer -> 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 ()
frunRaw :: Conn -> ChildList -> String -> IO ()
frunRaw :: Conn -> MVar [Weak Statement] -> String -> IO ()
frunRaw Conn
o MVar [Weak Statement]
children String
query =
do Statement
sth <- Conn -> MVar [Weak Statement] -> String -> IO Statement
newSth Conn
o MVar [Weak Statement]
children String
query
Statement -> IO ()
executeRaw Statement
sth
Statement -> IO ()
finish Statement
sth
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
frun :: Conn -> ChildList -> String -> [SqlValue] -> IO Integer
frun :: Conn -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
frun Conn
o MVar [Weak Statement]
children String
query [SqlValue]
args =
do Statement
sth <- Conn -> MVar [Weak Statement] -> String -> IO Statement
newSth Conn
o MVar [Weak Statement]
children String
query
Integer
res <- Statement -> [SqlValue] -> IO Integer
execute Statement
sth [SqlValue]
args
Statement -> IO ()
finish Statement
sth
Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
res
fcommit :: Bool -> Conn -> ChildList -> IO ()
fcommit :: Bool -> Conn -> MVar [Weak Statement] -> IO ()
fcommit Bool
begin Conn
o MVar [Weak Statement]
cl = do Integer
_ <- Conn -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
frun Conn
o MVar [Weak Statement]
cl String
"COMMIT" []
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
begin (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Conn -> MVar [Weak Statement] -> IO ()
begin_transaction Conn
o MVar [Weak Statement]
cl
frollback :: Bool -> Conn -> ChildList -> IO ()
frollback :: Bool -> Conn -> MVar [Weak Statement] -> IO ()
frollback Bool
begin Conn
o MVar [Weak Statement]
cl = do Integer
_ <- Conn -> MVar [Weak Statement] -> String -> [SqlValue] -> IO Integer
frun Conn
o MVar [Weak Statement]
cl String
"ROLLBACK" []
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
begin (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Conn -> MVar [Weak Statement] -> IO ()
begin_transaction Conn
o MVar [Weak Statement]
cl
fgetTables :: (Convertible SqlValue a) => Conn -> ChildList -> IO [a]
fgetTables :: forall a.
Convertible SqlValue a =>
Conn -> MVar [Weak Statement] -> IO [a]
fgetTables Conn
conn MVar [Weak Statement]
children =
do Statement
sth <- Conn -> MVar [Weak Statement] -> String -> IO Statement
newSth Conn
conn MVar [Weak Statement]
children
String
"select table_name from information_schema.tables where \
\table_schema != 'pg_catalog' AND table_schema != \
\'information_schema'"
Integer
_ <- Statement -> [SqlValue] -> IO Integer
execute Statement
sth []
[[SqlValue]]
res1 <- Statement -> IO [[SqlValue]]
fetchAllRows' Statement
sth
let res :: [a]
res = (SqlValue -> a) -> [SqlValue] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map SqlValue -> a
forall a. Convertible SqlValue a => SqlValue -> a
fromSql ([SqlValue] -> [a]) -> [SqlValue] -> [a]
forall a b. (a -> b) -> a -> b
$ [[SqlValue]] -> [SqlValue]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[SqlValue]]
res1
[a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> [a]
forall a b. a -> b -> b
seq ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
res) [a]
res
fdescribeTable :: Conn -> ChildList -> String -> IO [(String, SqlColDesc)]
fdescribeTable :: Conn
-> MVar [Weak Statement] -> String -> IO [(String, SqlColDesc)]
fdescribeTable Conn
o MVar [Weak Statement]
cl String
table = Conn
-> MVar [Weak Statement]
-> Maybe String
-> String
-> IO [(String, SqlColDesc)]
fdescribeSchemaTable Conn
o MVar [Weak Statement]
cl Maybe String
forall a. Maybe a
Nothing String
table
fdescribeSchemaTable :: Conn -> ChildList -> Maybe String -> String -> IO [(String, SqlColDesc)]
fdescribeSchemaTable :: Conn
-> MVar [Weak Statement]
-> Maybe String
-> String
-> IO [(String, SqlColDesc)]
fdescribeSchemaTable Conn
o MVar [Weak Statement]
cl Maybe String
maybeSchema String
table =
do Statement
sth <- Conn -> MVar [Weak Statement] -> String -> IO Statement
newSth Conn
o MVar [Weak Statement]
cl
(String
"SELECT attname, atttypid, attlen, format_type(atttypid, atttypmod), attnotnull " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"FROM pg_attribute, pg_class, pg_namespace ns " String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"WHERE relname = ? and attnum > 0 and attisdropped IS FALSE " String -> String -> String
forall a. [a] -> [a] -> [a]
++
(if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
maybeSchema then String
"and ns.nspname = ? " else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"and attrelid = pg_class.oid and relnamespace = ns.oid order by attnum")
let params :: [SqlValue]
params = String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql String
table SqlValue -> [SqlValue] -> [SqlValue]
forall a. a -> [a] -> [a]
: (if Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
maybeSchema then [String -> SqlValue
forall a. Convertible a SqlValue => a -> SqlValue
toSql (String -> SqlValue) -> String -> SqlValue
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust Maybe String
maybeSchema] else [])
Integer
_ <- Statement -> [SqlValue] -> IO Integer
execute Statement
sth [SqlValue]
params
[[SqlValue]]
res <- Statement -> IO [[SqlValue]]
fetchAllRows' Statement
sth
[(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, SqlColDesc)] -> IO [(String, SqlColDesc)])
-> [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ ([SqlValue] -> (String, SqlColDesc))
-> [[SqlValue]] -> [(String, SqlColDesc)]
forall a b. (a -> b) -> [a] -> [b]
map [SqlValue] -> (String, SqlColDesc)
forall {a}. Convertible SqlValue a => [SqlValue] -> (a, SqlColDesc)
desccol [[SqlValue]]
res
where
desccol :: [SqlValue] -> (a, SqlColDesc)
desccol [SqlValue
attname, SqlValue
atttypid, SqlValue
attlen, SqlValue
formattedtype, SqlValue
attnotnull] =
(SqlValue -> a
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
attname,
Word32 -> Int -> String -> Bool -> SqlColDesc
colDescForPGAttr (SqlValue -> Word32
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
atttypid) (SqlValue -> Int
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
attlen) (SqlValue -> String
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
formattedtype) (SqlValue -> Bool
forall a. Convertible SqlValue a => SqlValue -> a
fromSql SqlValue
attnotnull Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False))
desccol [SqlValue]
x =
String -> (a, SqlColDesc)
forall a. HasCallStack => String -> a
error (String -> (a, SqlColDesc)) -> String -> (a, SqlColDesc)
forall a b. (a -> b) -> a -> b
$ String
"Got unexpected result from pg_attribute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [SqlValue] -> String
forall a. Show a => a -> String
show [SqlValue]
x
fdisconnect :: Conn -> ChildList -> IO ()
fdisconnect :: Conn -> MVar [Weak Statement] -> IO ()
fdisconnect (MVar ()
lock, ForeignPtr CConn
fptr) MVar [Weak Statement]
childList = do
MVar [Weak Statement] -> IO ()
closeAllChildren MVar [Weak Statement]
childList
MVar () -> (() -> IO ()) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar ()
lock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \()
_ ->
ForeignPtr CConn -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr ForeignPtr CConn
fptr
foreign import ccall safe "libpq-fe.h PQconnectdb"
pqconnectdb :: CString -> IO (Ptr CConn)
foreign import ccall safe "libpq-fe.h PQstatus"
pqstatus :: Ptr CConn -> IO Word32
{-# LINE 184 "Database/HDBC/PostgreSQL/Connection.hsc" #-}
foreign import ccall safe "libpq-fe.h &PQfinish"
pqfinish :: FunPtr (Ptr CConn -> IO ())
foreign import ccall safe "libpq-fe.h PQprotocolVersion"
pqprotocolVersion :: Ptr CConn -> IO CInt
foreign import ccall safe "libpq-fe.h PQserverVersion"
pqserverVersion :: Ptr CConn -> IO CInt
foreign import ccall safe "libpq.fe.h PQisthreadsafe"
pqisThreadSafe :: Ptr CConn -> IO Int