HDBC-postgresql 2.3.2.0 → 2.3.2.1
raw patch · 8 files changed
+41/−38 lines, 8 filesdep ~basesetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Database/HDBC/PostgreSQL/Connection.hsc +3/−1
- Database/HDBC/PostgreSQL/PTypeConv.hsc +0/−1
- Database/HDBC/PostgreSQL/Parser.hs +16/−11
- Database/HDBC/PostgreSQL/Statement.hsc +10/−11
- HDBC-postgresql.cabal +7/−5
- Setup.hs +4/−4
- TODO +0/−5
- hdbc-postgresql-helper.c +1/−0
Database/HDBC/PostgreSQL/Connection.hsc view
@@ -1,6 +1,7 @@ -- -*- mode: haskell; -*- {-# CFILES hdbc-postgresql-helper.c #-} -- Above line for hugs+{-# LANGUAGE FlexibleContexts #-} module Database.HDBC.PostgreSQL.Connection (connectPostgreSQL, withPostgreSQL,@@ -10,7 +11,6 @@ import Database.HDBC import Database.HDBC.DriverUtils-import Database.HDBC.ColTypes import qualified Database.HDBC.PostgreSQL.ConnectionImpl as Impl import Database.HDBC.PostgreSQL.Types import Database.HDBC.PostgreSQL.Statement@@ -29,6 +29,7 @@ import System.IO (stderr, hPutStrLn) import System.IO.Unsafe (unsafePerformIO) import Control.Exception(bracket) +import Data.Convertible (Convertible) #include <libpq-fe.h> #include <pg_config.h>@@ -138,6 +139,7 @@ frollback begin o cl = do _ <- frun o cl "ROLLBACK" [] when begin $ begin_transaction o cl +fgetTables :: (Convertible SqlValue a) => Conn -> ChildList -> IO [a] fgetTables conn children = do sth <- newSth conn children "select table_name from information_schema.tables where \
Database/HDBC/PostgreSQL/PTypeConv.hsc view
@@ -2,7 +2,6 @@ module Database.HDBC.PostgreSQL.PTypeConv where import Database.HDBC.ColTypes import Data.Word-import Data.Int #include "pgtypes.h" #include <libpq-fe.h>
Database/HDBC/PostgreSQL/Parser.hs view
@@ -13,44 +13,49 @@ (try $ string "\\'") literal :: GenParser Char st [Char]-literal = do char '\''+literal = do _ <- char '\'' s <- many (escapeseq <|> (noneOf "'" >>= (\x -> return [x])))- char '\''+ _ <- char '\'' return $ "'" ++ (concat s) ++ "'" qidentifier :: GenParser Char st [Char]-qidentifier = do char '"'+qidentifier = do _ <- char '"' s <- many (noneOf "\"")- char '"'+ _ <- char '"' return $ "\"" ++ s ++ "\"" comment :: GenParser Char st [Char] comment = ccomment <|> linecomment ccomment :: GenParser Char st [Char]-ccomment = do string "/*"+ccomment = do _ <- string "/*" c <- manyTill ((try ccomment) <|> (anyChar >>= (\x -> return [x]))) (try (string "*/")) return $ "/*" ++ concat c ++ "*/" linecomment :: GenParser Char st [Char]-linecomment = do string "--"+linecomment = do _ <- string "--" c <- many (noneOf "\n")- char '\n'+ _ <- char '\n' return $ "--" ++ c ++ "\n" -- FIXME: handle pgsql dollar-quoted constants -qmark :: Num st => GenParser Char st [Char]-qmark = do char '?'+qmark :: (Num st, Show st) => GenParser Char st [Char]+qmark = do _ <- char '?' n <- getState updateState (+1) return $ "$" ++ show n -statement :: Num st => GenParser Char st [Char]+escapedQmark :: GenParser Char st [Char]+escapedQmark = do _ <- try (char '\\' >> char '?')+ return "?"++statement :: (Num st, Show st) => GenParser Char st [Char] statement = - do s <- many ((try qmark) <|>+ do s <- many ((try escapedQmark) <|>+ (try qmark) <|> (try comment) <|> (try literal) <|> (try qidentifier) <|>
Database/HDBC/PostgreSQL/Statement.hsc view
@@ -15,18 +15,16 @@ import Control.Monad import Data.List import Data.Word-import Data.Maybe import Data.Ratio-import System.IO import qualified Data.ByteString as B import qualified Data.ByteString.UTF8 as BUTF8 import Database.HDBC.PostgreSQL.Parser(convertSQL) import Database.HDBC.DriverUtils import Database.HDBC.PostgreSQL.PTypeConv-import Database.HDBC.PostgreSQL.Utils import Data.Time.Format import System.Locale +l :: Monad m => t -> m () l _ = return () --l m = hPutStrLn stderr ("\n" ++ m) @@ -100,7 +98,7 @@ do l "in fexecute" public_ffinish sstate -- Sets nextrowmv to -1 resptr <- pqexec cconn cquery- handleResultStatus cconn resptr sstate =<< pqresultStatus resptr+ _ <- handleResultStatus cconn resptr sstate =<< pqresultStatus resptr :: IO Int return () handleResultStatus :: (Num a, Read a) => Ptr CConn -> WrappedCStmt -> SState -> ResultStatus -> IO a@@ -109,28 +107,28 @@ #{const PGRES_EMPTY_QUERY} -> do l $ "PGRES_EMPTY_QUERY: " ++ squery sstate pqclear_raw resptr- swapMVar (coldefmv sstate) []+ _ <- swapMVar (coldefmv sstate) [] return 0 #{const PGRES_COMMAND_OK} -> do l $ "PGRES_COMMAND_OK: " ++ squery sstate rowscs <- pqcmdTuples resptr rows <- peekCString rowscs pqclear_raw resptr- swapMVar (coldefmv sstate) []+ _ <- swapMVar (coldefmv sstate) [] return $ case rows of "" -> 0 x -> read x #{const PGRES_TUPLES_OK} -> do l $ "PGRES_TUPLES_OK: " ++ squery sstate- fgetcoldef resptr >>= swapMVar (coldefmv sstate)+ _ <- fgetcoldef resptr >>= swapMVar (coldefmv sstate) 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- swapMVar (nextrowmv sstate) 0- swapMVar (stomv sstate) (Just fresptr)+ _ <- swapMVar (nextrowmv sstate) 0+ _ <- swapMVar (stomv sstate) (Just fresptr) return 0 _ | resptr == nullPtr -> do l $ "PGRES ERROR: " ++ squery sstate@@ -212,13 +210,13 @@ -- FIXME: needs a faster algorithm. fexecutemany :: SState -> [[SqlValue]] -> IO () fexecutemany sstate arglist =- mapM_ (fexecute sstate) arglist >> return ()+ mapM_ (fexecute sstate :: [SqlValue] -> IO Int) arglist >> return () -- Finish and change state public_ffinish :: SState -> IO () public_ffinish sstate = do l "public_ffinish"- swapMVar (nextrowmv sstate) (-1)+ _ <- swapMVar (nextrowmv sstate) (-1) modifyMVar_ (stomv sstate) worker where worker Nothing = return Nothing worker (Just sth) = ffinish sth >> return Nothing@@ -357,6 +355,7 @@ SqlGUIDT -> return $ SqlByteString bstrval SqlUnknownT _ -> return $ SqlByteString bstrval+ _ -> error $ "PostgreSQL Statement.hsc: unknown typeid: " ++ show sqltypeid -- Convert "15:33:01.536+00" to "15:33:01.536 +0000" fixString :: String -> String
HDBC-postgresql.cabal view
@@ -1,16 +1,15 @@ Name: HDBC-postgresql-Version: 2.3.2.0+Version: 2.3.2.1 License: BSD3-Maintainer: Nicolas Wu <nick@well-typed.com>+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, pgtypes.h, Makefile, README.txt,- TODO, testsrc/TestTime.hs-homepage: http://software.complete.org/hdbc-postgresql+homepage: http://github.com/hdbc/hdbc-postgresql Category: Database synopsis: PostgreSQL driver for HDBC Description: This package provides a PostgreSQL driver for HDBC@@ -37,7 +36,7 @@ Database.HDBC.PostgreSQL.ErrorCodes Extensions: ExistentialQuantification, ForeignFunctionInterface Build-Depends: base >= 3 && < 5, mtl, HDBC>=2.2.0, parsec, utf8-string,- bytestring, old-time, old-locale, time+ bytestring, old-time, old-locale, time, convertible if impl(ghc >= 6.9) Build-Depends: base >= 4 Extra-Libraries: pq@@ -77,3 +76,6 @@ Extensions: ExistentialQuantification, ForeignFunctionInterface +source-repository head+ type: git+ location: https://github.com/hdbc/hdbc-postgresql.git
Setup.hs view
@@ -17,7 +17,7 @@ hookedPrograms = [pgconfigProgram], confHook = \pkg flags -> do- lbi <- confHook defaultUserHooks pkg flags+ lbi <- confHook simpleUserHooks pkg flags bi <- psqlBuildInfo lbi return lbi {@@ -26,10 +26,10 @@ } } -pgconfigProgram = (simpleProgram "pgconfig") {+pgconfigProgram = (simpleProgram "pgconfig or pg_config") { programFindLocation = \verbosity -> do- pgconfig <- findProgramOnPath "pgconfig" verbosity - pg_config <- findProgramOnPath "pg_config" verbosity+ pgconfig <- findProgramLocation verbosity "pgconfig"+ pg_config <- findProgramLocation verbosity "pg_config" return (pgconfig `mplus` pg_config) }
− TODO
@@ -1,5 +0,0 @@-optimize multiple executions and executeMany--cursors--shouldn't use Double when converting from intervals
hdbc-postgresql-helper.c view
@@ -31,6 +31,7 @@ if (conn->isfinalized) return; PQfinish((PGconn *) (conn->encapobj));+ conn->encapobj = NULL; conn->isfinalized = 1; }