Skip to content

exec, query: factor out common parameter handling helpers #30

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Nov 3, 2022
Merged

exec, query: factor out common parameter handling helpers #30

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
182 changes: 90 additions & 92 deletions src/Database/PostgreSQL/LibPQ.hsc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -225,7 +225,6 @@ import qualified Foreign.ForeignPtr.Unsafe as Unsafe
#endif
import qualified Foreign.Concurrent as FC
import System.Posix.Types ( Fd(..) )
import Data.List ( foldl' )
import System.IO ( IOMode(..), SeekMode(..) )

#if __GLASGOW_HASKELL__ >= 700
Expand Down Expand Up @@ -746,6 +745,71 @@ newtype Oid = Oid CUInt deriving (Eq, Ord, Read, Show, Storable, Typeable)
invalidOid :: Oid
invalidOid = Oid (#const InvalidOid)

-- | Convert a list of parameters to the format expected by libpq FFI calls.
withParams :: [Maybe (Oid, B.ByteString, Format)]
-> (CInt -> Ptr Oid -> Ptr CString -> Ptr CInt -> Ptr CInt -> IO a)
-> IO a
withParams params action =
withArray oids $ \ts ->
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
action n ts vs ls fs
where
AccumParams oids values c_lengths formats =
foldr accum (AccumParams [] [] [] []) params

n :: CInt
!n = intToCInt $ length params

accum :: Maybe (Oid, B.ByteString, Format) -> AccumParams -> AccumParams
accum Nothing ~(AccumParams a b c d) =
AccumParams (invalidOid : a) (Nothing : b) (0 : c) (0 : d)

accum (Just (t,v,f)) ~(AccumParams xs ys zs ws) =
let z = intToCInt (B.length v)
w = formatToCInt f
in z `seq` w `seq` AccumParams (t : xs) (Just v : ys) (z : zs) (w : ws)

formatToCInt :: Format -> CInt
formatToCInt Text = 0
formatToCInt Binary = 1

intToCInt :: Int -> CInt
intToCInt = toEnum

data AccumParams = AccumParams ![Oid] ![Maybe B.ByteString] ![CInt] ![CInt]

-- | Convert a list of parameters to the format expected by libpq FFI calls,
-- prepared statement variant.
withParamsPrepared :: [Maybe (B.ByteString, Format)]
-> (CInt -> Ptr CString -> Ptr CInt -> Ptr CInt -> IO a)
-> IO a
withParamsPrepared params action =
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
action n vs ls fs
where
AccumPrepParams values c_lengths formats =
foldr accum (AccumPrepParams [] [] []) params

n :: CInt
n = intToCInt $ length params

accum :: Maybe (B.ByteString ,Format) -> AccumPrepParams -> AccumPrepParams
accum Nothing ~(AccumPrepParams a b c) =
AccumPrepParams (Nothing : a) (0 : b) (0 : c)

accum (Just (v, f)) ~(AccumPrepParams xs ys zs) =
let y = intToCInt (B.length v)
z = formatToCInt f
in y `seq` z `seq` AccumPrepParams (Just v : xs) (y : ys) (z : zs)

data AccumPrepParams = AccumPrepParams ![Maybe B.ByteString] ![CInt] ![CInt]

-- | Submits a command to the server and waits for the result.
--
-- Returns a 'Result' or possibly 'Nothing'. A 'Result' will generally
Expand Down Expand Up @@ -812,31 +876,12 @@ execParams :: Connection -- ^ connection
-> Format -- ^ result format
-> IO (Maybe Result) -- ^ result
execParams connection statement params rFmt =
do let (oids, values, lengths, formats) =
foldl' accum ([],[],[],[]) $ reverse params
!c_lengths = map toEnum lengths :: [CInt]
!n = toEnum $ length params
!f = toEnum $ fromEnum rFmt
resultFromConn connection $ \c ->
B.useAsCString statement $ \s ->
withArray oids $ \ts ->
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
c_PQexecParams c s n ts vs ls fs f

where
accum (!a,!b,!c,!d) Nothing = ( invalidOid:a
, Nothing:b
, 0:c
, 0:d
)
accum (!a,!b,!c,!d) (Just (t,v,f)) = ( t:a
, (Just v):b
, (B.length v):c
, (toEnum $ fromEnum f):d
)
resultFromConn connection $ \c ->
B.useAsCString statement $ \s ->
withParams params $ \n ts vs ls fs ->
c_PQexecParams c s n ts vs ls fs f
where
!f = formatToCInt rFmt


-- | Submits a request to create a prepared statement with the given
Expand Down Expand Up @@ -885,7 +930,7 @@ prepare connection stmtName query mParamTypes =
B.useAsCString stmtName $ \s ->
B.useAsCString query $ \q ->
maybeWith withArray mParamTypes $ \o ->
let l = maybe 0 (toEnum . length) mParamTypes
let l = maybe 0 (intToCInt . length) mParamTypes
in c_PQprepare c s q l o


Expand All @@ -911,28 +956,13 @@ execPrepared :: Connection -- ^ connection
-> [Maybe (B.ByteString, Format)] -- ^ parameters
-> Format -- ^ result format
-> IO (Maybe Result) -- ^ result
execPrepared connection stmtName mPairs rFmt =
do let (values, lengths, formats) = foldl' accum ([],[],[]) $ reverse mPairs
!c_lengths = map toEnum lengths :: [CInt]
!n = toEnum $ length mPairs
!f = toEnum $ fromEnum rFmt
resultFromConn connection $ \c ->
B.useAsCString stmtName $ \s ->
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
c_PQexecPrepared c s n vs ls fs f

execPrepared connection stmtName params rFmt =
resultFromConn connection $ \c ->
B.useAsCString stmtName $ \s ->
withParamsPrepared params $ \n vs ls fs ->
c_PQexecPrepared c s n vs ls fs f
where
accum (!a,!b,!c) Nothing = ( Nothing:a
, 0:b
, 0:c
)
accum (!a,!b,!c) (Just (v, f)) = ( (Just v):a
, (B.length v):b
, (toEnum $ fromEnum f):c
)
!f = formatToCInt rFmt


-- | Submits a request to obtain information about the specified
Expand Down Expand Up @@ -1676,31 +1706,13 @@ sendQueryParams :: Connection
-> Format
-> IO Bool
sendQueryParams connection statement params rFmt =
do let (oids, values, lengths, formats) =
foldl' accum ([],[],[],[]) $ reverse params
!c_lengths = map toEnum lengths :: [CInt]
!n = toEnum $ length params
!f = toEnum $ fromEnum rFmt
enumFromConn connection $ \c ->
B.useAsCString statement $ \s ->
withArray oids $ \ts ->
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
c_PQsendQueryParams c s n ts vs ls fs f
enumFromConn connection $ \c ->
B.useAsCString statement $ \s ->
withParams params $ \n ts vs ls fs ->
c_PQsendQueryParams c s n ts vs ls fs f

where
accum (!a,!b,!c,!d) Nothing = ( invalidOid:a
, Nothing:b
, 0:c
, 0:d
)
accum (!a,!b,!c,!d) (Just (t,v,f)) = ( t:a
, (Just v):b
, (B.length v):c
, (toEnum $ fromEnum f):d
)
!f = formatToCInt rFmt


-- | Sends a request to create a prepared statement with the given
Expand All @@ -1715,7 +1727,7 @@ sendPrepare connection stmtName query mParamTypes =
B.useAsCString stmtName $ \s ->
B.useAsCString query $ \q ->
maybeWith withArray mParamTypes $ \o ->
let l = maybe 0 (toEnum . length) mParamTypes
let l = maybe 0 (intToCInt . length) mParamTypes
in c_PQsendPrepare c s q l o


Expand All @@ -1726,28 +1738,14 @@ sendQueryPrepared :: Connection
-> [Maybe (B.ByteString, Format)]
-> Format
-> IO Bool
sendQueryPrepared connection stmtName mPairs rFmt =
do let (values, lengths, formats) = foldl' accum ([],[],[]) $ reverse mPairs
!c_lengths = map toEnum lengths :: [CInt]
!n = toEnum $ length mPairs
!f = toEnum $ fromEnum rFmt
enumFromConn connection $ \c ->
B.useAsCString stmtName $ \s ->
withMany (maybeWith B.useAsCString) values $ \c_values ->
withArray c_values $ \vs ->
withArray c_lengths $ \ls ->
withArray formats $ \fs ->
c_PQsendQueryPrepared c s n vs ls fs f
sendQueryPrepared connection stmtName params rFmt =
enumFromConn connection $ \c ->
B.useAsCString stmtName $ \s ->
withParamsPrepared params $ \n vs ls fs ->
c_PQsendQueryPrepared c s n vs ls fs f

where
accum (!a,!b,!c) Nothing = ( Nothing:a
, 0:b
, 0:c
)
accum (!a,!b,!c) (Just (v, f)) = ( (Just v):a
, (B.length v):b
, (toEnum $ fromEnum f):c
)
!f = formatToCInt rFmt


-- | Submits a request to obtain information about the specified
Expand Down