@@ -15,6 +15,8 @@ import Data.Word
1515import Database.PostgreSQL.LibPQ(Oid(..))
1616import qualified Database.PostgreSQL.LibPQ as PQ
1717import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType)
18+import Foreign.ForeignPtr (newForeignPtr_, unsafeForeignPtrToPtr)
19+import Foreign.Ptr (nullPtr)
1820import System.IO.Unsafe (unsafePerformIO)
1921
2022-- | A Field represents metadata about a particular field
@@ -49,7 +51,7 @@ typeOid Field{..} = unsafePerformIO (PQ.ftype result column)
4951
5052
5153data Connection = Connection {
52− connectionHandle :: MVar (Maybe PQ.Connection)
54+ connectionHandle :: MVar PQ.Connection
5355 , connectionObjects :: MVar (IntMap.IntMap ByteString)
5456 }
5557
@@ -93,7 +95,7 @@ connectPostgreSQL connstr = do
9395 stat <- PQ.status conn
9496 case stat of
9597 PQ.ConnectionOk -> do
96− connectionHandle <- newMVar (Just conn)
98+ connectionHandle <- newMVar conn
9799 connectionObjects <- newMVar (IntMap.empty)
98100 return Connection{..}
99101 _ -> do
@@ -159,22 +161,21 @@ disconnectedError = SqlError {
159161 sqlState = ""
160162 }
161163
162−
163164-- | Atomically perform an action with the database handle, if there is one.
164165withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a
165166withConnection Connection{..} m = do
166− withMVar connectionHandle $ \h -> do
167− case h of
168− Just h -> m h
169− -- TODO: Use extensible exceptions.
170− Nothing -> throwIO disconnectedError
167+ withMVar connectionHandle $ \conn -> do
168+ if PQ.isNullConnection conn
169+ then throwIO disconnectedError
170+ else m conn
171171
172172close :: Connection -> IO ()
173−close Connection{..} = do
174− mconn <- takeMVar connectionHandle
175− case mconn of
176− Just conn -> PQ.finish conn
177− Nothing -> return ()
178− `finally` putMVar connectionHandle Nothing
173+close Connection{..} =
174+ mask $ \restore -> (do
175+ conn <- takeMVar connectionHandle
176+ restore (PQ.finish conn)
177+ `finally` do
178+ putMVar connectionHandle =<< PQ.newNullConnection
179+ )
179180
180181data RawResult = RawResult { rawField :: Field, rawData :: Maybe ByteString }