Merge pull request #30 from haskellari/common-params

exec, query: factor out common parameter handling helpers

Author: phadej

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