Revised string handling to avoid memcpy when possible.

Database/PQ.hsc

@@ -78,6 +78,7 @@ module Database.PQ
     , fmod
     , fsize
     , getvalue
+    , getvalue'
     , getisnull
     , getlength
     , nparams
@@ -140,10 +141,10 @@ where
 #include <libpq-fe.h>
 
 import Prelude hiding ( print )
-import Control.Monad ( when )
 import Foreign
 import Foreign.C.Types
 import Foreign.C.String
+import qualified Foreign.Concurrent as FC
 import GHC.Conc ( -- threadWaitRead
                  threadWaitWrite)
 import System.Posix.Types ( Fd(..) )
@@ -338,40 +339,53 @@ finish (Conn mvar) =
 
 -- | Returns the database name of the connection.
 db :: Connection
-   -> IO B.ByteString
+   -> IO (Maybe B.ByteString)
 db = statusString c_PQdb
 
 
 -- | Returns the user name of the connection.
 user :: Connection
-     -> IO B.ByteString
+     -> IO (Maybe B.ByteString)
 user = statusString c_PQuser
 
 
 -- | Returns the password of the connection.
 pass :: Connection
-     -> IO B.ByteString
+     -> IO (Maybe B.ByteString)
 pass = statusString c_PQpass
 
 
 -- | Returns the server host name of the connection.
 host :: Connection
-     -> IO B.ByteString
+     -> IO (Maybe B.ByteString)
 host = statusString c_PQhost
 
 
 -- | Returns the port of the connection.
 port :: Connection
-     -> IO B.ByteString
+     -> IO (Maybe B.ByteString)
 port = statusString c_PQport
 
 
 -- | Returns the command-line options passed in the connection request.
 options :: Connection
-        -> IO B.ByteString
+        -> IO (Maybe B.ByteString)
 options = statusString c_PQoptions
 
 
+-- | Helper function that checks for nullPtrs and returns the empty
+-- string.
+statusString :: (Ptr PGconn -> IO CString)
+             -> Connection
+             -> IO (Maybe B.ByteString)
+statusString f connection =
+    withConn connection $ \ptr ->
+        do cstr <- f ptr
+           if cstr == nullPtr
+             then return Nothing
+             else Just `fmap` B.packCString cstr
+
+
 data ConnStatus
     = ConnectionOk                 -- ^ The 'Connection' is ready.
     | ConnectionBad                -- ^ The connection procedure has failed.
@@ -499,21 +513,8 @@ serverVersion connection =
 -- newline. The result string should not be expected to remain the
 -- same across operations on the 'Connection'.
 errorMessage :: Connection
-             -> IO B.ByteString
-errorMessage = statusString c_PQerrorMessage
-
-
--- | Helper function that checks for nullPtrs and returns the empty
--- string.
-statusString :: (Ptr PGconn -> IO CString)
-             -> Connection
-             -> IO B.ByteString
-statusString f connection =
-    withConn connection $ \ptr ->
-        do cstr <- f ptr
-           if cstr == nullPtr
-             then return ""
-             else B.packCString cstr
+             -> IO (Maybe B.ByteString)
+errorMessage = flip maybeBsFromConn c_PQerrorMessage
 
 
 -- | Obtains the file descriptor number of the connection socket to
@@ -877,9 +878,8 @@ resStatus es =
 -- | Returns the error message most recently generated by an operation
 -- on the connection.
 resultErrorMessage :: Result
-                   -> IO B.ByteString
-resultErrorMessage (Result res) =
-    B.packCString =<< withForeignPtr res c_PQresultErrorMessage
+                   -> IO (Maybe B.ByteString)
+resultErrorMessage = flip maybeBsFromResult c_PQresultErrorMessage
 
 
 data FieldCode = DiagSeverity
@@ -1004,13 +1004,9 @@ instance Enum FieldCode where
 resultErrorField :: Result
                  -> FieldCode
                  -> IO (Maybe B.ByteString)
-resultErrorField result fieldcode =
-    withResult result $ \res ->
-        do cstr <- c_PQresultErrorField res $ fromIntegral $ fromEnum fieldcode
-           if cstr == nullPtr
-             then return Nothing
-             else Just `fmap` B.packCString cstr
-
+resultErrorField (Result fp) fieldcode =
+    maybeBsFromForeignPtr fp $ \res ->
+        c_PQresultErrorField res $ fromIntegral $ fromEnum fieldcode
 
 
 -- $queryresultinfo
@@ -1052,20 +1048,10 @@ toRow = Row . fromIntegral
 -- number. Column numbers start at 0.
 fname :: Result
       -> Column
-      -> IO B.ByteString
+      -> IO (Maybe B.ByteString)
 fname result (Col colNum) =
-    do nf <- nfields result
-       when (colNum < 0 || colNum >= fromIntegral nf) (failure nf)
-       withResult result $ \fp ->
-           do cs <- c_PQfname fp colNum
-              if cs == nullPtr
-                then failure nf
-                else B.packCString cs
-    where
-      failure nf = fail ("column number " ++
-                         show colNum ++
-                         " is out of range 0.." ++
-                         show (nf - 1))
+    maybeBsFromResult result $ \fp ->
+        c_PQfname fp colNum
 
 
 -- | Returns the column number associated with the given column name.
@@ -1154,19 +1140,47 @@ fsize result (Col colNum) = numFromResult result $ \ptr -> c_PQfsize ptr colNum
 --
 -- For convenience, this binding uses 'getisnull' and 'getlength' to
 -- help construct the result.
+--
+-- Note: The 'ByteString' returned holds a reference to the Result. As
+-- long as ByteString is live, the Result will not be garbage
+-- collected. 'getvalue'' returns a copy of the data.
 getvalue :: Result
          -> Row
          -> Column
          -> IO (Maybe B.ByteString)
-getvalue (Result res) (Row rowNum) (Col colNum) =
-  withForeignPtr res $ \ptr -> do
-    isnull <- c_PQgetisnull ptr rowNum colNum
-    if toEnum $ fromIntegral isnull
-      then return $ Nothing
+getvalue (Result fp) (Row rowNum) (Col colNum) =
+    withForeignPtr fp $ \ptr -> do
+      isnull <- c_PQgetisnull ptr rowNum colNum
+      if toEnum $ fromIntegral isnull
+        then return $ Nothing
+
+        else do cstr <- c_PQgetvalue ptr rowNum colNum
+                l <- c_PQgetlength ptr rowNum colNum
+                fp' <- FC.newForeignPtr (castPtr cstr) finalizer
+                return $ Just $ B.fromForeignPtr fp' 0 $ fromIntegral l
+
+    where
+      finalizer = touchForeignPtr fp
+
 
-      else do cstr <- c_PQgetvalue ptr rowNum colNum
-              len <- c_PQgetlength ptr rowNum colNum
-              fmap Just $ B.packCStringLen (cstr, fromIntegral len)
+-- | Returns a copy of a single field value of one row of a
+-- PGresult. Row and column numbers start at 0.
+--
+-- For convenience, this binding uses 'getisnull' and 'getlength' to
+-- help construct the result.
+getvalue' :: Result
+          -> Row
+          -> Column
+          -> IO (Maybe B.ByteString)
+getvalue' (Result fp) (Row rowNum) (Col colNum) =
+    withForeignPtr fp $ \ptr -> do
+      isnull <- c_PQgetisnull ptr rowNum colNum
+      if toEnum $ fromIntegral isnull
+        then return $ Nothing
+
+        else do cstr <- c_PQgetvalue ptr rowNum colNum
+                l <- fromIntegral `fmap` c_PQgetlength ptr rowNum colNum
+                Just `fmap` B.packCStringLen (cstr, l)
 
 
 -- | Tests a field for a null value. Row and column numbers start at
@@ -1315,10 +1329,8 @@ print h (Result res) po =
 -- Commonly this is just the name of the command, but it might include
 -- additional data such as the number of rows processed.
 cmdStatus :: Result
-          -> IO B.ByteString
-cmdStatus result =
-    withResult result $ \ptr ->
-        c_PQcmdStatus ptr >>= B.packCString
+          -> IO (Maybe B.ByteString)
+cmdStatus = flip maybeBsFromResult c_PQcmdStatus
 
 
 -- | Returns the number of rows affected by the SQL command.
@@ -1332,10 +1344,8 @@ cmdStatus result =
 -- the 'Result' was anything else, 'cmdTuples' returns an empty
 -- string.
 cmdTuples :: Result
-          -> IO B.ByteString
-cmdTuples result =
-    withResult result $ \ptr ->
-        c_PQcmdTuples ptr >>= B.packCString
+          -> IO (Maybe B.ByteString)
+cmdTuples = flip maybeBsFromResult c_PQcmdTuples
 
 
 -- | Returns the 'Oid' of the inserted row, if the SQL command was an
@@ -1702,11 +1712,15 @@ cancel :: Cancel
        -> IO (Either B.ByteString ())
 cancel (Cancel fp) =
     withForeignPtr fp $ \ptr ->
-        allocaBytes errbufsize $ \errbuf ->
-            do res <- c_PQcancel ptr errbuf $ fromIntegral errbufsize
-               case res of
-                 1 -> return $ Right ()
-                 _ -> Left `fmap` B.packCString errbuf
+        do errbuf <- mallocBytes errbufsize
+           res <- c_PQcancel ptr errbuf $ fromIntegral errbufsize
+           case res of
+             1 -> do free errbuf
+                     return $ Right ()
+
+             _ -> do l <- fromIntegral `fmap` B.c_strlen errbuf
+                     fp' <- newForeignPtr finalizerFree $ castPtr errbuf
+                     return $ Left $ B.fromForeignPtr fp' 0 l
 
     where
       errbufsize = 256
@@ -1857,16 +1871,23 @@ untrace :: Connection
 untrace connection = withConn connection c_PQuntrace
 
 
-
-
 withConn :: Connection
          -> (Ptr PGconn -> IO b)
          -> IO b
-withConn (Conn mvar) f =
+withConn connection f =
+    withConn' connection $ flip withForeignPtr f
+
+
+withConn' :: Connection
+          -> (ForeignPtr PGconn -> IO b)
+          -> IO b
+withConn' (Conn mvar) f =
     withMVar mvar $ \mFp ->
         case mFp of
           Nothing -> error "Database connection has been closed"
-          Just fp -> withForeignPtr fp f
+          Just fp -> f fp
+
+
 
 
 enumFromConn :: (Integral a, Enum b) => Connection
@@ -1885,10 +1906,6 @@ resultFromConn connection f =
            else (Just . Result) `fmap` newForeignPtr p_PQclear resPtr
 
 
-
-
-
-
 withResult :: Result
            -> (Ptr PGresult -> IO b)
            -> IO b
@@ -1907,6 +1924,63 @@ enumFromResult :: (Integral a, Enum b) => Result
 enumFromResult result f = fmap (toEnum . fromIntegral) $ withResult result f
 
 
+-- | Returns a ByteString with a finalizer that touches the ForeignPtr
+-- PGconn that \"owns\" the CString to keep it alive.
+--
+-- The CString must be a null terminated c string. nullPtrs are
+-- treated as 'Nothing'.
+maybeBsFromConn :: Connection
+                -> (Ptr PGconn -> IO CString)
+                -> IO (Maybe B.ByteString)
+maybeBsFromConn connection f =
+    withConn' connection $ \fp -> maybeBsFromForeignPtr fp f
+
+
+-- | Returns a ByteString with a finalizer that touches the ForeignPtr
+-- PGresult that \"owns\" the CString to keep it alive.
+--
+-- The CString must be a null terminated c string. nullPtrs are
+-- treated as 'Nothing'.
+maybeBsFromResult :: Result
+                  -> (Ptr PGresult -> IO CString)
+                  -> IO (Maybe B.ByteString)
+maybeBsFromResult (Result res) f = maybeBsFromForeignPtr res f
+
+-- | Returns a ByteString with a finalizer that touches the ForeignPtr
+-- that \"owns\" the CString to keep it alive.
+--
+-- The CString must be a null terminated c string. nullPtrs are
+-- treated as 'Nothing'.
+maybeBsFromForeignPtr :: ForeignPtr a
+                      -> (Ptr a -> IO CString)
+                      -> IO (Maybe B.ByteString)
+maybeBsFromForeignPtr fp f =
+    withForeignPtr fp $ \p ->
+        do cstr <- f p
+           if cstr == nullPtr
+             then return Nothing
+             else do l <- fromIntegral `fmap` B.c_strlen cstr
+                     fp' <- FC.newForeignPtr (castPtr cstr) finalizer
+                     return $ Just $ B.fromForeignPtr fp' 0 l
+    where
+      finalizer = touchForeignPtr fp
+
+-- -- | Returns a ByteString with a finalizer that touches the ForeignPtr
+-- -- that \"owns\" the CStringLen to keep it alive.
+-- bsFromForeignPtrLen :: ForeignPtr a
+--                     -> (Ptr a -> IO CStringLen)
+--                     -> IO B.ByteString
+-- bsFromForeignPtrLen fp f =
+--     withForeignPtr fp $ \p ->
+--         do (cstr, l) <- f p
+--            if cstr == nullPtr
+--              then return ""
+--              else do fp' <- FC.newForeignPtr (castPtr cstr) finalizer
+--                      return $ B.fromForeignPtr fp' 0 l
+--     where
+--       finalizer = touchForeignPtr fp
+
+
 foreign import ccall safe "libpq-fe.h PQconnectdb"
     c_PQconnectdb :: CString ->IO (Ptr PGconn)