diff --git a/postgresql-simple.cabal b/postgresql-simple.cabal --- a/postgresql-simple.cabal +++ b/postgresql-simple.cabal @@ -1,5 +1,5 @@ Name: postgresql-simple -Version: 0.4.2.3 +Version: 0.4.3.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple. @@ -81,7 +81,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple - tag: v0.4.2.3 + tag: v0.4.3.0 test-suite test type: exitcode-stdio-1.0 diff --git a/src/Database/PostgreSQL/Simple/Internal.hs b/src/Database/PostgreSQL/Simple/Internal.hs --- a/src/Database/PostgreSQL/Simple/Internal.hs +++ b/src/Database/PostgreSQL/Simple/Internal.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-} +{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} ------------------------------------------------------------------------------ -- | @@ -46,6 +44,9 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.Class import GHC.IO.Exception +#if !defined(mingw32_HOST_OS) +import Control.Concurrent(threadWaitRead, threadWaitWrite) +#endif -- | A Field represents metadata about a particular field -- @@ -143,8 +144,8 @@ -- -- On systems that provide unix domain sockets, omitting the host parameter -- will cause libpq to attempt to connect via unix domain sockets. --- The default path to the socket is constructed from the port number --- and the @DEFAULT_PGSOCKET_DIR@ constant defined in the +-- The default filesystem path to the socket is constructed from the +-- port number and the @DEFAULT_PGSOCKET_DIR@ constant defined in the -- @pg_config_manual.h@ header file. Connecting via unix sockets tends -- to use the @peer@ authentication method, which is very secure and -- does not require a password. @@ -154,7 +155,7 @@ -- -- > ... dbname='postgres' user='postgres' password='secret \' \\ pw' -- --- This attempts to connect to database named @postgres@ with +-- This attempts to connect to a database named @postgres@ with -- user @postgres@ and password @secret \' \\ pw@. Backslash -- characters will have to be double-quoted in literal Haskell strings, -- of course. Omitting @dbname@ and @user@ will both default to the @@ -176,7 +177,7 @@ -- granted to the user on the database. -- -- On Windows, in addition you will either need @pg_hba.conf@ --- to specify the use the @trust@ authentication method for the +-- to specify the use of the @trust@ authentication method for -- the connection, which may not be appropriate for multiuser -- or production machines, or you will need to use a @pgpass@ file -- with the @password@ or @md5@ authentication methods. @@ -186,7 +187,7 @@ connectPostgreSQL :: ByteString -> IO Connection connectPostgreSQL connstr = do - conn <- PQ.connectdb connstr + conn <- connectdb connstr stat <- PQ.status conn case stat of PQ.ConnectionOk -> do @@ -197,14 +198,44 @@ version <- PQ.serverVersion conn let settings | version < 80200 = "SET datestyle TO ISO" - | otherwise = "SET standard_conforming_strings TO on;\ - \SET datestyle TO ISO" + | otherwise = "SET standard_conforming_strings TO on;SET datestyle TO ISO" _ <- execute_ wconn settings return wconn _ -> do msg <- maybe "connectPostgreSQL error" id <$> PQ.errorMessage conn throwIO $ fatalError msg +connectdb :: ByteString -> IO PQ.Connection +#if defined(mingw32_HOST_OS) +connectdb = PQ.connectdb +#else +connectdb conninfo = do + conn <- PQ.connectStart conninfo + loop conn + where + funcName = "Database.PostgreSQL.Simple.connectPostgreSQL" + loop conn = do + status <- PQ.connectPoll conn + case status of + PQ.PollingFailed -> throwLibPQError conn "connection failed" + PQ.PollingReading -> do + mfd <- PQ.socket conn + case mfd of + Nothing -> throwIO $! fdError funcName + Just fd -> do + threadWaitRead fd + loop conn + PQ.PollingWriting -> do + mfd <- PQ.socket conn + case mfd of + Nothing -> throwIO $! fdError funcName + Just fd -> do + threadWaitWrite fd + loop conn + PQ.PollingOk -> return conn + +#endif + -- | Turns a 'ConnectInfo' data structure into a libpq connection string. postgreSQLConnectionString :: ConnectInfo -> ByteString @@ -246,16 +277,43 @@ exec :: Connection -> ByteString -> IO PQ.Result +#if defined(mingw32_HOST_OS) exec conn sql = withConnection conn $ \h -> do mres <- PQ.exec h sql case mres of - Nothing -> do - msg <- maybe "execute error" id <$> PQ.errorMessage h - throwIO $ fatalError msg - Just res -> do - return res + Nothing -> throwLibPQError h "PQexec returned no results" + Just res -> return res +#else +exec conn sql = + withConnection conn $ \h -> do + success <- PQ.sendQuery h sql + if success + then awaitResult h Nothing + else throwLibPQError h "PQsendQuery failed" + where + awaitResult h mres = do + mfd <- PQ.socket h + case mfd of + Nothing -> throwIO $! fdError "Database.PostgreSQL.Simple.Internal.exec" + Just fd -> do + threadWaitRead fd + _ <- PQ.consumeInput h -- FIXME? + getResult h mres + getResult h mres = do + isBusy <- PQ.isBusy h + if isBusy + then awaitResult h mres + else do + mres' <- PQ.getResult h + case mres' of + Nothing -> case mres of + Nothing -> throwLibPQError h "PQgetResult returned no results" + Just res -> return res + Just _ -> getResult h mres' +#endif + -- | A version of 'execute' that does not perform query substitution. execute_ :: Connection -> Query -> IO Int64 execute_ conn q@(Query stmt) = do @@ -407,3 +465,19 @@ ioe_errno = Nothing, ioe_filename = Nothing } + + +libPQError :: ByteString -> IOError +libPQError desc = IOError { + ioe_handle = Nothing, + ioe_type = OtherError, + ioe_location = "libpq", + ioe_description = B8.unpack desc, + ioe_errno = Nothing, + ioe_filename = Nothing + } + +throwLibPQError :: PQ.Connection -> ByteString -> IO a +throwLibPQError conn default_desc = do + msg <- maybe default_desc id <$> PQ.errorMessage conn + throwIO $! libPQError msg