beam-postgres 0.5.1.0 → 0.5.2.0

raw patch · 10 files changed

+312/−116 lines, 10 filesdep ~attoparsecdep ~bytestringdep ~hashablePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: attoparsec, bytestring, hashable, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +14/−0
• Database/Beam/Postgres/Conduit.hs +177/−69
• Database/Beam/Postgres/Connection.hs +6/−1
• Database/Beam/Postgres/Full.hs +1/−1
• Database/Beam/Postgres/PgSpecific.hs +63/−11
• Database/Beam/Postgres/Syntax.hs +7/−2
• beam-postgres.cabal +5/−5
• test/Database/Beam/Postgres/Test.hs +10/−14
• test/Database/Beam/Postgres/Test/Marshal.hs +0/−1
• test/Database/Beam/Postgres/Test/Select.hs +29/−12

@@ -1,3 +1,17 @@+# 0.5.2.0++## Added features++ * New `conduit` streaming variants which work directly in `MonadResource`+ * Heterogeneous variant of `ilike_`: `ilike_'`+ * Postgres-specific `EXTRACT` fields+ * GHC 9.2 and 9.0 support++## Bug fixes++ * Throw correct exception for row errors in `conduit` implementation+ * Support emitting UUID values in context where type cannot be inferred by Postgres+ # 0.5.1.0  ## Added features

@@ -1,28 +1,51 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}  -- | More efficient query execution functions for @beam-postgres@. These -- functions use the @conduit@ package, to execute @beam-postgres@ statements in -- an arbitrary 'MonadIO'. These functions may be more efficient for streaming -- operations than 'MonadBeam'.-module Database.Beam.Postgres.Conduit where+module Database.Beam.Postgres.Conduit+  ( streamingRunSelect+  , runInsert+  , streamingRunInsertReturning+  , runUpdate+  , streamingRunUpdateReturning+  , runDelete+  , streamingRunDeleteReturning+  , executeStatement+  , streamingRunQueryReturning+  -- * Deprecated streaming variants+  , runSelect+  , runInsertReturning+  , runUpdateReturning+  , runDeleteReturning+  , runQueryReturning+  ) where -import           Database.Beam+import           Database.Beam hiding (runInsert, runUpdate, runDelete) import           Database.Beam.Postgres.Connection import           Database.Beam.Postgres.Full import           Database.Beam.Postgres.Syntax import           Database.Beam.Postgres.Types +import           Control.Concurrent.MVar (takeMVar, putMVar)+import           Control.Exception.Base (bracket, throwIO) import           Control.Exception.Lifted (finally)+import qualified Control.Exception.Lifted as Lifted+import qualified Control.Concurrent.MVar.Lifted as Lifted import           Control.Monad.Trans.Control (MonadBaseControl)  import qualified Database.PostgreSQL.LibPQ as Pg hiding   (Connection, escapeStringConn, escapeIdentifier, escapeByteaConn, exec)+import qualified Database.PostgreSQL.LibPQ as Pq import qualified Database.PostgreSQL.Simple as Pg-import qualified Database.PostgreSQL.Simple.Internal as Pg (withConnection)+import qualified Database.PostgreSQL.Simple.Internal as Pg+import           Database.PostgreSQL.Simple.Internal (connectionHandle) import qualified Database.PostgreSQL.Simple.Types as Pg (Query(..)) -import qualified Data.Conduit as C+import qualified Conduit as C import           Data.Int (Int64) import           Data.Maybe (fromMaybe) #if !MIN_VERSION_base(4, 11, 0)@@ -39,13 +62,22 @@  -- * @SELECT@ +-- | Run a PostgreSQL @SELECT@ statement in any 'C.MonadResource'.+streamingRunSelect :: ( C.MonadResource m, Fail.MonadFail m, FromBackendRow Postgres a )+                   => Pg.Connection -> SqlSelect Postgres a+                   -> CONDUIT_TRANSFORMER () a m ()+streamingRunSelect conn (SqlSelect (PgSelectSyntax syntax)) =+  streamingRunQueryReturning conn syntax+ -- | Run a PostgreSQL @SELECT@ statement in any 'MonadIO'. runSelect :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, FromBackendRow Postgres a )           => Pg.Connection -> SqlSelect Postgres a           -> (CONDUIT_TRANSFORMER () a m () -> m b) -> m b runSelect conn (SqlSelect (PgSelectSyntax syntax)) withSrc =   runQueryReturning conn syntax withSrc+{-# DEPRECATED runSelect "Use streamingRunSelect" #-} + -- * @INSERT@  -- | Run a PostgreSQL @INSERT@ statement in any 'MonadIO'. Returns the number of@@ -56,6 +88,16 @@ runInsert conn (SqlInsert _ (PgInsertSyntax i)) =   executeStatement conn i +-- | Run a PostgreSQL @INSERT ... RETURNING ...@ statement in any 'C.MonadResource' and+-- get a 'C.Source' of the newly inserted rows.+streamingRunInsertReturning :: ( C.MonadResource m, Fail.MonadFail m, FromBackendRow Postgres a )+                            => Pg.Connection+                            -> PgInsertReturning a+                            -> CONDUIT_TRANSFORMER () a m ()+streamingRunInsertReturning _ PgInsertReturningEmpty = pure ()+streamingRunInsertReturning conn (PgInsertReturning i) =+    streamingRunQueryReturning conn i+ -- | Run a PostgreSQL @INSERT ... RETURNING ...@ statement in any 'MonadIO' and -- get a 'C.Source' of the newly inserted rows. runInsertReturning :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, FromBackendRow Postgres a )@@ -66,6 +108,7 @@ runInsertReturning _ PgInsertReturningEmpty withSrc = withSrc (pure ()) runInsertReturning conn (PgInsertReturning i) withSrc =     runQueryReturning conn i withSrc+{-# DEPRECATED runInsertReturning "Use streamingRunInsertReturning" #-}  -- * @UPDATE@ @@ -77,6 +120,16 @@ runUpdate conn (SqlUpdate _ (PgUpdateSyntax i)) =     executeStatement conn i +-- | Run a PostgreSQL @UPDATE ... RETURNING ...@ statement in any 'C.MonadResource' and+-- get a 'C.Source' of the newly updated rows.+streamingRunUpdateReturning :: ( C.MonadResource m, Fail.MonadFail m, FromBackendRow Postgres a)+                            => Pg.Connection+                            -> PgUpdateReturning a+                            -> CONDUIT_TRANSFORMER () a m ()+streamingRunUpdateReturning _ PgUpdateReturningEmpty = pure ()+streamingRunUpdateReturning conn (PgUpdateReturning u) =+  streamingRunQueryReturning conn u+ -- | Run a PostgreSQL @UPDATE ... RETURNING ...@ statement in any 'MonadIO' and -- get a 'C.Source' of the newly updated rows. runUpdateReturning :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, FromBackendRow Postgres a)@@ -87,6 +140,7 @@ runUpdateReturning _ PgUpdateReturningEmpty withSrc = withSrc (pure ()) runUpdateReturning conn (PgUpdateReturning u) withSrc =   runQueryReturning conn u withSrc+{-# DEPRECATED runUpdateReturning "Use streamingRunUpdateReturning" #-}  -- * @DELETE@ @@ -99,12 +153,21 @@     executeStatement conn d  -- | Run a PostgreSQl @DELETE ... RETURNING ...@ statement in any+-- 'C.MonadResource' and get a 'C.Source' of the deleted rows.+streamingRunDeleteReturning :: ( C.MonadResource m, Fail.MonadFail m, FromBackendRow Postgres a )+                            => Pg.Connection -> PgDeleteReturning a+                            -> CONDUIT_TRANSFORMER () a m ()+streamingRunDeleteReturning conn (PgDeleteReturning d) =+  streamingRunQueryReturning conn d++-- | Run a PostgreSQl @DELETE ... RETURNING ...@ statement in any -- 'MonadIO' and get a 'C.Source' of the deleted rows. runDeleteReturning :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, FromBackendRow Postgres a )                    => Pg.Connection -> PgDeleteReturning a                    -> (CONDUIT_TRANSFORMER () a m () -> m b) -> m b runDeleteReturning conn (PgDeleteReturning d) withSrc =   runQueryReturning conn d withSrc+{-# DEPRECATED runDeleteReturning "Use streamingRunDeleteReturning" #-}  -- * Convenience functions @@ -115,77 +178,122 @@     syntax <- pgRenderSyntax conn x     Pg.execute_ conn (Pg.Query syntax) + -- | Runs any query that returns a set of values-runQueryReturning-  :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, Functor m, FromBackendRow Postgres r )+streamingRunQueryReturning+  :: ( C.MonadResource m, Fail.MonadFail m, FromBackendRow Postgres r )   => Pg.Connection -> PgSyntax-  -> (CONDUIT_TRANSFORMER () r m () -> m b)-  -> m b-runQueryReturning conn x withSrc = do-  success <- liftIO $ do-    syntax <- pgRenderSyntax conn x+  -> CONDUIT_TRANSFORMER () r m ()+streamingRunQueryReturning (conn@Pg.Connection {connectionHandle}) x = do+  syntax <- liftIO $ pgRenderSyntax conn x+  -- We need to own the connection for the duration of the conduit's+  -- lifetime, since it will be in a streaming state until we clean up+  C.bracketP+    (takeMVar connectionHandle)+    (putMVar connectionHandle)+    (\conn' -> do+      success <- liftIO $+        if Pg.isNullConnection conn'+        then throwIO Pg.disconnectedError+        else Pg.sendQuery conn' syntax -    Pg.withConnection conn (\conn' -> Pg.sendQuery conn' syntax)+      if success+        then do+          singleRowModeSet <- liftIO $ Pg.setSingleRowMode conn'+          if singleRowModeSet+            then+              C.bracketP+                (pure ())+                (\_ -> gracefulShutdown conn')+                (\_ -> streamResults conn conn' Nothing)+            else Fail.fail "Could not enable single row mode"+        else do+          errMsg <- fromMaybe "No libpq error provided" <$> liftIO (Pg.errorMessage conn')+          Fail.fail (show errMsg)) -  if success-    then do-      singleRowModeSet <- liftIO (Pg.withConnection conn Pg.setSingleRowMode)-      if singleRowModeSet-         then withSrc (streamResults Nothing) `finally` gracefulShutdown-         else Fail.fail "Could not enable single row mode"-    else do-      errMsg <- fromMaybe "No libpq error provided" <$> liftIO (Pg.withConnection conn Pg.errorMessage)-      Fail.fail (show errMsg)+streamResults :: (Fail.MonadFail m, FromBackendRow Postgres r, MonadIO m) => Pg.Connection -> Pq.Connection -> Maybe [Pg.Field] -> C.ConduitT i r m ()+streamResults (conn@Pg.Connection {connectionHandle}) conn' fields = do+  nextRow <- liftIO (Pg.getResult conn')+  case nextRow of+    Nothing -> pure ()+    Just row ->+      liftIO (Pg.resultStatus row) >>=+      \case+        Pg.SingleTuple ->+          do fields' <- liftIO (maybe (getFields row) pure fields)+             parsedRow <- liftIO $ bracket+               (putMVar connectionHandle conn')+               (\_ -> takeMVar connectionHandle)+               (\_ -> runPgRowReader conn 0 row fields' fromBackendRow)+             case parsedRow of+               Left err -> liftIO (bailEarly conn' row ("Could not read row: " <> show err))+               Right parsedRow' ->+                 do C.yield parsedRow'+                    streamResults conn conn' (Just fields')+        Pg.TuplesOk -> liftIO (finishQuery conn')+        Pg.EmptyQuery -> Fail.fail "No query"+        Pg.CommandOk -> pure ()+        status@Pg.BadResponse -> liftIO (Pg.throwResultError "streamResults" row status)+        status@Pg.NonfatalError -> liftIO (Pg.throwResultError "streamResults" row status)+        status@Pg.FatalError -> liftIO (Pg.throwResultError "streamResults" row status)+        _ -> do errMsg <- liftIO (Pg.resultErrorMessage row)+                Fail.fail ("Postgres error: " <> show errMsg) -  where-    streamResults fields = do-      nextRow <- liftIO (Pg.withConnection conn Pg.getResult)-      case nextRow of-        Nothing -> pure ()-        Just row ->-          liftIO (Pg.resultStatus row) >>=-          \case-            Pg.SingleTuple ->-              do fields' <- liftIO (maybe (getFields row) pure fields)-                 parsedRow <- liftIO (runPgRowReader conn 0 row fields' fromBackendRow)-                 case parsedRow of-                   Left err -> liftIO (bailEarly row ("Could not read row: " <> show err))-                   Right parsedRow' ->-                     do C.yield parsedRow'-                        streamResults (Just fields')-            Pg.TuplesOk -> liftIO (Pg.withConnection conn finishQuery)-            Pg.EmptyQuery -> Fail.fail "No query"-            Pg.CommandOk -> pure ()-            _ -> do errMsg <- liftIO (Pg.resultErrorMessage row)-                    Fail.fail ("Postgres error: " <> show errMsg)+bailEarly :: Pq.Connection -> Pg.Result -> String -> IO a+bailEarly conn' row errorString = do+  Pg.unsafeFreeResult row+  cancelQuery conn'+  Fail.fail errorString -    bailEarly row errorString = do-      Pg.unsafeFreeResult row-      Pg.withConnection conn $ cancelQuery-      Fail.fail errorString+cancelQuery :: Pq.Connection -> IO ()+cancelQuery conn' = do+  cancel <- Pg.getCancel conn'+  case cancel of+    Nothing -> pure ()+    Just cancel' -> do+      res <- Pg.cancel cancel'+      case res of+        Right () -> liftIO (finishQuery conn')+        Left err -> Fail.fail ("Could not cancel: " <> show err) -    cancelQuery conn' = do-      cancel <- Pg.getCancel conn'-      case cancel of-        Nothing -> pure ()-        Just cancel' -> do-          res <- Pg.cancel cancel'-          case res of-            Right () -> liftIO (finishQuery conn')-            Left err -> Fail.fail ("Could not cancel: " <> show err)+finishQuery :: Pq.Connection -> IO ()+finishQuery conn' = do+  nextRow <- Pg.getResult conn'+  case nextRow of+    Nothing -> pure ()+    Just _ -> finishQuery conn' -    finishQuery conn' = do-      nextRow <- Pg.getResult conn'-      case nextRow of-        Nothing -> pure ()-        Just _ -> finishQuery conn'+gracefulShutdown :: Pq.Connection -> IO ()+gracefulShutdown conn' = do+  sts <- Pg.transactionStatus conn'+  case sts of+    Pg.TransIdle -> pure ()+    Pg.TransInTrans -> pure ()+    Pg.TransInError -> pure ()+    Pg.TransUnknown -> pure ()+    Pg.TransActive -> cancelQuery conn' -    gracefulShutdown =-      liftIO . Pg.withConnection conn $ \conn' ->-      do sts <- Pg.transactionStatus conn'-         case sts of-           Pg.TransIdle -> pure ()-           Pg.TransInTrans -> pure ()-           Pg.TransInError -> pure ()-           Pg.TransUnknown -> pure ()-           Pg.TransActive -> cancelQuery conn'+-- | Runs any query that returns a set of values+runQueryReturning+  :: ( MonadIO m, Fail.MonadFail m, MonadBaseControl IO m, Functor m, FromBackendRow Postgres r )+  => Pg.Connection -> PgSyntax+  -> (CONDUIT_TRANSFORMER () r m () -> m b)+  -> m b+runQueryReturning (conn@Pg.Connection {connectionHandle}) x withSrc = do+  syntax <- liftIO $ pgRenderSyntax conn x++  Lifted.bracket+    (Lifted.takeMVar connectionHandle)+    (Lifted.putMVar connectionHandle)+    (\conn' -> do+      success <- liftIO $ Pg.sendQuery conn' syntax+      if success+        then do+          singleRowModeSet <- liftIO (Pg.setSingleRowMode conn')+          if singleRowModeSet+             then withSrc (streamResults conn conn' Nothing) `finally` (liftIO $ gracefulShutdown conn')+             else Fail.fail "Could not enable single row mode"+        else do+          errMsg <- fromMaybe "No libpq error provided" <$> liftIO (Pg.errorMessage conn')+          Fail.fail (show errMsg))+{-# DEPRECATED runQueryReturning "Use streamingRunQueryReturning" #-}

@@ -289,7 +289,12 @@         FromBackendRow Postgres x =>         (Maybe x -> next) -> PgF next     PgLiftWithHandle :: ((String -> IO ()) -> Pg.Connection -> IO a) -> (a -> next) -> PgF next-deriving instance Functor PgF+instance Functor PgF where+  fmap f = \case+    PgLiftIO io n -> PgLiftIO io $ f . n+    PgRunReturning mode cmd consume n -> PgRunReturning mode cmd consume $ f . n+    PgFetchNext n -> PgFetchNext $ f . n+    PgLiftWithHandle withConn n -> PgLiftWithHandle withConn $ f . n  -- | How to fetch results. data FetchMode

@@ -381,7 +381,7 @@   emit " RETURNING " <>   pgSepBy (emit ", ") (map fromPgExpression (project (Proxy @Postgres) (mkProjection tblQ) "t"))   where-    SqlDelete _ pgDelete = delete table mkWhere+    SqlDelete _ pgDelete = delete table $ \t -> mkWhere t     tblQ = changeBeamRep (\(Columnar' f) -> Columnar' (QExpr (pure (fieldE (unqualifiedField (_fieldName f)))))) tblSettings  runPgDeleteReturningList

@@ -106,12 +106,16 @@   , lowerInc_, upperInc_, lowerInf_, upperInf_   , rangeMerge_ +    -- * Postgres @EXTRACT@ fields+  , century_, decade_, dow_, doy_, epoch_, isodow_, isoyear_+  , microseconds_, milliseconds_, millennium_, quarter_, week_+     -- ** Postgres functions and aggregates   , pgBoolOr, pgBoolAnd, pgStringAgg, pgStringAggOver    , pgNubBy_ -  , now_, ilike_+  , now_, ilike_, ilike_'   ) where @@ -142,7 +146,7 @@ import           Data.Scientific (Scientific, formatScientific, FPFormat(Fixed)) import           Data.String import qualified Data.Text as T-import           Data.Time (LocalTime)+import           Data.Time (LocalTime, NominalDiffTime) import           Data.Type.Bool import qualified Data.Vector as V #if !MIN_VERSION_base(4, 11, 0)@@ -164,12 +168,23 @@ now_ = QExpr (\_ -> PgExpressionSyntax (emit "NOW()"))  -- | Postgres @ILIKE@ operator. A case-insensitive version of 'like_'.-ilike_ :: BeamSqlBackendIsString Postgres text-       => QExpr Postgres s text-       -> QExpr Postgres s text-       -> QExpr Postgres s Bool-ilike_ (QExpr a) (QExpr b) = QExpr (pgBinOp "ILIKE" <$> a <*> b)+ilike_+  :: BeamSqlBackendIsString Postgres text+  => QExpr Postgres s text+  -> QExpr Postgres s text+  -> QExpr Postgres s Bool+ilike_ = ilike_' +-- | Postgres @ILIKE@ operator. A case-insensitive version of 'like_''.+ilike_'+  :: ( BeamSqlBackendIsString Postgres left+     , BeamSqlBackendIsString Postgres right+     )+  => QExpr Postgres s left+  -> QExpr Postgres s right+  -> QExpr Postgres s Bool+ilike_' (QExpr a) (QExpr b) = QExpr (pgBinOp "ILIKE" <$> a <*> b)+ -- ** TsVector type  -- | The type of a document preprocessed for full-text search. The contained@@ -442,7 +457,7 @@ data PgBoundType   = Inclusive   | Exclusive-  deriving (Show, Generic)+  deriving (Eq, Show, Generic) instance Hashable PgBoundType  lBound :: PgBoundType -> ByteString@@ -455,7 +470,7 @@  -- | Represents a single bound on a Range. A bound always has a type, but may not have a value -- (the absense of a value represents unbounded).-data PgRangeBound a = PgRangeBound PgBoundType (Maybe a) deriving (Show, Generic)+data PgRangeBound a = PgRangeBound PgBoundType (Maybe a) deriving (Eq, Show, Generic)  inclusive :: a -> PgRangeBound a inclusive = PgRangeBound Inclusive . Just@@ -474,7 +489,7 @@ data PgRange (n :: *) a   = PgEmptyRange   | PgRange (PgRangeBound a) (PgRangeBound a)-  deriving (Show, Generic)+  deriving (Eq, Show, Generic)  instance Hashable a => Hashable (PgRangeBound a) @@ -1464,6 +1479,44 @@   defaultSqlDataType _ be embedded =       pgUnboundedArrayType (defaultSqlDataType (Proxy :: Proxy a) be embedded) +-- ** Extract++century_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+century_ = ExtractField (PgExtractFieldSyntax (emit "CENTURY"))++decade_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+decade_ = ExtractField (PgExtractFieldSyntax (emit "DECADE"))++dow_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+dow_ = ExtractField (PgExtractFieldSyntax (emit "DOW"))++doy_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+doy_ = ExtractField (PgExtractFieldSyntax (emit "DOY"))++epoch_ :: HasSqlTime tgt => ExtractField Postgres tgt NominalDiffTime+epoch_ = ExtractField (PgExtractFieldSyntax (emit "EPOCH"))++isodow_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+isodow_ = ExtractField (PgExtractFieldSyntax (emit "ISODOW"))++isoyear_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+isoyear_ = ExtractField (PgExtractFieldSyntax (emit "ISOYEAR"))++microseconds_ :: HasSqlTime tgt => ExtractField Postgres tgt Int32+microseconds_ = ExtractField (PgExtractFieldSyntax (emit "MICROSECONDS"))++milliseconds_ :: HasSqlTime tgt => ExtractField Postgres tgt Int32+milliseconds_ = ExtractField (PgExtractFieldSyntax (emit "MILLISECONDS"))++millennium_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+millennium_ = ExtractField (PgExtractFieldSyntax (emit "MILLENNIUM"))++quarter_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+quarter_ = ExtractField (PgExtractFieldSyntax (emit "QUARTER"))++week_ :: HasSqlDate tgt => ExtractField Postgres tgt Int32+week_ = ExtractField (PgExtractFieldSyntax (emit "WEEK"))+ -- $full-text-search -- -- Postgres has comprehensive, and thus complicated, support for full text@@ -1551,4 +1604,3 @@ -- 'pgUnnestArrayWithOrdinality' function allows you to join against the -- elements of an array along with its index. This corresponds to the -- @UNNEST .. WITH ORDINALITY@ clause.-

@@ -120,7 +120,7 @@ import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import           Data.Time (LocalTime, UTCTime, TimeOfDay, NominalDiffTime, Day)-import           Data.UUID.Types (UUID)+import           Data.UUID.Types (UUID, toASCIIBytes) import           Data.Word import qualified Data.Vector as V import           GHC.TypeLits@@ -1197,7 +1197,6 @@ DEFAULT_SQL_SYNTAX(TimeOfDay) DEFAULT_SQL_SYNTAX(NominalDiffTime) DEFAULT_SQL_SYNTAX(Day)-DEFAULT_SQL_SYNTAX(UUID) DEFAULT_SQL_SYNTAX([Char]) DEFAULT_SQL_SYNTAX(Pg.HStoreMap) DEFAULT_SQL_SYNTAX(Pg.HStoreList)@@ -1224,6 +1223,12 @@  instance HasSqlValueSyntax PgValueSyntax BL.ByteString where   sqlValueSyntax = defaultPgValueSyntax . Pg.Binary++-- This should be removed in favor of the default syntax if/when+-- https://github.com/lpsmith/postgresql-simple/issues/277 is fixed upstream.+instance HasSqlValueSyntax PgValueSyntax UUID where+  sqlValueSyntax v = PgValueSyntax $+    emit "'" <> emit (toASCIIBytes v) <> emit "'::uuid"  instance Pg.ToField a => HasSqlValueSyntax PgValueSyntax (V.Vector a) where   sqlValueSyntax = defaultPgValueSyntax

@@ -1,5 +1,5 @@ name:                 beam-postgres-version:              0.5.1.0+version:              0.5.2.0 synopsis:             Connection layer between beam and postgres description:          Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS homepage:             https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres@@ -40,13 +40,13 @@                       postgresql-simple    >=0.5  && <0.7,                        text                 >=1.0  && <1.3,-                      bytestring           >=0.10 && <0.11,+                      bytestring           >=0.10 && <0.12, -                      attoparsec           >=0.13 && <0.14,-                      hashable             >=1.1  && <1.4,+                      attoparsec           >=0.13 && <0.15,+                      hashable             >=1.1  && <1.5,                       lifted-base          >=0.2  && <0.3,                       free                 >=4.12 && <5.2,-                      time                 >=1.6  && <1.10,+                      time                 >=1.6  && <1.12,                       monad-control        >=1.0  && <1.1,                       mtl                  >=2.1  && <2.3,                       conduit              >=1.2  && <1.4,

@@ -10,15 +10,21 @@ import           Control.Exception (bracket)  import           Control.Monad (void)-#if MIN_VERSION_base(4,12,0)-import           Control.Monad.Fail (MonadFail(..))-#endif  import           Data.ByteString (ByteString) import           Data.String +#if MIN_VERSION_base(4,12,0)+#if !MIN_VERSION_hedgehog(1,0,0)+import           Control.Monad.Fail (MonadFail(..)) import qualified Hedgehog-+-- TODO orphan instances are bad+-- Would be easier to say 'build-depends: hedgehog >= 1.0',+-- but it's difficult to propagate to older Stackage snapshots+instance Monad m => MonadFail (Hedgehog.PropertyT m) where+    fail _ = Hedgehog.failure+#endif+#endif  withTestPostgres :: String -> IO ByteString -> (Pg.Connection -> IO a) -> IO a withTestPostgres dbName getConnStr action = do@@ -40,13 +46,3 @@           Pg.execute_ c' (fromString ("DROP DATABASE " <> dbName))    bracket createDatabase dropDatabase action--#if MIN_VERSION_base(4,12,0)-#if !MIN_VERSION_hedgehog(1,0,0)--- TODO orphan instances are bad--- Would be easier to say 'build-depends: hedgehog >= 1.0',--- but it's difficult to propagate to older Stackage snapshots-instance Monad m => MonadFail (Hedgehog.PropertyT m) where-    fail _ = Hedgehog.failure-#endif-#endif

@@ -13,7 +13,6 @@ import           Data.ByteString (ByteString) import           Data.Functor.Classes import           Data.Int-import           Data.Proxy (Proxy(..)) import qualified Data.Text as T import           Data.Typeable import           Data.UUID (UUID, fromWords)

@@ -5,11 +5,11 @@ import           Data.Aeson import           Data.ByteString (ByteString) import           Data.Int-import           Data.Text (Text) import qualified Data.Vector as V import           Test.Tasty import           Test.Tasty.HUnit import           Data.UUID (UUID, nil)+import qualified Data.UUID.V5 as V5  import           Database.Beam import           Database.Beam.Backend.SQL.SQL92@@ -25,18 +25,22 @@       [ testPgArrayToJSON getConn       ]   , testGroup "UUID"-      [ testUuidFunction getConn "uuid_nil" pgUuidNil-      , testUuidFunction getConn "uuid_ns_dns" pgUuidNsDns-      , testUuidFunction getConn "uuid_ns_url" pgUuidNsUrl-      , testUuidFunction getConn "uuid_ns_oid" pgUuidNsOid-      , testUuidFunction getConn "uuid_ns_x500" pgUuidNsX500-      , testUuidFunction getConn "uuid_generate_v1" pgUuidGenerateV1-      , testUuidFunction getConn "uuid_generate_v1mc" pgUuidGenerateV1Mc+      [ testUuidFunction getConn "uuid_nil" $ \ext -> pgUuidNil ext+      , testUuidFunction getConn "uuid_ns_dns" $ \ext -> pgUuidNsDns ext+      , testUuidFunction getConn "uuid_ns_url" $ \ext -> pgUuidNsUrl ext+      , testUuidFunction getConn "uuid_ns_oid" $ \ext -> pgUuidNsOid ext+      , testUuidFunction getConn "uuid_ns_x500" $ \ext -> pgUuidNsX500 ext+      , testUuidFunction getConn "uuid_generate_v1" $ \ext ->+          pgUuidGenerateV1 ext+      , testUuidFunction getConn "uuid_generate_v1mc" $ \ext ->+          pgUuidGenerateV1Mc ext       , testUuidFunction getConn "uuid_generate_v3" $ \ext ->           pgUuidGenerateV3 ext (val_ nil) "nil"-      , testUuidFunction getConn "uuid_generate_v4" pgUuidGenerateV4+      , testUuidFunction getConn "uuid_generate_v4" $ \ext ->+          pgUuidGenerateV4 ext       , testUuidFunction getConn "uuid_generate_v5" $ \ext ->           pgUuidGenerateV5 ext (val_ nil) "nil"+      , testUuuidInValues getConn       ]   , testInRowValues getConn   , testReturningMany getConn@@ -68,6 +72,19 @@       return $ mkUuid $ getPgExtension $ _uuidOssp $ unCheckDatabase db     return () +-- | Regression test for <https://github.com/haskell-beam/beam/issues/555 #555>+testUuuidInValues :: IO ByteString -> TestTree+testUuuidInValues getConn = testCase "UUID in values_ works" $+  withTestPostgres "uuid_values" getConn $ \conn -> do+    result <- runBeamPostgres conn $ do+      db <- executeMigration runNoReturn $ UuidSchema <$>+        pgCreateExtension @UuidOssp+      let ext = getPgExtension $ _uuidOssp $ unCheckDatabase db+      runSelectReturningList $ select $ do+        v <- values_ [val_ nil]+        return $ pgUuidGenerateV5 ext v ""+    assertEqual "result" [V5.generateNamed nil []] result+ data Pair f = Pair   { _left :: C f Bool   , _right :: C f Bool@@ -77,9 +94,9 @@ testInRowValues getConn = testCase "IN with row values works" $   withTestPostgres "db_in_row_values" getConn $ \conn -> do     result <- runBeamPostgres conn $ runSelectReturningList $ select $ do-      let p :: forall ctx s. Pair (QGenExpr ctx Postgres s)-          p = val_ $ Pair False False-      return $ p `in_` [p, p]+      let pair :: forall ctx s. Pair (QGenExpr ctx Postgres s)+          pair = val_ $ Pair False False+      return $ pair `in_` [pair, pair]     assertEqual "result" [True] result  testReturningMany :: IO ByteString -> TestTree