@@ -1,7 +1,5 @@
1−{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE RecordWildCards #-}
1+{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
2+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
53
64------------------------------------------------------------------------------
75-- |
@@ -46,6 +44,9 @@ import Control.Monad.Trans.State.Strict
4644import Control.Monad.Trans.Reader
4745import Control.Monad.Trans.Class
4846import GHC.IO.Exception
47+#if !defined(mingw32_HOST_OS)
48+import Control.Concurrent(threadWaitRead)
49+#endif
4950
5051-- | A Field represents metadata about a particular field
5152--
@@ -197,8 +198,7 @@ connectPostgreSQL connstr = do
197198 version <- PQ.serverVersion conn
198199 let settings
199200 | version < 80200 = "SET datestyle TO ISO"
200− | otherwise = "SET standard_conforming_strings TO on;\
201− \SET datestyle TO ISO"
201+ | otherwise = "SET standard_conforming_strings TO on;SET datestyle TO ISO"
202202 _ <- execute_ wconn settings
203203 return wconn
204204 _ -> do
@@ -246,15 +246,42 @@ oid2int (Oid x) = fromIntegral x
246246exec :: Connection
247247 -> ByteString
248248 -> IO PQ.Result
249+#if defined(mingw32_HOST_OS)
249250exec conn sql =
250251 withConnection conn $ \h -> do
251252 mres <- PQ.exec h sql
252253 case mres of
253− Nothing -> do
254− msg <- maybe "execute error" id <$> PQ.errorMessage h
255− throwIO $ fatalError msg
256− Just res -> do
257− return res
254+ Nothing -> throwLibPQError h "PQexec returned no results"
255+ Just res -> return res
256+#else
257+exec conn sql =
258+ withConnection conn $ \h -> do
259+ success <- PQ.sendQuery h sql
260+ if success
261+ then awaitResult h Nothing
262+ else throwLibPQError h "PQsendQuery failed"
263+ where
264+ awaitResult h mres = do
265+ mfd <- PQ.socket h
266+ case mfd of
267+ Nothing -> throwIO $! fdError "Database.PostgreSQL.Simple.Internal.exec"
268+ Just fd -> do
269+ threadWaitRead fd
270+ _ <- PQ.consumeInput h -- FIXME?
271+ getResult h mres
272+
273+ getResult h mres = do
274+ isBusy <- PQ.isBusy h
275+ if isBusy
276+ then awaitResult h mres
277+ else do
278+ mres' <- PQ.getResult h
279+ case mres' of
280+ Nothing -> case mres of
281+ Nothing -> throwLibPQError h "PQgetResult returned no results"
282+ Just res -> return res
283+ Just _ -> getResult h mres'
284+#endif
258285
259286-- | A version of 'execute' that does not perform query substitution.
260287execute_ :: Connection -> Query -> IO Int64
@@ -407,3 +434,19 @@ fdError funcName = IOError {
407434 ioe_errno = Nothing,
408435 ioe_filename = Nothing
409436 }
437+
438+
439+libPQError :: ByteString -> IOError
440+libPQError desc = IOError {
441+ ioe_handle = Nothing,
442+ ioe_type = OtherError,
443+ ioe_location = "libpq",
444+ ioe_description = B8.unpack desc,
445+ ioe_errno = Nothing,
446+ ioe_filename = Nothing
447+ }
448+
449+throwLibPQError :: PQ.Connection -> ByteString -> IO a
450+throwLibPQError conn default_desc = do
451+ msg <- maybe default_desc id <$> PQ.errorMessage conn
452+ throwIO $! libPQError msg