hsql-postgresql 1.7.3 → 1.8.1

raw patch · 10 files changed

+401/−269 lines, 10 filesdep ~basedep ~hsqlsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, hsql

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• DB/HSQL/PG/Core.hs +97/−0
• DB/HSQL/PG/Functions.hsc +71/−0
• DB/HSQL/PG/Sql.hs +19/−0
• DB/HSQL/PG/Status.hsc +28/−0
• DB/HSQL/PG/Type.hsc +50/−0
• Database/HSQL/PostgreSQL.hs +122/−0
• Database/HSQL/PostgreSQL.hsc +0/−263
• Setup.lhs +2/−2
• hsql-postgresql.cabal +10/−4

@@ -1,3 +1,5 @@+2010-1-24+    1.8.1: uses updated exception handling of hsql-1.8.1; refactorings 2009-2-15     1.7.3: filtering out of zombie dir paths returned                `pg_config --includedir-server',

@@ -0,0 +1,97 @@+{-| +-}+module DB.HSQL.PG.Core where++import Database.HSQL hiding(fetch,describe,query,execute)+import Database.HSQL.Types(Statement(..))+import Foreign(nullPtr)+import Foreign.C(CString,newCString,peekCString,withCString)+import Control.Exception (throw)+import Control.Monad(when,unless)+import Control.Concurrent.MVar(MVar,newMVar,modifyMVar,readMVar)++import DB.HSQL.PG.Functions+import DB.HSQL.PG.Type(mkSqlType)+import DB.HSQL.PG.Status(pgTuplesOk,pgCommandOk,pgFatalError)+++-- |+execute :: PGconn -> String -> IO ()+execute pConn sqlExpr = do+  pRes <- withCString sqlExpr (pqExec pConn)+  when (pRes==nullPtr) (do+    errMsg <- pqErrorMessage pConn >>= peekCString+    throw (SqlError { seState="E"+                    , seNativeError=fromIntegral pgFatalError+                    , seErrorMsg=errMsg }))+  status <- pqResultStatus pRes+  unless (status == pgCommandOk || status == pgTuplesOk) (do+    errMsg <- pqResultErrorMessage pRes >>= peekCString+    throw (SqlError { seState="E"+                    , seNativeError=fromIntegral status+                    , seErrorMsg=errMsg }))+  return ()++-- |+query :: Connection -> PGconn -> String -> IO Statement+query conn pConn query = do+  pRes <- withCString query (pqExec pConn)+  when (pRes==nullPtr) (do+    errMsg <- pqErrorMessage pConn >>= peekCString+    throw (SqlError { seState="E"+                    , seNativeError=fromIntegral pgFatalError+                    , seErrorMsg=errMsg }))+  status <- pqResultStatus pRes+  unless (status == pgCommandOk || status == pgTuplesOk) (do+    errMsg <- pqResultErrorMessage pRes >>= peekCString+    throw (SqlError { seState="E"+                    , seNativeError=fromIntegral status+                    , seErrorMsg=errMsg }))+  defs <- if status == pgTuplesOk +            then pgNFields pRes >>= getFieldDefs pRes 0 +            else return []+  countTuples <- pqNTuples pRes;+  tupleIndex <- newMVar (-1)+  refFalse <- newMVar False+  return (Statement { stmtConn   = conn+		    , stmtClose  = return ()+		    , stmtFetch  = fetch tupleIndex countTuples+		    , stmtGetCol = getColValue pRes tupleIndex countTuples+		    , stmtFields = defs+		    , stmtClosed = refFalse })+  where getFieldDefs pRes i n+	    | i >= n = return []+	    | otherwise = do+		name <- pgFName pRes i	>>= peekCString+		dataType <- pqFType pRes i+		modifier <- pqFMod pRes i+		defs <- getFieldDefs pRes (i+1) n+		return ((name,mkSqlType dataType modifier,True):defs)+++-- |+fetch :: MVar Int -> Int -> IO Bool+fetch tupleIndex countTuples =+  modifyMVar tupleIndex +             (\index -> return (index+1,index < countTuples-1))++-- |+getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef +            -> (FieldDef -> CString -> Int -> IO a) -> IO a+getColValue pRes tupleIndex countTuples colNumber fieldDef f = do+  index <- readMVar tupleIndex+  when (index >= countTuples) (throw SqlNoData)+  isnull <- pqGetisnull pRes index colNumber+  if isnull == 1+    then f fieldDef nullPtr 0+    else do pStr <- pqGetvalue pRes index colNumber+	    strLen <- strlen pStr+	    f fieldDef pStr strLen+++-- | Convert string by newCString, if provided, else return of nullPtr+newCStringElseNullPtr :: Maybe String -> IO CString+newCStringElseNullPtr Nothing =+    return nullPtr+newCStringElseNullPtr (Just string) =+    newCString string

@@ -0,0 +1,71 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-| Interface to the functions of the the foreign code environment.+-}+module DB.HSQL.PG.Functions where++import Foreign(Ptr,Word32)+import Foreign.C(CString)++import DB.HSQL.PG.Status(ConnStatusType,ExecStatusType)+import DB.HSQL.PG.Type(Oid)++#include <postgres.h>+#include <libpq-fe.h>++type PGconn = Ptr ()+type PGresult = Ptr ()++foreign import ccall "strlen" +  strlen :: CString -> IO Int++{-| Refer to PostgreSQL manual, chapter 30, `libpq - C library' +    (e.g. http://www.postgresql.org/docs/8.3/interactive/libpq.html)+-}+foreign import ccall "libpq-fe.h PQsetdbLogin" +  pqSetdbLogin :: CString -> CString -> CString -> CString -> CString -> CString -> CString -> IO PGconn++foreign import ccall "libpq-fe.h PQstatus" +  pqStatus :: PGconn -> IO ConnStatusType++foreign import ccall "libpq-fe.h PQerrorMessage"  +  pqErrorMessage :: PGconn -> IO CString++foreign import ccall "libpq-fe.h PQfinish" +  pqFinish :: PGconn -> IO ()++foreign import ccall "libpq-fe.h PQexec" +  pqExec :: PGconn -> CString -> IO PGresult++foreign import ccall "libpq-fe.h PQresultStatus" +  pqResultStatus :: PGresult -> IO ExecStatusType++foreign import ccall "libpq-fe.h PQresStatus" +  pqResStatus :: ExecStatusType -> IO CString++foreign import ccall "libpq-fe.h PQresultErrorMessage"+  pqResultErrorMessage :: PGresult -> IO CString++foreign import ccall "libpq-fe.h PQnfields" +  pgNFields :: PGresult -> IO Int++foreign import ccall "libpq-fe.h PQntuples" +  pqNTuples :: PGresult -> IO Int++foreign import ccall "libpq-fe.h PQfname" +  pgFName :: PGresult -> Int -> IO CString++foreign import ccall "libpq-fe.h PQftype" +  pqFType :: PGresult -> Int -> IO Oid++foreign import ccall "libpq-fe.h PQfmod" +  pqFMod :: PGresult -> Int -> IO Int++foreign import ccall "libpq-fe.h PQfnumber" +  pqFNumber :: PGresult -> CString -> IO Int++foreign import ccall "libpq-fe.h PQgetvalue" +  pqGetvalue :: PGresult -> Int -> Int -> IO CString++foreign import ccall "libpq-fe.h PQgetisnull" +  pqGetisnull :: PGresult -> Int -> Int -> IO Int+

@@ -0,0 +1,19 @@+{-| SQL queries.+-}+module DB.HSQL.PG.Sql where++import Database.HSQL.Types(SqlBind(toSqlValue))++-- | retrieval of the names of all tables+sqlAllTableNames:: String+sqlAllTableNames =+    "SELECT relname FROM pg_class WHERE relkind='r' AND relname !~ '^pg_'"+++-- | retrieval of the field defs for a table name+sqlAllFieldDefsForTableName:: SqlBind t=> t-> String+sqlAllFieldDefsForTableName tableName =+    "SELECT attname, atttypid, atttypmod, attnotnull " +    ++"FROM pg_attribute AS cols JOIN pg_class AS ts ON cols.attrelid=ts.oid " +    ++"WHERE cols.attnum > 0 AND ts.relname="++ (toSqlValue tableName)+       ++" AND cols.attisdropped = FALSE "

@@ -0,0 +1,28 @@+module DB.HSQL.PG.Status where++import Foreign(Word32)++#include <libpq-fe.h>+-- |+type ConnStatusType = #type ConnStatusType+type ExecStatusType = #type ExecStatusType+++-- |+connectionOk:: ConnStatusType+connectionOk = (#const CONNECTION_OK)+++-- |+pgTuplesOk:: ExecStatusType+pgTuplesOk = (#const PGRES_TUPLES_OK)+++-- |+pgCommandOk:: ExecStatusType+pgCommandOk = (#const PGRES_COMMAND_OK)+++-- |+pgFatalError:: ExecStatusType+pgFatalError = (#const PGRES_FATAL_ERROR)

@@ -0,0 +1,50 @@+module DB.HSQL.PG.Type where++import Foreign(Word32)++import Database.HSQL(SqlType(..))++#include <postgres.h>+#include <catalog/pg_type.h>++-- |+type Oid = #type Oid++-- |+mkSqlType :: Oid -> Int -> SqlType+mkSqlType (#const BPCHAROID)    size = SqlChar (size-4)+mkSqlType (#const VARCHAROID)   size = SqlVarChar (size-4)+mkSqlType (#const NAMEOID)      size = SqlVarChar 31+mkSqlType (#const TEXTOID)      size = SqlText+mkSqlType (#const NUMERICOID)   size = +    SqlNumeric ((size-4) `div` 0x10000) ((size-4) `mod` 0x10000)+mkSqlType (#const INT2OID)      size = SqlSmallInt+mkSqlType (#const INT4OID)      size = SqlInteger+mkSqlType (#const FLOAT4OID)    size = SqlReal+mkSqlType (#const FLOAT8OID)    size = SqlDouble+mkSqlType (#const BOOLOID)      size = SqlBit+mkSqlType (#const BITOID)       size = SqlBinary size+mkSqlType (#const VARBITOID)    size = SqlVarBinary size+mkSqlType (#const BYTEAOID)     size = SqlTinyInt+mkSqlType (#const INT8OID)      size = SqlBigInt+mkSqlType (#const DATEOID)      size = SqlDate+mkSqlType (#const TIMEOID)      size = SqlTime+mkSqlType (#const TIMETZOID)    size = SqlTimeTZ+mkSqlType (#const ABSTIMEOID)   size = SqlAbsTime+mkSqlType (#const RELTIMEOID)   size = SqlRelTime+mkSqlType (#const INTERVALOID)  size = SqlTimeInterval+mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval+mkSqlType (#const TIMESTAMPOID)	size = SqlDateTime+mkSqlType (#const TIMESTAMPTZOID)	size = SqlDateTimeTZ+mkSqlType (#const CASHOID)      size = SqlMoney+mkSqlType (#const INETOID)      size = SqlINetAddr+mkSqlType (#const 829)          size = SqlMacAddr		-- hack+mkSqlType (#const CIDROID)      size = SqlCIDRAddr+mkSqlType (#const POINTOID)     size = SqlPoint+mkSqlType (#const LSEGOID)      size = SqlLSeg+mkSqlType (#const PATHOID)      size = SqlPath+mkSqlType (#const BOXOID)       size = SqlBox+mkSqlType (#const POLYGONOID)   size = SqlPolygon+mkSqlType (#const LINEOID)      size = SqlLine+mkSqlType (#const CIRCLEOID)    size = SqlCircle+mkSqlType tp   size = SqlUnknown (fromIntegral tp)

@@ -0,0 +1,122 @@+{-| Module      :  Database.HSQL.PostgreSQL+    Copyright   :  (c) Krasimir Angelov 2003+    License     :  BSD-style++    Maintainer  :  ka2_mail@yahoo.com+    Stability   :  provisional+    Portability :  portable++    The module provides an interface to PostgreSQL database+-}+module Database.HSQL.PostgreSQL(connect, +                                connectWithOptions, +                                module Database.HSQL) where++import Foreign(free)+import Foreign.C(newCString,peekCString)+import Control.Exception (throw)+import Control.Monad(unless)+import Control.Concurrent.MVar(newMVar)++import Database.HSQL hiding(query,execute)+import Database.HSQL.Types(Connection(..),Statement(stmtGetCol))+import DB.HSQL.PG.Functions+import DB.HSQL.PG.Type(mkSqlType)+import DB.HSQL.PG.Core(query,execute,newCStringElseNullPtr)+import DB.HSQL.PG.Status(connectionOk)+import DB.HSQL.PG.Sql(sqlAllTableNames,sqlAllFieldDefsForTableName)++------------------------------------------------------------------------------+-- Connect/Disconnect+------------------------------------------------------------------------------+-- | Makes a new connection to the database server+connect :: String   -- ^ Server name : port nr+        -> String   -- ^ Database name+        -> String   -- ^ User identifier+        -> String   -- ^ Authentication string (password)+        -> IO Connection+connect server database user authentication = do+  let (serverAddress,portInput)= break (==':') server+      port= if length portInput < 2 +            then Nothing +            else Just (tail portInput)+  connectWithOptions serverAddress +                     port+                     Nothing +                     Nothing +                     database +                     user +                     authentication+++-- | Makes a new connection to the database server,+-- with specification of port, options & tty+connectWithOptions :: String   -- ^ Server name+                   -> Maybe String   -- ^ Port number+                   -> Maybe String   -- ^ Options+                   -> Maybe String   -- ^ TTY+                   -> String   -- ^ Database name+                   -> String   -- ^ User identifier+                   -> String   -- ^ Authentication string (password)+                   -> IO Connection+connectWithOptions server port options tty database user authentication = do+  pServer <- newCString server+  pPort <- newCStringElseNullPtr port+  pOptions <- newCStringElseNullPtr options+  pTty <- newCStringElseNullPtr tty+  pDatabase <- newCString database+  pUser <- newCString user+  pAuthentication <- newCString authentication+  pConn <- pqSetdbLogin pServer pPort pOptions pTty +                        pDatabase pUser pAuthentication+  free pServer+  free pPort+  free pOptions+  free pTty+  free pUser+  free pAuthentication+  status <- pqStatus pConn+  unless (status == connectionOk)  (do+    errMsg <- pqErrorMessage pConn >>= peekCString+    pqFinish pConn+    throw (SqlError { seState="C"+                    , seNativeError=fromIntegral status+                    , seErrorMsg=errMsg }))+  refFalse <- newMVar False+  let connection = +          Connection { connDisconnect = pqFinish pConn+                     , connExecute = execute pConn+                     , connQuery = query connection pConn+                     , connTables = tables connection pConn+                     , connDescribe = describe connection pConn+                     , connBeginTransaction = execute pConn "BEGIN"+                     , connCommitTransaction = execute pConn "COMMIT"+                     , connRollbackTransaction = execute pConn "ROLLBACK"+                     , connClosed = refFalse	}+  return connection+  where+    getFieldValue stmt colNumber fieldDef v = do+      mb_v <- stmtGetCol stmt colNumber fieldDef fromSqlCStringLen+      return (case mb_v of { Nothing -> v; Just a -> a })++    tables :: Connection -> PGconn -> IO [String]+    tables connection pConn = do+      stmt <- query connection pConn sqlAllTableNames+      collectRows (\s -> +          getFieldValue  s 0 ("relname", SqlVarChar 0, False) "") stmt++    describe :: Connection -> PGconn -> String -> IO [FieldDef]+    describe connection pConn table = do+      stmt <- query connection pConn+		    (sqlAllFieldDefsForTableName table)+      collectRows getColumnInfo stmt+      where+	getColumnInfo stmt = do+	  column_name <- +              getFieldValue stmt 0 ("attname", SqlVarChar 0, False) ""+	  data_type <- getFieldValue stmt 1 ("atttypid", SqlInteger, False) 0+	  type_mod <- getFieldValue stmt 2 ("atttypmod", SqlInteger, False) 0+	  notnull <- getFieldValue stmt 3 ("attnotnull", SqlBit, False) False+	  let sqlType = mkSqlType (fromIntegral (data_type :: Int)) +                                  (fromIntegral (type_mod :: Int))+	  return (column_name, sqlType, not notnull)

@@ -1,263 +0,0 @@-------------------------------------------------------------------------------------------{-| Module      :  Database.HSQL.PostgreSQL-    Copyright   :  (c) Krasimir Angelov 2003-    License     :  BSD-style--    Maintainer  :  ka2_mail@yahoo.com-    Stability   :  provisional-    Portability :  portable--    The module provides an interface to PostgreSQL database--}--------------------------------------------------------------------------------------------module Database.HSQL.PostgreSQL(connect, -                                connectWithOptions, -                                module Database.HSQL) where--import Database.HSQL-import Database.HSQL.Types-import Data.Dynamic-import Data.Char-import Foreign-import Foreign.C-import Control.OldException (throwDyn, catchDyn, dynExceptions, Exception(..))-import Control.Monad(when,unless,mplus)-import Control.Concurrent.MVar-import System.Time-import System.IO.Unsafe-import Text.ParserCombinators.ReadP-import Text.Read-import Numeric--#include <time.h>-#include <libpq-fe.h>-#include <postgres.h>-#include <catalog/pg_type.h>--type PGconn = Ptr ()-type PGresult = Ptr ()-type ConnStatusType = #type ConnStatusType-type ExecStatusType = #type ExecStatusType-type Oid = #type Oid--{-| Refer to PostgreSQL manual, chapter 30, `libpq - C library' -    (e.g. http://www.postgresql.org/docs/8.3/interactive/libpq.html)--}-foreign import ccall "libpq-fe.h PQsetdbLogin" pqSetdbLogin :: CString -> CString -> CString -> CString -> CString -> CString -> CString -> IO PGconn-foreign import ccall "libpq-fe.h PQstatus" pqStatus :: PGconn -> IO ConnStatusType-foreign import ccall "libpq-fe.h PQerrorMessage"  pqErrorMessage :: PGconn -> IO CString-foreign import ccall "libpq-fe.h PQfinish" pqFinish :: PGconn -> IO ()-foreign import ccall "libpq-fe.h PQexec" pqExec :: PGconn -> CString -> IO PGresult-foreign import ccall "libpq-fe.h PQresultStatus" pqResultStatus :: PGresult -> IO ExecStatusType-foreign import ccall "libpq-fe.h PQresStatus" pqResStatus :: ExecStatusType -> IO CString-foreign import ccall "libpq-fe.h PQresultErrorMessage" pqResultErrorMessage :: PGresult -> IO CString-foreign import ccall "libpq-fe.h PQnfields" pgNFields :: PGresult -> IO Int-foreign import ccall "libpq-fe.h PQntuples" pqNTuples :: PGresult -> IO Int-foreign import ccall "libpq-fe.h PQfname" pgFName :: PGresult -> Int -> IO CString-foreign import ccall "libpq-fe.h PQftype" pqFType :: PGresult -> Int -> IO Oid-foreign import ccall "libpq-fe.h PQfmod" pqFMod :: PGresult -> Int -> IO Int-foreign import ccall "libpq-fe.h PQfnumber" pqFNumber :: PGresult -> CString -> IO Int-foreign import ccall "libpq-fe.h PQgetvalue" pqGetvalue :: PGresult -> Int -> Int -> IO CString-foreign import ccall "libpq-fe.h PQgetisnull" pqGetisnull :: PGresult -> Int -> Int -> IO Int--foreign import ccall "strlen" strlen :: CString -> IO Int---------------------------------------------------------------------------------------------- Connect/Disconnect---------------------------------------------------------------------------------------------- | Makes a new connection to the database server-connect :: String   -- ^ Server name : port nr-        -> String   -- ^ Database name-        -> String   -- ^ User identifier-        -> String   -- ^ Authentication string (password)-        -> IO Connection-connect server database user authentication = do-    let (serverAddress,portInput)= break (==':') server-        port= if length portInput < 2 -              then Nothing -              else Just (tail portInput)-    connectWithOptions serverAddress -                       port-                       Nothing -                       Nothing -                       database -                       user -                       authentication----- | Makes a new connection to the database server, with specification of port, options & tty-connectWithOptions :: String   -- ^ Server name-             -> Maybe String   -- ^ Port number-             -> Maybe String   -- ^ Options-             -> Maybe String   -- ^ TTY-             -> String   -- ^ Database name-             -> String   -- ^ User identifier-             -> String   -- ^ Authentication string (password)-             -> IO Connection-connectWithOptions server port options tty database user authentication = do-	pServer <- newCString server-	pPort <- newCStringElseNullPtr port-	pOptions <- newCStringElseNullPtr options-	pTty <- newCStringElseNullPtr tty-	pDatabase <- newCString database-	pUser <- newCString user-	pAuthentication <- newCString authentication-	pConn <- pqSetdbLogin pServer pPort pOptions pTty pDatabase pUser pAuthentication-	free pServer-	free pPort-	free pOptions-	free pTty-	free pUser-	free pAuthentication-	status <- pqStatus pConn-	unless (status == (#const CONNECTION_OK))  (do-		errMsg <- pqErrorMessage pConn >>= peekCString-		pqFinish pConn-		throwDyn (SqlError {seState="C", seNativeError=fromIntegral status, seErrorMsg=errMsg}))-	refFalse <- newMVar False-	let connection = Connection-		{ connDisconnect = pqFinish pConn-		, connExecute = execute pConn-		, connQuery = query connection pConn-		, connTables = tables connection pConn-		, connDescribe = describe connection pConn-		, connBeginTransaction = execute pConn "begin"-		, connCommitTransaction = execute pConn "commit"-		, connRollbackTransaction = execute pConn "rollback"-		, connClosed = refFalse-		}-	return connection-	where-		execute :: PGconn -> String -> IO ()-		execute pConn sqlExpr = do-			pRes <- withCString sqlExpr (pqExec pConn)-			when (pRes==nullPtr) (do-				errMsg <- pqErrorMessage pConn >>= peekCString-				throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg}))-			status <- pqResultStatus pRes-			unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do-				errMsg <- pqResultErrorMessage pRes >>= peekCString-				throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg}))-			return ()--		query :: Connection -> PGconn -> String -> IO Statement-		query conn pConn query = do-			pRes <- withCString query (pqExec pConn)-			when (pRes==nullPtr) (do-				errMsg <- pqErrorMessage pConn >>= peekCString-				throwDyn (SqlError {seState="E", seNativeError=(#const PGRES_FATAL_ERROR), seErrorMsg=errMsg}))-			status <- pqResultStatus pRes-			unless (status == (#const PGRES_COMMAND_OK) || status == (#const PGRES_TUPLES_OK)) (do-				errMsg <- pqResultErrorMessage pRes >>= peekCString-				throwDyn (SqlError {seState="E", seNativeError=fromIntegral status, seErrorMsg=errMsg}))-			defs <- if status ==  (#const PGRES_TUPLES_OK) then pgNFields pRes >>= getFieldDefs pRes 0 else return []-			countTuples <- pqNTuples pRes;-			tupleIndex <- newMVar (-1)-			refFalse <- newMVar False-			return (Statement-			              { stmtConn   = conn-			              , stmtClose  = return ()-			              , stmtFetch  = fetch tupleIndex countTuples-			              , stmtGetCol = getColValue pRes tupleIndex countTuples-			              , stmtFields = defs-			              , stmtClosed = refFalse-			              })-			where-				getFieldDefs pRes i n-					| i >= n = return []-					| otherwise = do-						name <- pgFName pRes i	>>= peekCString-						dataType <- pqFType pRes i-						modifier <- pqFMod pRes i-						defs <- getFieldDefs pRes (i+1) n-						return ((name,mkSqlType dataType modifier,True):defs)--		mkSqlType :: Oid -> Int -> SqlType-		mkSqlType (#const BPCHAROID)    size = SqlChar (size-4)-		mkSqlType (#const VARCHAROID)   size = SqlVarChar (size-4)-		mkSqlType (#const NAMEOID)      size = SqlVarChar 31-		mkSqlType (#const TEXTOID)      size = SqlText-		mkSqlType (#const NUMERICOID)   size = SqlNumeric ((size-4) `div` 0x10000) ((size-4) `mod` 0x10000)-		mkSqlType (#const INT2OID)      size = SqlSmallInt-		mkSqlType (#const INT4OID)      size = SqlInteger-		mkSqlType (#const FLOAT4OID)    size = SqlReal-		mkSqlType (#const FLOAT8OID)    size = SqlDouble-		mkSqlType (#const BOOLOID)      size = SqlBit-		mkSqlType (#const BITOID)       size = SqlBinary size-		mkSqlType (#const VARBITOID)    size = SqlVarBinary size-		mkSqlType (#const BYTEAOID)     size = SqlTinyInt-		mkSqlType (#const INT8OID)      size = SqlBigInt-		mkSqlType (#const DATEOID)      size = SqlDate-		mkSqlType (#const TIMEOID)      size = SqlTime-		mkSqlType (#const TIMETZOID)    size = SqlTimeTZ-		mkSqlType (#const ABSTIMEOID)   size = SqlAbsTime-		mkSqlType (#const RELTIMEOID)   size = SqlRelTime-		mkSqlType (#const INTERVALOID)  size = SqlTimeInterval-		mkSqlType (#const TINTERVALOID) size = SqlAbsTimeInterval-		mkSqlType (#const TIMESTAMPOID)	size = SqlDateTime-		mkSqlType (#const TIMESTAMPTZOID)	size = SqlDateTimeTZ-		mkSqlType (#const CASHOID)      size = SqlMoney-		mkSqlType (#const INETOID)      size = SqlINetAddr-		mkSqlType (#const 829)          size = SqlMacAddr		-- hack-		mkSqlType (#const CIDROID)      size = SqlCIDRAddr-		mkSqlType (#const POINTOID)     size = SqlPoint-		mkSqlType (#const LSEGOID)      size = SqlLSeg-		mkSqlType (#const PATHOID)      size = SqlPath-		mkSqlType (#const BOXOID)       size = SqlBox-		mkSqlType (#const POLYGONOID)   size = SqlPolygon-		mkSqlType (#const LINEOID)      size = SqlLine-		mkSqlType (#const CIRCLEOID)    size = SqlCircle-		mkSqlType tp   size = SqlUnknown (fromIntegral tp)--		getFieldValue stmt colNumber fieldDef v = do-			mb_v <- stmtGetCol stmt colNumber fieldDef fromSqlCStringLen-			return (case mb_v of { Nothing -> v; Just a -> a })--		tables :: Connection -> PGconn -> IO [String]-		tables connection pConn = do-			stmt <- query connection pConn "select relname from pg_class where relkind='r' and relname !~ '^pg_'"-			collectRows (\s -> getFieldValue  s 0 ("relname", SqlVarChar 0, False) "") stmt--		describe :: Connection -> PGconn -> String -> IO [FieldDef]-		describe connection pConn table = do-			stmt <- query connection pConn-					("select attname, atttypid, atttypmod, attnotnull " ++-					 "from pg_attribute as cols join pg_class as ts on cols.attrelid=ts.oid " ++-					 "where cols.attnum > 0 and ts.relname="++toSqlValue table++-					 " and cols.attisdropped = False ")--			collectRows getColumnInfo stmt-			where-				getColumnInfo stmt = do-					column_name <- getFieldValue stmt 0 ("attname", SqlVarChar 0, False) ""-					data_type <- getFieldValue stmt 1 ("atttypid", SqlInteger, False) 0-					type_mod <- getFieldValue stmt 2 ("atttypmod", SqlInteger, False) 0-					notnull <- getFieldValue stmt 3 ("attnotnull", SqlBit, False) False-					let sqlType = mkSqlType (fromIntegral (data_type :: Int)) (fromIntegral (type_mod :: Int))-					return (column_name, sqlType, not notnull)--		fetch :: MVar Int -> Int -> IO Bool-		fetch tupleIndex countTuples =-			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples-1))--		getColValue :: PGresult -> MVar Int -> Int -> Int -> FieldDef -> (FieldDef -> CString -> Int -> IO a) -> IO a-		getColValue pRes tupleIndex countTuples colNumber fieldDef f = do-			index <- readMVar tupleIndex-			when (index >= countTuples) (throwDyn SqlNoData)-			isnull <- pqGetisnull pRes index colNumber-			if isnull == 1-				then f fieldDef nullPtr 0-				else do-					pStr <- pqGetvalue pRes index colNumber-					strLen <- strlen pStr-					f fieldDef pStr strLen----- | Convert string by newCString, if provided, else return of nullPtr-newCStringElseNullPtr :: Maybe String -> IO CString-newCStringElseNullPtr Nothing =-    return nullPtr-newCStringElseNullPtr (Just string) =-    newCString string

@@ -16,14 +16,14 @@ import System.Process(runInteractiveProcess, waitForProcess) import System.IO(hClose, hGetContents, hPutStr, stderr) import Control.Monad(when)-import Control.OldException(try)+import Control.Exception(SomeException,try)  main = defaultMainWithHooks autoconfUserHooks{preConf= preConf                                              ,postConf= postConf}   where     preConf ::  [String] -> ConfigFlags -> IO HookedBuildInfo     preConf args flags = do-      try (removeFile "PostgreSQL.buildinfo")+      try (removeFile "PostgreSQL.buildinfo")::IO (Either SomeException ())       return emptyHookedBuildInfo     postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()     postConf args flags _ localbuildinfo = do

@@ -1,14 +1,20 @@ Name:		 hsql-postgresql-Version:	 1.7.3+Version:	 1.8.1 Synopsis:	 A Haskell Interface to PostgreSQL via the PQ library.  License:	 BSD3 License-file:	 LICENSE Author:		 Krasimir Angelov <kr.angelov@gmail.com> Category:	 Database Description: 	 PostgreSQL driver for HSQL.-Exposed-modules: Database.HSQL.PostgreSQL-Build-depends: 	 base >= 4.0.0.0, hsql, old-time+Exposed-modules: +    DB.HSQL.PG.Core,+    DB.HSQL.PG.Sql,+    DB.HSQL.PG.Status, +    DB.HSQL.PG.Type,+    DB.HSQL.PG.Functions,+    Database.HSQL.PostgreSQL+Build-depends: 	 base >= 4 && <5, hsql >= 1.8 && < 1.9, old-time Maintainer:	 nick.rudnick@googlemail.com-Extensions:      ForeignFunctionInterface, CPP+-- Extensions:       Build-Type:	 Custom Extra-libraries: pq