Takusen-0.8.4: Database/PostgreSQL/PGFunctions.lhs
|
Module : Database.PostgreSQL.PGFunctions
Copyright : (c) 2004 Oleg Kiselyov, Alistair Bayley
License : BSD-style
Maintainer : oleg@pobox.com, alistair@abayley.org
Stability : experimental
Portability : non-portable
Simple wrappers for PostgreSQL functions (FFI) plus middle-level
wrappers (in the second part of this file)
> {-# OPTIONS -fglasgow-exts #-}
> {-# LANGUAGE ForeignFunctionInterface #-}
> {-# LANGUAGE CPP #-}
> module Database.PostgreSQL.PGFunctions where
> import Prelude hiding (catch)
> import Database.Util
> import Control.Monad
> import Control.Exception.Extensible
> import Data.Dynamic
> import Data.Int
> import Data.Time
> import Foreign
> import Foreign.C
> import Foreign.C.UTF8
> import Foreign.Ptr
> import System.IO
> import System.Time
> data DBHandleStruct = PGconn
> type DBHandle = Ptr DBHandleStruct
> data StmtStruct = PGresult
> type ResultSetHandle = Ptr StmtStruct
> type Oid = CUInt -- from postgres_ext.h
> type Format = CInt
> type Void = ()
> type ParamLen = CInt
> invalidOid = 0
> -- type Blob = Ptr Word8
> data PGException = PGException Int String
> deriving (Typeable)
> instance Show PGException where
> show (PGException i s) = "PGException " ++ (show i) ++ " " ++ s
> catchPG :: IO a -> (PGException -> IO a) -> IO a
> throwPG :: Integral i => i -> String -> a
> rethrowPG :: PGException -> a
> instance Exception PGException
> catchPG = catch
> throwPG rc s = throw (PGException (fromIntegral rc) s)
> rethrowPG = throw
> cStr :: CStringLen -> CString
> cStr = fst
> cStrLen :: CStringLen -> CInt
> cStrLen = fromIntegral . snd
PG sends binary data in big-endian byte-order (AKA network byte order)
at least according to the manual page for the DECLARE command
(in the Reference section of the manual).
The example C programs in the manual use the htonl/ntohl functions
to reverse the byte order before-sending/after-receiving (resp.)
I've included the decls here for reference, but we now use a
Haskell function to achieve the same result.
Note that this only works in little-endian platforms, like x86.
We need something better to detect endian-ness and choose whether
or not to reverse.
include C:\MinGW\include\winsock.h
foreign import stdcall "winsock.h htonl" htonl :: Word32 -> Word32
foreign import stdcall "winsock.h ntohl" ntohl :: Word32 -> Word32
> foreign import ccall "libpq-fe.h PQconnectdb" fPQconnectdb
> :: CString -> IO DBHandle
> foreign import ccall "libpq-fe.h PQfinish" fPQfinish
> :: DBHandle -> IO ()
From the PostgreSQL 8.0.0 docs, postgresql/libpq.html:
This function will close the connection to the server and attempt to
reestablish a new connection to the same server, using all the same
parameters previously used. This may be useful for error recovery if a
working connection is lost.
> foreign import ccall "libpq-fe.h PQreset" fPQreset
> :: DBHandle -> IO ()
Returns the database name of the connection
This is guaranteed by the Postgresql documentation to be a pure function
> foreign import ccall "libpq-fe.h PQdb" fPQdb
> :: DBHandle -> CString
Inquire the connection status
> type ConnStatusType = CInt -- enumeration, see libpq-fe.h
> [eCONNECTION_OK,eCONNECTION_BAD] = [0..1]::[ConnStatusType]
> foreign import ccall "libpq-fe.h PQstatus" fPQstatus
> :: DBHandle -> IO ConnStatusType
Returns the error message most recently generated by an operation on the
connection.
> foreign import ccall "libpq-fe.h PQerrorMessage" fPQerrorMessage
> :: DBHandle -> IO CString
Set client charset (UTF8 etc)
> foreign import ccall "libpq-fe.h PQsetClientEncoding" fPQsetClientEncoding
> :: DBHandle -> CString -> IO CString
28.10. Notice Processing
We have a couple of callback hooks for server notice messages.
The C decls are:
typedef void (*PQnoticeReceiver) (void *arg, const PGresult *res);
PQnoticeReceiver PQsetNoticeReceiver(PGconn *conn, PQnoticeReceiver proc, void *arg);
typedef void (*PQnoticeProcessor) (void *arg, const char *message);
PQnoticeProcessor PQsetNoticeProcessor(PGconn *conn, PQnoticeProcessor proc, void *arg);
> type NoticeReceiver = Ptr () -> ResultSetHandle -> IO ()
> type NoticeProcessor = Ptr () -> CString -> IO ()
We need the wrapper to turn our NoticeReceiver-typed function
into something libpq can consume.
This decl will make GHC create the wrapper function for us.
GHC generates files PGFunctions_stub.h and PGFunctions_stub.c.
The wrapper decl syntax is odd, as it's more an export than an import...
> foreign import ccall "wrapper" mkNoticeReceiver ::
> NoticeReceiver -> IO (FunPtr NoticeReceiver)
> foreign import ccall "wrapper" mkNoticeProcessor ::
> NoticeProcessor -> IO (FunPtr NoticeProcessor)
> foreign import ccall "libpq-fe.h PQsetNoticeReceiver" fPQsetNoticeReceiver
> :: DBHandle -> FunPtr NoticeReceiver -> Ptr () -> IO (FunPtr NoticeReceiver)
> foreign import ccall "libpq-fe.h PQsetNoticeProcessor" fPQsetNoticeProcessor
> :: DBHandle -> FunPtr NoticeProcessor -> Ptr () -> IO (FunPtr NoticeProcessor)
Execution of commands
We don't use fPQexec; the docs suggest fPQexecParams is better anyway
(better defense from SQL injection attacks, etc).
foreign import ccall "libpq-fe.h PQexec" fPQexec
:: DBHandle -> CString -> IO ResultSetHandle
> foreign import ccall "libpq-fe.h PQexecParams" fPQexecParams
> :: DBHandle -> CString -> CInt -> Ptr Oid -> Ptr Void -> Ptr ParamLen -> Ptr Format ->
> CInt -> IO ResultSetHandle
> foreign import ccall "libpq-fe.h PQprepare" fPQprepare
> :: DBHandle -> CString -> CString -> CInt -> Ptr Oid -> IO ResultSetHandle
> foreign import ccall "libpq-fe.h PQexecPrepared" fPQexecPrepared
> :: DBHandle -> CString -> CInt -> Ptr Void -> Ptr ParamLen -> Ptr Format ->
> CInt -> IO ResultSetHandle
> foreign import ccall "libpq-fe.h PQresultStatus" fPQresultStatus
> :: ResultSetHandle -> IO ExecStatusType
> type ExecStatusType = CInt -- enumeration, see libpq-fe.h
> (ePGRES_EMPTY_QUERY :
> ePGRES_COMMAND_OK :
> ePGRES_TUPLES_OK :
> ePGRES_COPY_OUT :
> ePGRES_COPY_IN :
> ePGRES_BAD_RESPONSE :
> ePGRES_NONFATAL_ERROR :
> ePGRES_FATAL_ERROR :
> _)
> = [0..] :: [ExecStatusType]
> (textResultSet:binaryResultSet:_) = [0,1] :: [CInt]
> (textParameters:__binaryParameters:_) = [0,1] :: [CInt]
> foreign import ccall "libpq-fe.h PQresultErrorMessage" fPQresultErrorMessage
> :: ResultSetHandle -> IO CString
> foreign import ccall "libpq-fe.h PQclear" fPQclear
> :: ResultSetHandle -> IO ()
Retrieving Query Result Information
> foreign import ccall "libpq-fe.h PQntuples" fPQntuples
> :: ResultSetHandle -> IO CInt
> foreign import ccall "libpq-fe.h PQnfields" fPQnfields
> :: ResultSetHandle -> IO CInt
Inquiry about a column; Column numbers start at 0
> foreign import ccall "libpq-fe.h PQfname" fPQfname
> :: ResultSetHandle -> CInt -> IO CString
> foreign import ccall "libpq-fe.h PQfformat" fPQfformat
> :: ResultSetHandle -> CInt -> IO CInt
> foreign import ccall "libpq-fe.h PQftype" fPQftype
> :: ResultSetHandle -> CInt -> IO Oid
Really getting the values
> foreign import ccall "libpq-fe.h PQgetvalue" fPQgetvalue
> :: ResultSetHandle -> CInt -> CInt -> IO (Ptr Word8)
> foreign import ccall "libpq-fe.h PQgetisnull" fPQgetisnull
> :: ResultSetHandle -> CInt -> CInt -> IO CInt
> foreign import ccall "libpq-fe.h PQgetlength" fPQgetlength
> :: ResultSetHandle -> CInt -> CInt -> IO CInt
27.3.3. Retrieving Result Information for Other Commands
> foreign import ccall "libpq-fe.h PQcmdStatus" fPQcmdStatus
> :: ResultSetHandle -> IO CString
> foreign import ccall "libpq-fe.h PQcmdTuples" fPQcmdTuples
> :: ResultSetHandle -> IO CString
> foreign import ccall "libpq-fe.h PQoidValue" fPQoidValue
> :: ResultSetHandle -> IO Oid
27.8. Functions Associated with the COPY Command
> foreign import ccall "libpq-fe.h PQputCopyData" fPQputCopyData
> :: DBHandle -> Ptr Word8 -> CInt -> IO CInt
> foreign import ccall "libpq-fe.h PQputCopyEnd" fPQputCopyEnd
> :: DBHandle -> CString -> IO CInt
> foreign import ccall "libpq-fe.h PQgetResult" fPQgetResult
> :: DBHandle -> IO ResultSetHandle
27.9. Control Functions
> type PGVerbosity = CInt -- enumeration, see libpq-fe.h
> (ePQERRORS_TERSE :
> ePQERRORS_DEFAULT :
> ePQERRORS_VERBOSE :
> _) = [0..]::[PGVerbosity]
> foreign import ccall "libpq-fe.h PQsetErrorVerbosity" fPQsetErrorVerbosity
> :: DBHandle -> PGVerbosity -> IO PGVerbosity
28.3. Large Objects. Client Interfaces
> type LOAccessType = CInt -- enumeration, see libpq-fs.h
> [eINV_WRITE,eINV_READ] = [0x00020000,0x00040000]::[LOAccessType]
> type WhenceType = CInt -- enumeration, see <sys/unistd.h>
> [eSEEK_SET,eSEEK_CUR,eSEEK_END] = [0,1,2]::[WhenceType]
> foreign import ccall "libpq-fe.h lo_creat" flo_creat
> :: DBHandle -> LOAccessType -> IO Oid
> foreign import ccall "libpq-fe.h lo_import" flo_import
> :: DBHandle -> CString -> IO Oid
> foreign import ccall "libpq-fe.h lo_export" flo_export
> :: DBHandle -> Oid -> CString -> IO CInt
> foreign import ccall "libpq-fe.h lo_open" flo_open
> :: DBHandle -> Oid -> LOAccessType -> IO CInt
> foreign import ccall "libpq-fe.h lo_write" flo_write
> :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
> foreign import ccall "libpq-fe.h lo_read" flo_read
> :: DBHandle -> CInt -> Ptr Word8 -> CUInt -> IO CInt
> foreign import ccall "libpq-fe.h lo_lseek" flo_lseek
> :: DBHandle -> CInt -> CInt -> WhenceType -> IO CInt
> foreign import ccall "libpq-fe.h lo_tell" flo_tell
> :: DBHandle -> CInt -> IO CInt
> foreign import ccall "libpq-fe.h lo_close" flo_close
> :: DBHandle -> CInt -> IO CInt
> foreign import ccall "libpq-fe.h lo_unlink" flo_unlink
> :: DBHandle -> Oid -> IO CInt
-------------------------------------------------------------------
Middle-level interface
Get the current error message
> getError :: DBHandle -> IO String
> getError db = fPQerrorMessage db >>= peekUTF8String
conn'parm is a string with all the attributes
> openDb :: String -> IO DBHandle
> openDb conn'parm =
> withUTF8String conn'parm $ \cstr -> do
> db <- fPQconnectdb cstr
> if db == nullPtr
> then throwPG (-1) "Null PGconn handle from PQconnectdb"
> else do
> rc <- fPQstatus db
> if rc == eCONNECTION_OK
> then do
> setClientEncoding db "UTF8"
> return db
> else do
> emsg <- getError db
> fPQfinish db
> throwPG rc emsg
> closeDb :: DBHandle -> IO ()
> closeDb db = fPQfinish db
> ignoreNotices _ _ = return ()
> reportNotices _ cstr = peekUTF8String cstr >>= hPutStrLn stderr
> disableNoticeReporting db = do
> r <- mkNoticeProcessor ignoreNotices
> fPQsetNoticeProcessor db r nullPtr
> enableNoticeReporting db = do
> r <- mkNoticeProcessor reportNotices
> fPQsetNoticeProcessor db r nullPtr
> setErrorVerbosity db verb = fPQsetErrorVerbosity db verb >> return ()
> setClientEncoding db enc =
> withUTF8String enc (\s -> fPQsetClientEncoding db s)
-----------------------------------------------------------
Here we define a class useful in marshalling
Haskell values to and from their Postgres counterparts
(for binding and defining).
We can find the OIDs with this query:
select oid, typname from pg_type
Types we'll map:
18 char
25 text
21 int2
23 int4
20 int8
700 float4
701 float8
1114 timestamp
1184 timestamptz
1700 numeric
For ints and doubles/floats, we need to check what size they are
and choose the appropriate oid.
PG timestamps are stored as 8-byte Doubles (i.e. double-precision
floating point) holding the seconds before or after midnight 2000-01-01.
date = oid 1082 (4 bytes)
time = oid 1083 (8 bytes)
timetz = oid 1266 (12 bytes)
timestamp (sans time zone) = oid 1114 (8 bytes)
timestamptz (with time zone) = oid 1184 (8 bytes)
> class PGType a where
> pgTypeFormat :: a -> Format -- ^ 1 == binary (default), 0 == text
> pgTypeOid :: a -> Oid
> pgNewValue :: a -> IO (Ptr Word8)
> pgPeek :: Ptr Word8 -> IO a
> pgSize :: a -> Int
> -- default impls
> pgTypeFormat _ = textParameters
> instance PGType a => PGType (Maybe a) where
> pgTypeFormat Nothing = pgTypeFormat (undefined::a)
> pgTypeFormat (Just v) = pgTypeFormat v
> pgTypeOid Nothing = pgTypeOid (undefined::a)
> pgTypeOid (Just v) = pgTypeOid v
> pgNewValue Nothing = return nullPtr
> pgNewValue (Just v) = pgNewValue v
> pgPeek ptr = if ptr == nullPtr then return Nothing else pgPeek ptr >>= return . Just
> pgSize Nothing = 0 -- what is the size of a null value?... probably irrelevant
> pgSize (Just v) = pgSize v
timestamp and timestamp with time zone are probably exactly the same
in terms of internal representation, so it's really just an input-output
semantics that the two types distinguish.
> instance PGType UTCTime where
> pgTypeOid _ = 1114
> pgNewValue v = pgNewValue (utcTimeToPGDatetime v)
> pgPeek p = pgPeek p >>= return . pgDatetimetoUTCTime
> pgSize v = pgSize (utcTimeToPGDatetime v)
> instance PGType CalendarTime where
> pgTypeOid _ = 1114
> pgNewValue v = pgNewValue (calTimeToPGDatetime v)
> pgPeek p = pgPeek p >>= return . pgDatetimetoCalTime
> pgSize v = pgSize (calTimeToPGDatetime v)
We assume all Strings are UTF8 encoded.
> instance PGType String where
> pgTypeOid _ = 25
> pgNewValue s = newUTF8String s >>= return . castPtr
> pgPeek p = peekUTF8String (castPtr p) >>= return
> pgSize s = lengthUTF8 s
> instance PGType Char where
> pgTypeOid _ = 18
> -- need to cast to CChar because we don't know what the Storable instance
> -- for Char does; does it write 4 bytes, or just the lowest one?
> pgNewValue v = malloc >>= \p -> poke p (toCChar v) >> return (castPtr p)
> pgPeek p = peek (castPtr p) >>= return . fromCChar
> pgSize _ = sizeOf 'a'
> instance PGType Int16 where
> pgTypeOid _ = 21
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Int32 where
> pgTypeOid _ = 23
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Int64 where
> pgTypeOid _ = 20
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Int where
> pgTypeOid v = 1700
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Integer where
> pgTypeOid v = 1700
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Double where
> pgTypeOid v = 1700
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> instance PGType Float where
> pgTypeOid v = 1700
> pgNewValue v = pgNewValue (show v)
> pgPeek p = pgPeek p >>= return . read
> pgSize v = pgSize (show v)
> data PGBindVal = PGBindVal
> { bindValOid :: Oid
> , bindValFormat :: Format
> , bindValSize :: CInt
> , bindValPtr :: IO (Ptr Word8)
> }
newBindVal is useful when creating lists of bind values,
for passing to the stmtExec and prepare'n'exec functions.
> newBindVal v = PGBindVal (pgTypeOid v) (pgTypeFormat v) (toCInt (pgSize v)) (pgNewValue v)
> bindTypes vs = map bindValOid vs
> toCChar :: Char -> CChar; toCChar = toEnum . fromEnum
> fromCChar :: CChar -> Char; fromCChar = toEnum . fromEnum
> toCInt :: Int -> CInt; toCInt = fromIntegral
-----------------------------------------------------------
Check the ResultSetHandle returned by fPQexec and similar functions
> check'stmt :: DBHandle -> ExecStatusType -> ResultSetHandle -> IO ResultSetHandle
> check'stmt db _ stmt
> | stmt == nullPtr = do -- something is really wrong
> emsg <- getError db
> rc <- fPQstatus db
> throwPG rc emsg
> check'stmt _ expected'status stmt = do
> rc <- fPQresultStatus stmt
> if rc == expected'status then return stmt
> else do
> msg <- fPQresultErrorMessage stmt >>= peekUTF8String
> fPQclear stmt
> throwPG rc msg
> stmtPrepare :: DBHandle -> String -> String -> [Oid] -> IO String
> stmtPrepare db stmt'name sqlText types =
> withUTF8String stmt'name $ \csn -> do
> withUTF8String sqlText $ \cstr -> do
> withArray types $ \ctypearray -> do
> let np = fromIntegral $ length types
> stmt <- fPQprepare db csn cstr np ctypearray
> check'stmt db ePGRES_COMMAND_OK stmt
> fPQclear stmt -- doesn't have any useful info
> return stmt'name
Execute some kind of statement that returns no tuples.
Because this is a frequently used function, we code it specially
(rather than invoking a more generic execCommand).
> nqExec :: DBHandle -> String -> IO (String, String, Oid)
> nqExec db sqlText =
> withUTF8String sqlText $ \cstr ->
> do
> stmt <- fPQexecParams db cstr 0 nullPtr nullPtr nullPtr nullPtr textResultSet
> >>= check'stmt db ePGRES_COMMAND_OK
> -- save all information from PGresult and free it
> cmd'status <- fPQcmdStatus stmt >>= peekUTF8String
> cmd'ntuples <- fPQcmdTuples stmt >>= peekUTF8String
> cmd'oid <- fPQoidValue stmt
> fPQclear stmt
> return (cmd'status, cmd'ntuples, cmd'oid)
> execCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
> execCommand db sqlText bindvals = do
> stmtPrepare db "" sqlText (bindTypes bindvals)
> execPreparedCommand db "" bindvals
| This is for commands, as opposed to queries.
The query equivalent of 'execPreparedCommand' is 'stmtExec'.
> execPreparedCommand :: DBHandle -> String -> [PGBindVal] -> IO (String, String, Oid)
> execPreparedCommand db stmtname bindvals = do
> (rs, ntuples) <- execPrepared db stmtname bindvals ePGRES_COMMAND_OK
> -- save all information from PGresult and free it
> cmd'status <- fPQcmdStatus rs >>= peekUTF8String
> cmd'ntuples <- fPQcmdTuples rs >>= peekUTF8String
> cmd'oid <- fPQoidValue rs
> stmtFinalise rs
> return (cmd'status, cmd'ntuples, cmd'oid)
Prepare and Execute a query. Returns results as binary.
> stmtExecImm :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
> stmtExecImm db sqlText bindvals = do
> let np = fromIntegral $ length bindvals
> withUTF8String sqlText $ \cstr -> do
> withArray (map bindValOid bindvals) $ \coidarray -> do
> withArray (map bindValSize bindvals) $ \clenarray -> do
> withArray (map bindValFormat bindvals) $ \cformatarray -> do
> -- The bindValPtrs are IO actions; executing them (via sequence)
> -- creates the bind values (allocates storage, pokes values, etc).
> -- We must remember to free these later.
> paramlist <- sequence (map bindValPtr bindvals)
> withArray paramlist $ \cparamarray -> do
> rs <- fPQexecParams db cstr np coidarray (castPtr cparamarray) clenarray cformatarray textResultSet
> mapM_ (\p -> if p == nullPtr then return () else free p) paramlist
> check'stmt db ePGRES_TUPLES_OK rs
> ntuples <- fPQntuples rs
> return (rs, fromIntegral ntuples)
A simple version with no binding parameters and returning results as text
> stmtExecImm0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
> stmtExecImm0 db sqlText =
> withUTF8String sqlText $ \cstr -> do
> rs <- fPQexecParams db cstr 0 nullPtr nullPtr nullPtr nullPtr textResultSet
> check'stmt db ePGRES_TUPLES_OK rs
> ntuples <- fPQntuples rs
> return (rs, fromIntegral ntuples)
Execute a previously prepared query, with no params.
> stmtExec0 :: DBHandle -> String -> IO (ResultSetHandle, Int)
> stmtExec0 db stmt'name = stmtExec0bt db stmt'name binaryResultSet
> stmtExec0t :: DBHandle -> String -> IO (ResultSetHandle, Int)
> stmtExec0t db stmt'name = stmtExec0bt db stmt'name textResultSet
> stmtExec0bt db stmt'name binary_or_text =
> withUTF8String stmt'name $ \cstmtname -> do
> rs <- fPQexecPrepared db cstmtname 0 nullPtr nullPtr nullPtr
> binary_or_text
> check'stmt db ePGRES_TUPLES_OK rs
> ntuples <- fPQntuples rs
> return (rs, fromIntegral ntuples)
Execute a previously prepared query, with params.
> stmtExec :: DBHandle -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
> stmtExec db stmt'name bindvals = execPrepared db stmt'name bindvals ePGRES_TUPLES_OK
This is used for both queries and commands.
We have to pass the expected PQresult code, because
queries return ePGRES_TUPLES_OK while commands return ePGRES_COMMAND_OK.
> execPrepared :: DBHandle -> String -> [PGBindVal] -> CInt -> IO (ResultSetHandle, Int)
> execPrepared db stmt'name bindvals rc = do
> let np = fromIntegral $ length bindvals
> withUTF8String stmt'name $ \cstmtname -> do
> withArray (map bindValSize bindvals) $ \clenarray -> do
> withArray (map bindValFormat bindvals) $ \cformatarray -> do
> -- The bindValPtrs are IO actions; executing them (via sequence)
> -- creates the bind values (allocates storage, pokes values, etc).
> -- We must remember to free these later.
> paramlist <- sequence (map bindValPtr bindvals)
> withArray paramlist $ \cparamarray -> do
> rs <- fPQexecPrepared db cstmtname np (castPtr cparamarray) clenarray cformatarray textResultSet
> mapM_ (\p -> if p == nullPtr then return () else free p) paramlist
> check'stmt db rc rs
> ntuples <- fPQntuples rs
> return (rs, fromIntegral ntuples)
> prepare'n'exec :: DBHandle -> String -> String -> [PGBindVal] -> IO (ResultSetHandle, Int)
> prepare'n'exec db stmtname stmt bindvals = do
> let np = fromIntegral $ length bindvals
> withUTF8String stmtname $ \cstmtname -> do
> withUTF8String stmt $ \cstmt -> do
> withArray (map bindValOid bindvals) $ \coidarray -> do
> rs <- fPQprepare db cstmtname cstmt np coidarray
> check'stmt db ePGRES_COMMAND_OK rs
> execPrepared db stmtname bindvals ePGRES_TUPLES_OK
Free storage, that is. No error in Postgres
> stmtFinalise :: ResultSetHandle -> IO ()
> stmtFinalise = fPQclear
|Column numbers are zero-indexed, so subtract one
from given index (we present a one-indexed interface).
So are the row numbers.
> colValPtr :: ResultSetHandle -> Int -> Int -> IO (Ptr Word8)
> colValPtr rs row col = do
> nr <- fPQntuples rs
> nc <- fPQnfields rs
> if (fromIntegral nr) < row || row < 1
> then throwPG (-1) ("Attempted fetch from invalid row number " ++ show row)
> else
> if (fromIntegral nc) < col || col < 1
> then throwPG (-1) ("Attempted fetch from invalid column number " ++ show col)
> else fPQgetvalue rs (toCInt (row-1)) (toCInt (col-1)) >>= return . castPtr
> colVal :: PGType a => ResultSetHandle -> Int -> Int -> IO a
> colVal rs row col = colValPtr rs row col >>= pgPeek
> colValString :: ResultSetHandle -> Int -> Int -> IO String
> colValString = colVal
> colValInt :: ResultSetHandle -> Int -> Int -> IO Int
> colValInt = colVal
> colValInt64 :: ResultSetHandle -> Int -> Int -> IO Int64
> colValInt64 = colVal
> colValDouble :: ResultSetHandle -> Int -> Int -> IO Double
> colValDouble = colVal
> colValFloat :: ResultSetHandle -> Int -> Int -> IO Float
> colValFloat = colVal
> colValUTCTime :: ResultSetHandle -> Int -> Int -> IO UTCTime
> colValUTCTime = colVal
> colValCalTime :: ResultSetHandle -> Int -> Int -> IO CalendarTime
> colValCalTime = colVal
> colValNull :: ResultSetHandle -> Int -> Int -> IO Bool
> colValNull rs row col = do
> ind <- fPQgetisnull rs (toCInt (row-1)) (toCInt (col-1))
> return (ind /= 0)
> {-
> colValBlob :: ResultSetHandle -> Int -> Int -> IO (ForeignPtr Blob)
> colValBlob rs row col = do
> let ccolnum = fromIntegral (colnum - 1)
> bytes <- sqliteColumnBytes stmt ccolnum
> src <- sqliteColumnBlob stmt ccolnum
> buffer <- mallocForeignPtrBytes bytes
> withForeignPtr buffer $ \dest -> copyBytes dest src bytes
> return (castForeignPtr buffer)
> -}
> substituteBindPlaceHolders sql = sbph sql 1 False ""
> sbph :: String -> Int -> Bool -> String -> String
> sbph [] _ _ acc = reverse acc
> sbph ('\'':cs) i inQuote acc = sbph cs i (not inQuote) ('\'':acc)
> sbph ('?':cs) i False acc = sbph cs (i+1) False ((reverse (show i)) ++ ('$':acc))
> sbph (c:cs) i inQuote acc = sbph cs i inQuote (c:acc)
Execute the COPY FROM STDIN command
> nqCopyIn_buflen :: Int
> nqCopyIn_buflen = 8192
> nqCopyIn :: DBHandle -> String -> Handle -> IO ()
> nqCopyIn db sqlText hin =
> withUTF8String sqlText $ \cstr ->
> allocaBytes nqCopyIn_buflen $ \buffer ->
> do
> stmt <- fPQexecParams db cstr 0 nullPtr nullPtr nullPtr nullPtr 0
> >>= check'stmt db ePGRES_COPY_IN
> let check'copy'status 1 = return ()
> check'copy'status _ = do
> emsg <- getError db
> rc <- fPQstatus db
> throwPG rc emsg
> let loop = do
> len <- hGetBuf hin buffer nqCopyIn_buflen
> if len < 0 then withUTF8String "IO error" $ fPQputCopyEnd db
> else if len == 0 then fPQputCopyEnd db nullPtr
> else fPQputCopyData db buffer (fromIntegral len) >>=
> check'copy'status >> loop
> res <- loop
> fPQclear stmt
> check'copy'status res
> -- finishing, checking the final status
> fPQgetResult db >>= check'stmt db ePGRES_COMMAND_OK >>= fPQclear