83d3c38 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Change exec to async use of libpq on non-Windows OSes

83d3c38Leon P Smith12 years ago

src/Database/PostgreSQL/Simple/Internal.hs+54−11

compare with master

unifiedsplit

@@ -1,7 +1,5 @@

1−{-# LANGUAGE BangPatterns #-}

1+{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}

2−{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE RecordWildCards #-}

6------------------------------------------------------------------------------

4------------------------------------------------------------------------------

7-- |

5-- |

@@ -46,6 +44,9 @@ import Control.Monad.Trans.State.Strict

46import Control.Monad.Trans.Reader

44import Control.Monad.Trans.Reader

47import Control.Monad.Trans.Class

45import Control.Monad.Trans.Class

48import GHC.IO.Exception

46import GHC.IO.Exception

47+#if !defined(mingw32_HOST_OS)

48+import Control.Concurrent(threadWaitRead)

49+#endif

50-- | A Field represents metadata about a particular field

51-- | A Field represents metadata about a particular field

51--

52--

@@ -197,8 +198,7 @@ connectPostgreSQL connstr = do

197 version <- PQ.serverVersion conn

198 version <- PQ.serverVersion conn

198 let settings

199 let settings

199 | version < 80200 = "SET datestyle TO ISO"

200 | version < 80200 = "SET datestyle TO ISO"

200− | otherwise = "SET standard_conforming_strings TO on;\

201+ | otherwise = "SET standard_conforming_strings TO on;SET datestyle TO ISO"

201− \SET datestyle TO ISO"

202 _ <- execute_ wconn settings

203 return wconn

204 _ -> do

@@ -246,15 +246,42 @@ oid2int (Oid x) = fromIntegral x

246exec :: Connection

247 -> ByteString

248 -> IO PQ.Result

249+#if defined(mingw32_HOST_OS)

249exec conn sql =

250exec conn sql =

250 withConnection conn $ \h -> do

251 withConnection conn $ \h -> do

251 mres <- PQ.exec h sql

252 mres <- PQ.exec h sql

252 case mres of

253 case mres of

253− Nothing -> do

254+ Nothing -> throwLibPQError h "PQexec returned no results"

254− msg <- maybe "execute error" id <$> PQ.errorMessage h

255+ Just res -> return res

255− throwIO $ fatalError msg

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"

256− Just res -> do

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"

257− return res

282+ Just res -> return res

283+ Just _ -> getResult h mres'

284+#endif

258

285

259-- | A version of 'execute' that does not perform query substitution.

286-- | A version of 'execute' that does not perform query substitution.

260execute_ :: Connection -> Query -> IO Int64

287execute_ :: Connection -> Query -> IO Int64

@@ -407,3 +434,19 @@ fdError funcName = IOError {

407 ioe_errno = Nothing,

434 ioe_errno = Nothing,

408 ioe_filename = Nothing

435 ioe_filename = Nothing

409 }

436 }

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