postgresql-simple 0.5.1.2 → 0.5.1.3

raw patch · 8 files changed

+129/−44 lines, 8 filesdep ~base

Dependency ranges changed: base

Files

• postgresql-simple.cabal +2/−2
• src/Database/PostgreSQL/Simple/FromRow.hs +1/−1
• src/Database/PostgreSQL/Simple/Internal.hs +4/−2
• src/Database/PostgreSQL/Simple/Notification.hs +76/−29
• src/Database/PostgreSQL/Simple/Ok.hs +6/−3
• src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs +6/−3
• src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs +4/−4
• src/Database/PostgreSQL/Simple/Types.hs +30/−0

@@ -1,5 +1,5 @@ Name:                postgresql-simple-Version:             0.5.1.2+Version:             0.5.1.3 Synopsis:            Mid-Level PostgreSQL client library Description:     Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -87,7 +87,7 @@ source-repository this   type:     git   location: http://github.com/lpsmith/postgresql-simple-  tag:      v0.5.1.2+  tag:      v0.5.1.3  test-suite test   type:           exitcode-stdio-1.0

@@ -67,7 +67,7 @@ -- in a single row of the query result.  Otherwise,  a 'ConversionFailed' -- exception will be thrown. ----- Note that 'field' evaluates it's result to WHNF, so the caveats listed in+-- Note that 'field' evaluates its result to WHNF, so the caveats listed in -- mysql-simple and very early versions of postgresql-simple no longer apply. -- Instead, look at the caveats associated with user-defined implementations -- of 'fromField'.

@@ -4,7 +4,7 @@ ------------------------------------------------------------------------------ -- | -- Module:      Database.PostgreSQL.Simple.Internal--- Copyright:   (c) 2011-2012 Leon P Smith+-- Copyright:   (c) 2011-2015 Leon P Smith -- License:     BSD3 -- Maintainer:  Leon P Smith <leon@melding-monads.com> -- Stability:   experimental@@ -476,7 +476,9 @@                      Errors _ -> (oka <|>) <$> runConversion mb conn  instance Monad Conversion where-   return a = Conversion $ \_conn -> return (return a)+#if !(MIN_VERSION_base(4,8,0))+   return = pure+#endif    m >>= f = Conversion $ \conn -> do                  oka <- runConversion m conn                  case oka of

@@ -5,7 +5,8 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Database.PostgreSQL.Simple.Notification--- Copyright   :  (c) 2011-2012 Leon P Smith+-- Copyright   :  (c) 2011-2015 Leon P Smith+--                (c) 2012 Joey Adams -- License     :  BSD3 -- -- Maintainer  :  leon@melding-monads.com@@ -35,18 +36,28 @@      , getBackendPID      ) where -import           Control.Concurrent-import           Control.Monad ( when )-import           Control.Exception ( throwIO )+import           Control.Monad ( join, void )+import           Control.Exception ( throwIO, catch ) import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8 import           Database.PostgreSQL.Simple.Internal import qualified Database.PostgreSQL.LibPQ as PQ import           System.Posix.Types ( CPid )+import           GHC.IO.Exception ( ioe_location ) +#if defined(mingw32_HOST_OS)+import           Control.Concurrent ( threadDelay )+#elif !MIN_VERSION_base(4,7,0)+import           Control.Concurrent ( threadWaitRead )+#else+import           GHC.Conc           ( atomically )+import           Control.Concurrent ( threadWaitReadSTM )+#endif+ data Notification = Notification-   { notificationPid     :: !CPid-   , notificationChannel :: !B.ByteString-   , notificationData    :: !B.ByteString+   { notificationPid     :: {-# UNPACK #-} !CPid+   , notificationChannel :: {-# UNPACK #-} !B.ByteString+   , notificationData    :: {-# UNPACK #-} !B.ByteString    }  convertNotice :: PQ.Notify -> Notification@@ -57,35 +68,71 @@  -- | Returns a single notification.   If no notifications are available, --   'getNotification' blocks until one arrives.+--+--   It is safe to call 'getNotification' on a connection that is concurrently+--   being used for other purposes,   note however that PostgreSQL does not+--   deliver notifications while a connection is inside a transaction.  getNotification :: Connection -> IO Notification-getNotification conn = loop False+getNotification conn = join $ withConnection conn fetch   where     funcName = "Database.PostgreSQL.Simple.Notification.getNotification"-    loop doConsume = 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 -> throwIO $ fdError funcName-                                           Just fd -> return (Left fd)-                           Just msg -> return (Right msg)-        -- FIXME? what happens if the connection is closed/reset right here?-        case res of++    fetch c = do+        mmsg <- PQ.notifies c+        case mmsg of+          Just msg -> return (return $! convertNotice msg)+          Nothing -> do+              mfd <- PQ.socket c+              case mfd of+                Nothing  -> return (throwIO $! fdError funcName) #if defined(mingw32_HOST_OS)-          -- threadWaitRead doesn't work for sockets on Windows, so just poll-          -- for input every second (PQconsumeInput is non-blocking).-          ---          -- We could call select(), but FFI calls can't be interrupted with-          -- async exceptions, whereas threadDelay can.-          Left _fd -> threadDelay 1000000 >> loop True+                -- threadWaitRead doesn't work for sockets on Windows, so just+                -- poll for input every second (PQconsumeInput is non-blocking).+                --+                -- We could call select(), but FFI calls can't be interrupted+                -- with async exceptions, whereas threadDelay can.+                Just _fd -> do+                  return (threadDelay 1000000 >> loop)+#elif !MIN_VERSION_base(4,7,0)+                -- Technically there's a race condition that is usually benign.+                -- If the connection is closed or reset after we drop the+                -- lock,  and then the fd index is reallocated to a new+                -- descriptor before we call threadWaitRead,  then+                -- we could end up waiting on the wrong descriptor.+                --+                -- Now, if the descriptor becomes readable promptly,  then+                -- it's no big deal as we'll wake up and notice the change+                -- on the next iteration of the loop.   But if are very+                -- unlucky,  then we could end up waiting a long time.+                Just fd  -> do+                  return $ do+                    threadWaitRead fd `catch` (throwIO . setIOErrorLocation)+                    loop #else-          Left fd -> threadWaitRead fd >> loop True+                -- This case fixes the race condition above.   By registering+                -- our interest in the descriptor before we drop the lock,+                -- there is no opportunity for the descriptor index to be+                -- reallocated on us.+                --+                -- (That is, assuming there isn't concurrently executing+                -- code that manipulates the descriptor without holding+                -- the lock... but such a major bug is likely to exhibit+                -- itself in an at least somewhat more dramatic fashion.)+                Just fd  -> do+                  (waitRead, _) <- threadWaitReadSTM fd+                  return $ do+                    atomically waitRead `catch` (throwIO . setIOErrorLocation)+                    loop #endif-          Right msg -> return $! convertNotice msg++    loop = join $ withConnection conn $ \c -> do+             void $ PQ.consumeInput c+             fetch c++    setIOErrorLocation :: IOError -> IOError+    setIOErrorLocation err = err { ioe_location = B8.unpack funcName }+  -- | Non-blocking variant of 'getNotification'.   Returns a single notification, -- if available.   If no notifications are available,  returns 'Nothing'.

@@ -1,10 +1,11 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE CPP                #-}  ------------------------------------------------------------------------------ -- | -- Module      :  Database.PostgreSQL.Simple.Ok--- Copyright   :  (c) 2012 Leon P Smith+-- Copyright   :  (c) 2012-2015 Leon P Smith -- License     :  BSD3 -- -- Maintainer  :  leon@melding-monads.com@@ -20,7 +21,7 @@ -- commonly-used type and typeclass included in @base@. -- -- Extending the failure case to a list of 'SomeException's enables a--- more sensible 'Alternative' instance definitions:   '<|>' concatinates+-- more sensible 'Alternative' instance definitions:   '<|>' concatenates -- the list of exceptions when both cases fail,  and 'empty' is defined as -- 'Errors []'.   Though '<|>' one could pick one of two exceptions, and -- throw away the other,  and have 'empty' provide a generic exception,@@ -69,7 +70,9 @@     mplus = (<|>)  instance Monad Ok where-    return = Ok+#if !(MIN_VERSION_base(4,8,0))+    return = pure+#endif      Errors es >>= _ = Errors es     Ok a      >>= f = f a

@@ -52,12 +52,15 @@   let c2d c = ord c .&. 15   return $! c2d a * 10 + c2d b --- | Parse a time of the form @HH:MM:SS[.SSS]@.+-- | Parse a time of the form @HH:MM[:SS[.SSS]]@. timeOfDay :: Parser Local.TimeOfDay timeOfDay = do   h <- twoDigits <* char ':'-  m <- twoDigits <* char ':'-  s <- seconds+  m <- twoDigits+  mc <- peekChar+  s <- case mc of+         Just ':' -> anyChar *> seconds+         _   -> return 0   if h < 24 && m < 60 && s <= 60     then return (Local.TimeOfDay h m s)     else fail "invalid time"

@@ -96,13 +96,13 @@          (liftB (fromIntegral >$< digits2) >*< frac)  timeZone :: BoundedPrim TimeZone-timeZone = ((`quotRem` 60) . timeZoneMinutes) >$< (liftB tzh >*< tzm)+timeZone = timeZoneMinutes >$< tz   where-    f h = if h >= 0 then ('+', h) else (,) '-' $! (-h)+    tz  = condB (>= 0) ((,) '+' >$< tzh) ((,) '-' . negate >$< tzh) -    tzh = f >$< (char8 >*< digits2)+    tzh = liftB char8 >*< ((`quotRem` 60) >$< (liftB digits2 >*< tzm)) -    tzm = condB (==0) emptyB ((,) ':' . abs >$< liftB (char8 >*< digits2))+    tzm = condB (==0) emptyB ((,) ':' >$< liftB (char8 >*< digits2))  utcTime :: BoundedPrim UTCTime utcTime = f >$< (day >*< liftB char8 >*< timeOfDay >*< liftB char8)

@@ -117,6 +117,36 @@ -- Example: -- -- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))+--+-- Note that @In []@ expands to @(null)@, which works as expected in+-- the query above, but evaluates to the logical null value on every+-- row instead of @TRUE@.  This means that changing the query above+-- to @... id NOT in ?@ and supplying the empty list as the parameter+-- returns zero rows, instead of all of them as one would expect.+--+-- Since postgresql doesn't seem to provide a syntax for actually specifying+-- an empty list,  which could solve this completely,  there are two+-- workarounds particularly worth mentioning,  namely:+--+-- 1.  Use postgresql-simple's 'Values' type instead,  which can handle the+--     empty case correctly.  Note however that while specifying the+--     postgresql type @"int4"@ is mandatory in the empty case,  specifying+--     the haskell type @[Only Int]@ would not normally be needed in+--     realistic use cases.+--+--     > query c "select * from whatever where id not in ?"+--     >         (Only (Values "int4") ([] :: [Only Int]))+--+--+-- 2.  Use sql's @COALESCE@ operator to turn a logical @null@ into the correct+--     boolean.  Note however that the correct boolean depends on the use+--     case:+--+--     > query c "select * from whatever where coalesce(id NOT in ?, TRUE)"+--     >         (Only (In ([] :: [Int])))+--+--     > query c "select * from whatever where coalesce(id IN ?, FALSE)"+--     >         (Only (In ([] :: [Int]))) newtype In a = In a     deriving (Eq, Ord, Read, Show, Typeable, Functor)