diff --git a/Database/HDBC/PostgreSQL/Connection.hsc b/Database/HDBC/PostgreSQL/Connection.hsc --- a/Database/HDBC/PostgreSQL/Connection.hsc +++ b/Database/HDBC/PostgreSQL/Connection.hsc @@ -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 #include @@ -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 \ diff --git a/Database/HDBC/PostgreSQL/PTypeConv.hsc b/Database/HDBC/PostgreSQL/PTypeConv.hsc --- a/Database/HDBC/PostgreSQL/PTypeConv.hsc +++ b/Database/HDBC/PostgreSQL/PTypeConv.hsc @@ -2,7 +2,6 @@ module Database.HDBC.PostgreSQL.PTypeConv where import Database.HDBC.ColTypes import Data.Word -import Data.Int #include "pgtypes.h" #include diff --git a/Database/HDBC/PostgreSQL/Parser.hs b/Database/HDBC/PostgreSQL/Parser.hs --- a/Database/HDBC/PostgreSQL/Parser.hs +++ b/Database/HDBC/PostgreSQL/Parser.hs @@ -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) <|> diff --git a/Database/HDBC/PostgreSQL/Statement.hsc b/Database/HDBC/PostgreSQL/Statement.hsc --- a/Database/HDBC/PostgreSQL/Statement.hsc +++ b/Database/HDBC/PostgreSQL/Statement.hsc @@ -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 diff --git a/HDBC-postgresql.cabal b/HDBC-postgresql.cabal --- a/HDBC-postgresql.cabal +++ b/HDBC-postgresql.cabal @@ -1,16 +1,15 @@ Name: HDBC-postgresql -Version: 2.3.2.0 +Version: 2.3.2.1 License: BSD3 -Maintainer: Nicolas Wu +Maintainer: Nicolas Wu 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 diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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) } diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -1,5 +0,0 @@ -optimize multiple executions and executeMany - -cursors - -shouldn't use Double when converting from intervals diff --git a/hdbc-postgresql-helper.c b/hdbc-postgresql-helper.c --- a/hdbc-postgresql-helper.c +++ b/hdbc-postgresql-helper.c @@ -31,6 +31,7 @@ if (conn->isfinalized) return; PQfinish((PGconn *) (conn->encapobj)); + conn->encapobj = NULL; conn->isfinalized = 1; }