postgresql-simple 0.0.1 → 0.0.2
raw patch · 4 files changed
+43/−61 lines, 4 filesdep ~basedep ~postgresql-libpq
Dependency ranges changed: base, postgresql-libpq
Files
- postgresql-simple.cabal +3/−3
- src/Database/PostgreSQL/Simple/Internal.hs +16/−15
- src/Database/PostgreSQL/Simple/Notification.hs +16/−43
- src/Database/PostgreSQL/Simple/Result.hs +8/−0
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.0.1+Version: 0.0.2 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -39,7 +39,7 @@ blaze-textual, bytestring >= 0.9, containers,- postgresql-libpq >= 0.6,+ postgresql-libpq >= 0.6.2, pcre-light, old-locale, template-haskell,@@ -53,4 +53,4 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.0+ tag: v0.0.2
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -15,6 +15,8 @@ import Database.PostgreSQL.LibPQ(Oid(..)) import qualified Database.PostgreSQL.LibPQ as PQ import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType)+import Foreign.ForeignPtr (newForeignPtr_, unsafeForeignPtrToPtr)+import Foreign.Ptr (nullPtr) import System.IO.Unsafe (unsafePerformIO) -- | A Field represents metadata about a particular field@@ -49,8 +51,8 @@ data Connection = Connection {- connectionHandle :: MVar (Maybe PQ.Connection)- , connectionObjects :: MVar (IntMap.IntMap ByteString)+ connectionHandle :: {-# UNPACK #-} !(MVar PQ.Connection)+ , connectionObjects :: {-# UNPACK #-} !(MVar (IntMap.IntMap ByteString)) } data SqlType@@ -93,7 +95,7 @@ stat <- PQ.status conn case stat of PQ.ConnectionOk -> do- connectionHandle <- newMVar (Just conn)+ connectionHandle <- newMVar conn connectionObjects <- newMVar (IntMap.empty) return Connection{..} _ -> do@@ -159,22 +161,21 @@ sqlState = "" } - -- | Atomically perform an action with the database handle, if there is one. withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a withConnection Connection{..} m = do- withMVar connectionHandle $ \h -> do- case h of- Just h -> m h- -- TODO: Use extensible exceptions.- Nothing -> throwIO disconnectedError+ withMVar connectionHandle $ \conn -> do+ if PQ.isNullConnection conn+ then throwIO disconnectedError+ else m conn close :: Connection -> IO ()-close Connection{..} = do- mconn <- takeMVar connectionHandle- case mconn of- Just conn -> PQ.finish conn- Nothing -> return ()- `finally` putMVar connectionHandle Nothing+close Connection{..} =+ mask $ \restore -> (do+ conn <- takeMVar connectionHandle+ restore (PQ.finish conn)+ `finally` do+ putMVar connectionHandle =<< PQ.newNullConnection+ ) data RawResult = RawResult { rawField :: Field, rawData :: Maybe ByteString }
src/Database/PostgreSQL/Simple/Notification.hs view
@@ -17,7 +17,7 @@ ) where import Control.Concurrent ( threadWaitRead )-import Control.Concurrent.MVar ( takeMVar, putMVar )+import Control.Monad ( when ) import qualified Data.ByteString as B import Database.PostgreSQL.Simple.Internal import qualified Database.PostgreSQL.LibPQ as PQ@@ -31,51 +31,24 @@ errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \ \failed to fetch file descriptor"-errconn = "Database.PostgreSQL.Simple.Notification.getNotification: \- \not connected" -lockConn :: Connection -> IO (PQ.Connection)-lockConn Connection{..} = do- mconn <- takeMVar connectionHandle- case mconn of- Nothing -> do- putMVar connectionHandle mconn- fail errconn- Just conn -> return conn--unlockConn :: Connection -> PQ.Connection -> IO ()-unlockConn Connection{..} c = putMVar connectionHandle (Just c)- getNotification :: Connection -> IO Notification-getNotification conn = do- c <- lockConn conn- loop conn c+getNotification = loop False where- -- now, I believe the only ways that this code throws an exception is:- -- 1. lockConn/unlockConn when we are blocked on a GC'd MVar- -- 2. threadWaitRead when closeFdWith gets called- -- 3. and if we raise it ourself- -- If 1 happens, then it doesn't matter if the MVar is locked or not,- -- and if 2 or 3 happens then the connection should be unlocked.- --- -- Note, however, that this function is not safe from asynchronous- -- exceptions, which probably ought to be fixed.- loop conn c = do- mmsg <- PQ.notifies c- case mmsg of- Nothing -> do- mfd <- PQ.socket c- unlockConn conn c- case mfd of- Nothing -> fail errfd- Just fd -> do- threadWaitRead fd- c <- lockConn conn- _ <- PQ.consumeInput c- -- FIXME? error handling- loop conn c- Just PQ.Notify{..} -> do- unlockConn conn c+ loop doConsume conn = do+ res <- withConnection conn $ \c -> do+ when doConsume (PQ.consumeInput c >> return ())+ mmsg <- PQ.notifies c+ case mmsg of+ Nothing -> do+ mfd <- PQ.socket c+ case mfd of+ Nothing -> fail errfd+ Just fd -> return (Left fd)+ Just x -> return (Right x)+ case res of+ Left fd -> threadWaitRead fd >> loop True conn+ Right PQ.Notify{..} -> do return Notification { notificationPid = notifyBePid , notificationChannel = notifyRelname , notificationData = notifyExtra }
src/Database/PostgreSQL/Simple/Result.hs view
@@ -200,6 +200,14 @@ case makeTimeOfDayValid hours mins (fromIntegral secs) of Just t -> return (pure t) _ -> return (returnError ConversionFailed f "could not parse")++instance (Result a, Result b) => Result (Either a b) where+ convert f dat = case convert f dat of+ Right x -> Right (Right x)+ Left _ -> case convert f dat of+ Right x -> Right (Left x)+ Left e -> Left e+ newtype Compat = Compat Word64 mkCompats :: [BuiltinType] -> Compat