diff --git a/src/Database/PostgreSQL/LibPQ.hsc b/src/Database/PostgreSQL/LibPQ.hsc index 8496879..8699b56 100644 --- a/src/Database/PostgreSQL/LibPQ.hsc +++ b/src/Database/PostgreSQL/LibPQ.hsc @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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