packages feed

HDBC-postgresql 2.3.2.8 → 2.4.0.0

raw patch · 8 files changed

+40/−154 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Changelog +## 2.4.0.0++* Remove custom reference counting logic. Thanks to David Johnson.+ ### 2.3.2.8  * Compatiblity with Cabal 3.2
Database/HDBC/PostgreSQL/Connection.hsc view
@@ -1,5 +1,4 @@ -- -*- mode: haskell; -*--{-# CFILES hdbc-postgresql-helper.c #-} -- Above line for hugs {-# LANGUAGE FlexibleContexts #-} @@ -28,7 +27,7 @@ import Control.Concurrent.MVar import System.IO (stderr, hPutStrLn) import System.IO.Unsafe (unsafePerformIO)-import Control.Exception(bracket) +import Control.Exception(bracket) import Data.Convertible (Convertible)  #include <libpq-fe.h>@@ -64,8 +63,7 @@                                   return globalConnLock                           else newMVar ()             status <- pqstatus ptr-            wrappedptr <- wrapconn ptr nullPtr-            fptr <- newForeignPtr pqfinishptr wrappedptr+            fptr <- newForeignPtr pqfinish ptr             case status of                      #{const CONNECTION_OK} -> mkConn auto_transaction args (connLock,fptr)                      _ -> raiseError "connectPostgreSQL" status ptr@@ -74,14 +72,14 @@ -- for clone. mkConn :: Bool -> String -> Conn -> IO Impl.Connection mkConn auto_transaction args conn = withConn conn $-  \cconn -> +  \cconn ->     do children <- newMVar []        when auto_transaction $ begin_transaction conn children        protover <- pqprotocolVersion cconn        serverver <- pqserverVersion cconn        let clientver = #{const_str PG_VERSION}        let rconn = Impl.Connection {-                            Impl.disconnect = fdisconnect conn children,+                            Impl.disconnect = fdisconnect children,                             Impl.begin = if auto_transaction                                          then return ()                                          else begin_transaction conn children,@@ -141,7 +139,7 @@  fgetTables :: (Convertible SqlValue a) => Conn -> ChildList -> IO [a] fgetTables conn children =-    do sth <- newSth conn children +    do sth <- newSth conn children               "select table_name from information_schema.tables where \                \table_schema != 'pg_catalog' AND table_schema != \                \'information_schema'"@@ -155,7 +153,7 @@  fdescribeSchemaTable :: Conn -> ChildList -> Maybe String -> String -> IO [(String, SqlColDesc)] fdescribeSchemaTable o cl maybeSchema table =-    do sth <- newSth o cl +    do sth <- newSth o cl               ("SELECT attname, atttypid, attlen, format_type(atttypid, atttypmod), attnotnull " ++                "FROM pg_attribute, pg_class, pg_namespace ns " ++                "WHERE relname = ? and attnum > 0 and attisdropped IS FALSE " ++@@ -167,37 +165,28 @@        return $ map desccol res     where       desccol [attname, atttypid, attlen, formattedtype, attnotnull] =-          (fromSql attname, +          (fromSql attname,            colDescForPGAttr (fromSql atttypid) (fromSql attlen) (fromSql formattedtype) (fromSql attnotnull == False))       desccol x =           error $ "Got unexpected result from pg_attribute: " ++ show x-          -fdisconnect :: Conn -> ChildList -> IO ()-fdisconnect conn mchildren = -    do closeAllChildren mchildren-       withRawConn conn $ pqfinish+fdisconnect :: ChildList -> IO ()+fdisconnect = closeAllChildren  foreign import ccall safe "libpq-fe.h PQconnectdb"   pqconnectdb :: CString -> IO (Ptr CConn) -foreign import ccall unsafe "hdbc-postgresql-helper.h wrapobjpg"-  wrapconn :: Ptr CConn -> Ptr WrappedCConn -> IO (Ptr WrappedCConn)--foreign import ccall unsafe "libpq-fe.h PQstatus"+foreign import ccall safe "libpq-fe.h PQstatus"   pqstatus :: Ptr CConn -> IO #{type ConnStatusType} -foreign import ccall unsafe "hdbc-postgresql-helper.h PQfinish_app"-  pqfinish :: Ptr WrappedCConn -> IO ()--foreign import ccall unsafe "hdbc-postgresql-helper.h &PQfinish_finalizer"-  pqfinishptr :: FunPtr (Ptr WrappedCConn -> IO ())+foreign import ccall safe "libpq-fe.h &PQfinish"+  pqfinish :: FunPtr (Ptr CConn -> IO ()) -foreign import ccall unsafe "libpq-fe.h PQprotocolVersion"+foreign import ccall safe "libpq-fe.h PQprotocolVersion"   pqprotocolVersion :: Ptr CConn -> IO CInt -foreign import ccall unsafe "libpq-fe.h PQserverVersion"+foreign import ccall safe "libpq-fe.h PQserverVersion"   pqserverVersion :: Ptr CConn -> IO CInt -foreign import ccall unsafe "libpq.fe.h PQisthreadsafe"+foreign import ccall safe "libpq.fe.h PQisthreadsafe"   pqisThreadSafe :: Ptr CConn -> IO Int
Database/HDBC/PostgreSQL/Statement.hsc view
@@ -1,8 +1,5 @@--- -*- mode: haskell; -*--{-# CFILES hdbc-postgresql-helper.c #-}--- Above line for hugs- module Database.HDBC.PostgreSQL.Statement where+ import Database.HDBC.Types import Database.HDBC import Database.HDBC.PostgreSQL.Types@@ -103,7 +100,7 @@                _ <- handleResultStatus cconn resptr sstate =<< pqresultStatus resptr :: IO Int                return () -handleResultStatus :: (Num a, Read a) => Ptr CConn -> WrappedCStmt -> SState -> ResultStatus -> IO a+handleResultStatus :: (Num a, Read a) => Ptr CConn -> Ptr CStmt -> SState -> ResultStatus -> IO a handleResultStatus cconn resptr sstate status =     case status of       #{const PGRES_EMPTY_QUERY} ->@@ -126,9 +123,7 @@              numrows <- pqntuples resptr              if numrows < 1 then (pqclear_raw resptr >> return 0) else                  do-                   wrappedptr <- withRawConn (dbo sstate)-                                 (\rawconn -> wrapstmt resptr rawconn)-                   fresptr <- newForeignPtr pqclearptr wrappedptr+                   fresptr <- newForeignPtr pqclearptr resptr                    _ <- swapMVar (nextrowmv sstate) 0                    _ <- swapMVar (stomv sstate) (Just fresptr)                    return 0@@ -224,7 +219,7 @@           worker (Just sth) = ffinish sth >> return Nothing  ffinish :: Stmt -> IO ()-ffinish p = withRawStmt p $ pqclear+ffinish _ = pure ()  foreign import ccall unsafe "libpq-fe.h PQresultStatus"   pqresultStatus :: (Ptr CStmt) -> IO #{type ExecStatusType}@@ -241,17 +236,11 @@ foreign import ccall safe "libpq-fe.h PQexec"   pqexec :: (Ptr CConn) -> CString -> IO (Ptr CStmt) -foreign import ccall unsafe "hdbc-postgresql-helper.h PQclear_app"-  pqclear :: Ptr WrappedCStmt -> IO ()--foreign import ccall unsafe "hdbc-postgresql-helper.h &PQclear_finalizer"-  pqclearptr :: FunPtr (Ptr WrappedCStmt -> IO ())+foreign import ccall unsafe "libpq-fe.h &PQclear"+  pqclearptr :: FunPtr (Ptr CStmt -> IO ())  foreign import ccall unsafe "libpq-fe.h PQclear"   pqclear_raw :: Ptr CStmt -> IO ()--foreign import ccall unsafe "hdbc-postgresql-helper.h wrapobjpg"-  wrapstmt :: Ptr CStmt -> Ptr WrappedCConn -> IO (Ptr WrappedCStmt)  foreign import ccall unsafe "libpq-fe.h PQcmdTuples"   pqcmdTuples :: Ptr CStmt -> IO CString
Database/HDBC/PostgreSQL/Types.hs view
@@ -7,11 +7,9 @@ type ConnLock = MVar ()  data CConn = CConn-type WrappedCConn = Ptr CConn-type Conn = (ConnLock, ForeignPtr WrappedCConn)+type Conn = (ConnLock, ForeignPtr CConn)  data CStmt = CStmt-type WrappedCStmt = Ptr CStmt-type Stmt = ForeignPtr WrappedCStmt+type Stmt = ForeignPtr CStmt type ResultStatus = Word32
Database/HDBC/PostgreSQL/Utils.hsc view
@@ -1,7 +1,5 @@-{- -*- mode: haskell; -*- --}- module Database.HDBC.PostgreSQL.Utils where+ import Foreign.C.String import Foreign.ForeignPtr import Foreign.Ptr@@ -24,8 +22,6 @@ import qualified Data.ByteString.Unsafe as B #endif -#include "hdbc-postgresql-helper.h"- raiseError :: String -> Word32 -> (Ptr CConn) -> IO a raiseError msg code cconn =     do rc <- pqerrorMessage cconn@@ -47,30 +43,30 @@ Ditto for statements. -}  withConn :: Conn -> (Ptr CConn -> IO b) -> IO b-withConn (_lock,conn) = genericUnwrap conn+withConn (_lock,conn) = withForeignPtr conn  -- Perform the associated action with the connection lock held. -- Care must be taken with the use of this as it is *not* re-entrant.  Calling it--- a second time in the same thread will cause dead-lock. +-- a second time in the same thread will cause dead-lock. -- (A better approach would be to use RLock from concurrent-extra) withConnLocked :: Conn -> (Ptr CConn -> IO b) -> IO b withConnLocked c@(lock,_) a = withConn c (\cconn -> withMVar lock (\_ -> a cconn)) -withRawConn :: Conn -> (Ptr WrappedCConn -> IO b) -> IO b+withRawConn :: Conn -> (Ptr CConn -> IO b) -> IO b withRawConn (_lock,conn) = withForeignPtr conn  withStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b-withStmt = genericUnwrap+withStmt = withForeignPtr -withRawStmt :: Stmt -> (Ptr WrappedCStmt -> IO b) -> IO b+withRawStmt :: Stmt -> (Ptr CStmt -> IO b) -> IO b withRawStmt = withForeignPtr  withCStringArr0 :: [SqlValue] -> (Ptr CString -> IO a) -> IO a withCStringArr0 inp action = withAnyArr0 convfunc freefunc inp action     where convfunc SqlNull = return nullPtr {--          convfunc y@(SqlZonedTime _) = convfunc (SqlString $ -                                                "TIMESTAMP WITH TIME ZONE '" ++ +          convfunc y@(SqlZonedTime _) = convfunc (SqlString $+                                                "TIMESTAMP WITH TIME ZONE '" ++                                                 fromSql y ++ "'") -}           convfunc y@(SqlUTCTime _) = convfunc (SqlZonedTime (fromSql y))@@ -110,12 +106,5 @@         -- return ptr         return res -genericUnwrap :: ForeignPtr (Ptr a) -> (Ptr a -> IO b) -> IO b-genericUnwrap fptr action = withForeignPtr fptr (\structptr ->-    do objptr <- #{peek finalizeonce, encapobj} structptr-       action objptr-                                                )-           foreign import ccall unsafe "libpq-fe.h PQerrorMessage"   pqerrorMessage :: Ptr CConn -> IO CString-
HDBC-postgresql.cabal view
@@ -1,14 +1,14 @@ Name: HDBC-postgresql-Version: 2.3.2.8+Version: 2.4.0.0 License: BSD3 Maintainer: Nicolas Wu <nicolas.wu@gmail.com> Author: John Goerzen Copyright: Copyright (c) 2005-2011 John Goerzen license-file: LICENSE-extra-source-files: LICENSE, hdbc-postgresql-helper.h,+extra-source-files: LICENSE                     pgtypes_internal.h-                    Makefile,-                    README.txt,+                    Makefile+                    README.txt                     testsrc/TestTime.hs                     CHANGELOG.md homepage: http://github.com/hdbc/hdbc-postgresql@@ -52,7 +52,6 @@   if impl(ghc >= 6.9)     Build-Depends: base >= 4   Extra-Libraries: pq-  C-Sources: hdbc-postgresql-helper.c   Include-Dirs: .   GHC-Options: -O2 -Wall   Default-Language: Haskell2010@@ -86,11 +85,10 @@                   TestUtils,                   Testbasics,                   Tests-   C-Sources: hdbc-postgresql-helper.c    include-dirs: .    Extra-Libraries: pq    Hs-Source-Dirs: ., testsrc-   GHC-Options: -O2+   GHC-Options: -O2 -threaded    Default-Language: Haskell2010  source-repository head
− hdbc-postgresql-helper.c 
@@ -1,65 +0,0 @@-#include <libpq-fe.h>-#include <stdio.h>-#include <stdlib.h>-#include "hdbc-postgresql-helper.h"--/* Things can't finalize more than once.  -We'd like to let people call them from the app.-Yet we'd also like to be able to have a ForeignPtr finalize them.--So, here's a little wrapper for things. */--void PQfinish_conditional_finalizer(finalizeonce *conn);--finalizeonce *wrapobjpg(void *obj, finalizeonce *parentobj) {-  finalizeonce *newobj;-  newobj = malloc(sizeof(finalizeonce));-  if (newobj == NULL) {-    fprintf(stderr, "HDBC: could not allocate wrapper!\n");-    return NULL;-  }-  newobj->isfinalized = 0;-  newobj->refcount = 1;-  newobj->encapobj = obj;-  newobj->parent = parentobj;-  if (parentobj != NULL) -    parentobj->refcount++;-  return newobj;-}-  -void PQfinish_app(finalizeonce *conn) {-  if (conn->isfinalized)-    return;-  PQfinish((PGconn *) (conn->encapobj));-  conn->encapobj = NULL;-  conn->isfinalized = 1;-}--void PQfinish_finalizer(finalizeonce *conn) {-  (conn->refcount)--;-  PQfinish_conditional_finalizer(conn);-}--void PQfinish_conditional_finalizer(finalizeonce *conn) {-  if (conn->refcount < 1) {-    PQfinish_app(conn);-    free(conn);-  }-}--void PQclear_app(finalizeonce *res) {-  if (res->isfinalized)-    return;-  PQclear((PGresult *) (res->encapobj));-  res->isfinalized = 1;-}--void PQclear_finalizer(finalizeonce *res) {-  PQclear_app(res);-  (res->refcount)--;            /* Not really important since this is never a -                                   parent */-  (res->parent->refcount)--;-  PQfinish_conditional_finalizer(res->parent);-  free(res);-}-
− hdbc-postgresql-helper.h 
@@ -1,16 +0,0 @@-#include <libpq-fe.h>--typedef struct TAG_finalizeonce {-  void *encapobj;-  int refcount;-  int isfinalized;-  struct TAG_finalizeonce *parent;-} finalizeonce;--extern finalizeonce *wrapobjpg(void *obj, finalizeonce *parentobj);--extern void PQfinish_app(finalizeonce *conn);-extern void PQfinish_finalizer(finalizeonce *conn);--extern void PQclear_app(finalizeonce *res);-extern void PQclear_finalizer(finalizeonce *res);