beam-sqlite 0.5.5.0 → 0.5.6.0

raw patch · 7 files changed

+455/−50 lines, 7 filesdep +containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Database/Beam/Sqlite/Connection.hs +210/−44
• Database/Beam/Sqlite/Syntax.hs +1/−1
• beam-sqlite.cabal +4/−2
• test/Database/Beam/Sqlite/Test/Insert.hs +53/−3
• test/Database/Beam/Sqlite/Test/Returning.hs +178/−0
• test/Main.hs +2/−0

@@ -1,3 +1,10 @@+# 0.5.6.0++## Performance optimizations++* `insertReturning` / `deleteReturning` / `updateReturning` now generate optimal SQL queries, minimizing the number+  of separate statements, by grouping similar statements in the presence of the `DEFAULT` keyword (#785).+ # 0.5.5.0  ## Added features

@@ -4,6 +4,7 @@ {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeOperators #-}  module Database.Beam.Sqlite.Connection   ( Sqlite(..), SqliteM(..)@@ -11,7 +12,19 @@    , runBeamSqlite, runBeamSqliteDebug -  , insertReturning, runInsertReturningList+    -- * Support for @RETURNING@ with additional projection++    -- ** @INSERT ... RETURNING@+  , SqliteInsertReturning+  , insertReturning, insertOnConflictReturning, runInsertReturningList++    -- ** @DELETE ... RETURNING@+  , SqliteDeleteReturning+  , deleteReturning, runDeleteReturningList++    -- ** @UPDATE ... RETURNING@+  , SqliteUpdateReturning+  , updateReturning, runUpdateReturningList   ) where  import           Prelude hiding (fail)@@ -25,11 +38,13 @@ import qualified Database.Beam.Migrate.SQL as Beam import           Database.Beam.Migrate.SQL.BeamExtensions import           Database.Beam.Query ( SqlInsert(..), SqlInsertValues(..)+                                     , SqlDelete(..)                                      , HasQBuilder(..), HasSqlEqualityCheck                                      , HasSqlQuantifiedEqualityCheck                                      , DataType(..)                                      , HasSqlInTable(..)-                                     , insert, current_ )+                                     , QExprToIdentity+                                     , insert, current_, delete, SqlUpdate (..), update ) import           Database.Beam.Query.Internal import           Database.Beam.Query.SQL92 import           Database.Beam.Schema.Tables ( Beamable@@ -71,6 +86,9 @@ import qualified Data.DList as D import           Data.Int import           Data.IORef (newIORef, atomicModifyIORef')+import           Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import qualified Data.List.NonEmpty as NE import           Data.Maybe (mapMaybe) import           Data.Proxy (Proxy(..)) import           Data.Scientific (Scientific)@@ -80,6 +98,7 @@ import           Data.Time ( LocalTime, UTCTime, Day                            , ZonedTime, utc, utcToLocalTime ) import           Data.Typeable (cast)+import           Data.Void (Void) import           Data.Word import           GHC.IORef (atomicModifyIORef'_) import           GHC.TypeLits@@ -332,26 +351,15 @@                                 Nothing -> pure Nothing                                 Just (BeamSqliteRow row) -> pure row                runReaderT (runSqliteM (action nextRow')) (logger, conn)-  runReturningMany (SqliteCommandInsert (SqliteInsertSyntax tbl fields vs onConflict)) action-    | SqliteInsertExpressions es <- vs, any (any (== SqliteExpressionDefault)) es =-      -- SQLite's handling of default values differs from other DBMses because-      -- it lacks support for DEFAULT. In order to insert a default value in a column,-      -- the column's name should be omitted from the INSERT statement.-      ---      -- This is problematic if you insert multiple rows, some of which have defaults;-      -- you must use multiple INSERT statements. This is what we do below.-      ---      -- However, to respect the 'runReturningMany' interface, be must accumulate the-      -- results of all those inserts into an 'IORef [a]', and then feed the results-      -- incrementally to 'action'.+  runReturningMany (SqliteCommandInsert (SqliteInsertSyntax tbl fields vs onConflict)) action =+      -- The DEFAULT grouping happens at query construction time, so we just+      -- handle the already-grouped statements here.       SqliteM $ do         (logger, conn) <- ask         resultsRef <- liftIO (newIORef [])-        forM_ es $ \row -> do-          -- RETURNING is only supported by SQLite 3.35+, which requires direct-sqlite 2.3.27++        forM_ (sqliteGroupByDefaults fields vs) $ \(fields', vs') -> do           let returningClause = emit " RETURNING " <> commas (map quotedIdentifier fields)-              (insertFields, insertRow) = unzip $ filter ((/= SqliteExpressionDefault) . snd) $ zip fields row-              SqliteSyntax cmd vals = formatSqliteInsertOnConflict tbl insertFields (SqliteInsertExpressions [ insertRow ]) onConflict <> returningClause+              SqliteSyntax cmd vals = formatSqliteInsertOnConflict tbl fields' vs' onConflict <> returningClause               cmdString = BL.unpack (toLazyByteString (withPlaceholders cmd))            liftIO $ do@@ -369,21 +377,6 @@                 (BeamSqliteRow h:rest) -> (rest, Just h)                 [] -> ([], Nothing)         runSqliteM (action nextRow')-    | otherwise =-      SqliteM $ do-        (logger, conn) <- ask-        let returningClause = emit " RETURNING " <> commas (map quotedIdentifier fields)-            SqliteSyntax cmd vals = formatSqliteInsertOnConflict tbl fields vs onConflict <> returningClause-            cmdString = BL.unpack (toLazyByteString (withPlaceholders cmd))-        liftIO $ do-          logger (cmdString ++ ";\n-- With values: " ++ show (D.toList vals))-          withStatement conn (fromString cmdString) $ \stmt ->-            do bind stmt (BeamSqliteParams (D.toList vals))-               let nextRow' = liftIO (nextRow stmt) >>= \x ->-                              case x of-                                Nothing -> pure Nothing-                                Just (BeamSqliteRow row) -> pure row-               runReaderT (runSqliteM (action nextRow')) (logger, conn)   unfoldM :: Monad m => m (Maybe a) -> m [a]@@ -392,8 +385,89 @@     go acc = f >>= maybe (pure acc) (\x -> go (x : acc))  instance Beam.MonadBeamInsertReturning Sqlite SqliteM where-  runInsertReturningList = runInsertReturningList+  runInsertReturningList SqlInsertNoRows = pure []+  runInsertReturningList (SqlInsert _ insertCommand) = runReturningList $ SqliteCommandInsert insertCommand +newtype SqliteInsertReturning a = SqliteInsertReturning [SqliteSyntax]+newtype SqliteDeleteReturning a = SqliteDeleteReturning SqliteSyntax+newtype SqliteUpdateReturning a = SqliteUpdateReturning (Maybe SqliteSyntax)++-- | SQLite cannot deal with DEFAULT in insertion. Instead, it expects these+-- fields to be omitted from the INSERT.+--+-- This means that, for any given INSERT query, the row value being inserted+-- must have a fixed set of fields with DEFAULT value.+--+-- This function groups the inserted values by the set of DEFAULT fields, so+-- that we can perform a separate INSERT for each set of DEFAULT fields.+sqliteGroupByDefaults :: [T.Text] -> SqliteInsertValuesSyntax -> [([T.Text], SqliteInsertValuesSyntax)]+sqliteGroupByDefaults flds (SqliteInsertExpressions es) =+  let+    partitionDefaultsFrom :: (IntSet, [SqliteExpressionSyntax]) -> Int -> [SqliteExpressionSyntax] -> (IntSet, [SqliteExpressionSyntax])+    partitionDefaultsFrom (dflts, acc) _ [] = (dflts, reverse acc)+    partitionDefaultsFrom (dflts, acc) i (x:xs)+      | x == SqliteExpressionDefault+      = partitionDefaultsFrom (IntSet.insert i dflts, acc) (i + 1) xs+      | otherwise+      = partitionDefaultsFrom (dflts, x : acc) (i + 1) xs++    grouped :: [(IntSet, NE.NonEmpty [SqliteExpressionSyntax])]+    grouped =+      map (\xs -> (fst (NE.head xs), fmap snd xs)) $+      NE.groupBy (\(d1, _) (d2, _) -> d1 == d2)+        [ partitionDefaultsFrom (IntSet.empty, []) 0 e+        | e <- es+        ]++    mkSyntax :: IntSet -> NE.NonEmpty [SqliteExpressionSyntax] -> ([T.Text], SqliteInsertValuesSyntax)+    mkSyntax dflts xs =+      ( [fld | (i, fld) <- zip [0..] flds+             , not $ i `IntSet.member` dflts+             ]+      , SqliteInsertExpressions $ NE.toList xs+      )+  in+    map (uncurry mkSyntax) grouped+sqliteGroupByDefaults flds orig@(SqliteInsertFromSql {}) =+  -- Preserve manually-written queries+  [(flds, orig)]++runDeleteReturningList+  :: ( MonadBeam be m+     , BeamSqlBackendSyntax be ~ SqliteCommandSyntax+     , FromBackendRow be a+     )+  => SqliteDeleteReturning a+  -> m [a]+runDeleteReturningList (SqliteDeleteReturning syntax) =+  runReturningList $ SqliteCommandSyntax syntax++-- | SQLite @DELETE ... RETURNING@ statement support. The last+-- argument takes the deleted row and returns the values to be returned.+--+-- Use 'runDeleteReturningList' to get the results.+deleteReturning :: forall a table be. Projectible Sqlite a+                => DatabaseEntity Sqlite be (TableEntity table)+                      -- ^ table to delete from+                -> (forall s. table (QExpr Sqlite s) -> QExpr Sqlite s Bool)+                      -- ^ predicate selecting rows to delete+                -> (table (QExpr Sqlite Void) -> a)+                      -- ^ projection describing what to return+                -> SqliteDeleteReturning (QExprToIdentity a)+deleteReturning table@(DatabaseEntity (DatabaseTable { dbTableSettings = tblSettings }))+                mkWhere+                mkProjection =+  SqliteDeleteReturning $+    fromSqliteDelete sqliteDelete+      <>+    emit " RETURNING " <> commas (map fromSqliteExpression (project (Proxy @Sqlite) (mkProjection tblQ) "t"))+  where++    SqlDelete _ sqliteDelete = delete table (\t -> mkWhere t) -- eta-expand for compatibility with shallow subsumption+    tblQ = changeBeamRep getFieldName tblSettings+    getFieldName (Columnar' fd) =+      Columnar' $ QExpr $ pure $ fieldE (unqualifiedField (_fieldName fd))+ runSqliteInsert :: (String -> IO ()) -> Connection -> SqliteInsertSyntax -> IO () runSqliteInsert logger conn (SqliteInsertSyntax tbl fields vs onConflict)     -- If all expressions are simple expressions (no default), then just@@ -411,23 +485,73 @@       logger (cmdString ++ ";\n-- With values: " ++ show (D.toList vals))       execute conn (fromString cmdString) (D.toList vals) --- * INSERT returning support- -- | Build a 'SqliteInsertReturning' representing inserting the given values--- into the given table. Use 'runInsertReturningList'+-- into the given table and returning all inserted rows.+--+-- Use 'runInsertReturningList' to get the results. insertReturning :: Beamable table                 => DatabaseEntity Sqlite db (TableEntity table)+                      -- ^ table to insert into                 -> SqlInsertValues Sqlite (table (QExpr Sqlite s))-                -> SqlInsert Sqlite table-insertReturning = insert+                      -- ^ values/expressions to insert+                -> SqliteInsertReturning (table Identity)+insertReturning table vals =+  SqliteInsertReturning $+    case insert table vals of+      SqlInsert _ (SqliteInsertSyntax tbl fields values onConflict) ->+        [ formatSqliteInsertOnConflict tbl fields' values' onConflict <>+          emit " RETURNING " <> commas (map quotedIdentifier fields)+        | (fields', values') <- sqliteGroupByDefaults fields values+        ]+      SqlInsertNoRows -> [] +-- | SQLite @INSERT ... RETURNING@ statement support with conflict handling.+-- The last argument takes the newly inserted row and returns the values to be+-- returned.+--+-- Use 'runInsertReturningList' to get the results.+insertOnConflictReturning+  :: forall s a table db+  .  (Beamable table, Projectible Sqlite a)+  => DatabaseEntity Sqlite db (TableEntity table)+      -- ^ table to insert into+  -> SqlInsertValues Sqlite (table (QExpr Sqlite s))+      -- ^ values/expressions to insert+  -> Beam.SqlConflictTarget Sqlite table+      -- ^ the target of the conflict (e.g. the row primary key)+  -> Beam.SqlConflictAction Sqlite table+      -- ^ what to do on conflict (e.g. nothing, override, etc)+  -> (table (QExpr Sqlite Void) -> a)+        -- ^ projection describing what to return+  -> SqliteInsertReturning (QExprToIdentity a)+insertOnConflictReturning+  table@(DatabaseEntity (DatabaseTable { dbTableSettings = tblSettings }))+  vals tgt action mkProjection =+  SqliteInsertReturning $+    case Beam.insertOnConflict table vals tgt action of+      SqlInsert _ (SqliteInsertSyntax tbl fields values onConflict) ->+        [ formatSqliteInsertOnConflict tbl fields' values' onConflict <>+          emit " RETURNING " <> commas (map fromSqliteExpression (project (Proxy @Sqlite) (mkProjection tblQ) "t"))+        | (fields', values') <- sqliteGroupByDefaults fields values+        ]+      SqlInsertNoRows -> []+  where+    tblQ = changeBeamRep getFieldName tblSettings+    getFieldName (Columnar' fd) =+      Columnar' $ QExpr $ pure $ fieldE (unqualifiedField (_fieldName fd))+ -- | Runs a 'SqliteInsertReturning' statement and returns a result for each -- inserted row.-runInsertReturningList :: (Beamable table, FromBackendRow Sqlite (table Identity))-                       => SqlInsert Sqlite table-                       -> SqliteM [ table Identity ]-runInsertReturningList SqlInsertNoRows = pure []-runInsertReturningList (SqlInsert _ insertCommand) = runReturningList $ SqliteCommandInsert insertCommand+runInsertReturningList+  :: ( MonadBeam be m+     , BeamSqlBackendSyntax be ~ SqliteCommandSyntax+     , FromBackendRow be a+     )+  => SqliteInsertReturning a+  -> m [a]+runInsertReturningList (SqliteInsertReturning syntaxes) =+  concat <$>+    traverse (\syntax -> runReturningList $ SqliteCommandSyntax syntax) syntaxes  instance Beam.BeamHasInsertOnConflict Sqlite where   newtype SqlConflictTarget Sqlite table = SqliteConflictTarget@@ -508,3 +632,45 @@ excluded table = changeBeamRep excludedField table   where excludedField (Columnar' (QField _ _ name)) =           Columnar' $ QExpr $ const $ fieldE $ qualifiedField "excluded" name++-- | Use in conjunction with 'updateReturning'.+runUpdateReturningList+  :: ( MonadBeam be m+     , BeamSqlBackendSyntax be ~ SqliteCommandSyntax+     , FromBackendRow be a+     )+  => SqliteUpdateReturning a+  -> m [a]+runUpdateReturningList (SqliteUpdateReturning Nothing) = pure []+runUpdateReturningList (SqliteUpdateReturning (Just syntax)) =+  runReturningList $ SqliteCommandSyntax syntax++-- | SQLite @UPDATE ... RETURNING@ statement support. The last+-- argument takes the updated row and returns the values to be returned.+--+-- Use 'runUpdateReturningList' to get the results.+updateReturning :: forall a table db. Projectible Sqlite a+                => DatabaseEntity Sqlite db (TableEntity table)+                      -- ^ table to update+                -> (forall s. table (QField s) -> QAssignment Sqlite s)+                      -- ^ assignment for the update+                -> (forall s. table (QExpr Sqlite s) -> QExpr Sqlite s Bool)+                      -- ^ predicate selecting rows to update+                -> (table (QExpr Sqlite Void) -> a)+                      -- ^ projection describing what to return+                -> SqliteUpdateReturning (QExprToIdentity a)+updateReturning table@(DatabaseEntity (DatabaseTable { dbTableSettings = tblSettings }))+                mkAssignments+                mkWhere+                mkProjection =+  SqliteUpdateReturning $+    case update table mkAssignments mkWhere of+      SqlIdentityUpdate -> Nothing+      SqlUpdate _ sqliteUpdate ->+        Just $ fromSqliteUpdate sqliteUpdate+          <> emit " RETURNING "+          <> commas (map fromSqliteExpression (project (Proxy @Sqlite) (mkProjection tblQ) "t"))+  where+    tblQ = changeBeamRep getFieldName tblSettings+    getFieldName (Columnar' fd) =+      Columnar' $ QExpr $ pure $ fieldE (unqualifiedField (_fieldName fd))

@@ -133,7 +133,7 @@ -- | Convert the first argument of 'SQLiteSyntax' to a 'ByteString' 'Builder', -- where all the data has been replaced by @"?"@ placeholders. withPlaceholders :: ((SQLData -> Builder) -> Builder) -> Builder-withPlaceholders build = build (\_ -> "?")+withPlaceholders build = build (const "?")  -- | Embed a 'ByteString' directly in the syntax emit :: ByteString -> SqliteSyntax

@@ -1,5 +1,5 @@ name:                beam-sqlite-version:             0.5.5.0+version:             0.5.6.0 synopsis:            Beam driver for SQLite description:         Beam driver for the <https://sqlite.org/ SQLite> embedded database.                      See <https://haskell-beam.github.io/beam/user-guide/backends/beam-sqlite/ here>@@ -14,7 +14,7 @@ build-type:          Simple extra-source-files:  README.md extra-doc-files:     ChangeLog.md-bug-reports:          https://github.com/haskell-beam/beam/issues+bug-reports:         https://github.com/haskell-beam/beam/issues cabal-version:       1.18  library@@ -29,6 +29,7 @@                       beam-migrate  >=0.5.3.2  && <0.6,                        sqlite-simple >=0.4  && <0.5,+                      containers    >=0.6  && <0.9,                       text          >=1.0  && <2.2,                       bytestring    >=0.10 && <0.13,                       hashable      >=1.2  && <1.6,@@ -76,6 +77,7 @@     Database.Beam.Sqlite.Test.Insert     Database.Beam.Sqlite.Test.InsertOnConflictReturning     Database.Beam.Sqlite.Test.Migrate+    Database.Beam.Sqlite.Test.Returning     Database.Beam.Sqlite.Test.Select   default-language: Haskell2010   default-extensions:

@@ -18,6 +18,7 @@   [ testInsertReturningColumnOrder   , testInsertOnlyDefaults   , expectFail testUpsertOnlyDefaults+  , testInsertSomeDefaults   ]  data TestTableT f@@ -67,7 +68,7 @@                    , TestTable 1 "sally" "apple" 33 dateJoined oneUtcTime                    , TestTable 4 "blah" "blah" (-1) dateJoined now ] -    assertEqual "insert values" inserted expected+    assertEqual "insert values" expected inserted  data WithDefaultsT f = WithDefaults   { _id :: C f (SqlSerial Int32)@@ -99,10 +100,11 @@         [ WithDefaults default_ default_         , WithDefaults default_ $ val_ "other"         ]-    assertEqual "inserted values" inserted+    assertEqual "inserted values"       [ WithDefaults 1 "unknown"       , WithDefaults 2 "other"       ]+      inserted  testUpsertOnlyDefaults :: TestTree testUpsertOnlyDefaults = testCase "upsert only default values" $@@ -117,7 +119,55 @@         )         anyConflict         onConflictDoNothing-    assertEqual "inserted values" inserted+    assertEqual "inserted values"       [ WithDefaults 1 "unknown"       , WithDefaults 2 "other"       ]+      inserted+++data MixTableT f+  = MixTable+  { mtId :: C f (SqlSerial Int32)+  , mtField1 :: C f Int32+  , mtField2 :: C f Int32+  , mtField3 :: C f Int32+  } deriving (Generic, Beamable)++deriving instance Show (MixTableT Identity)+deriving instance Eq (MixTableT Identity)++instance Table MixTableT where+  data PrimaryKey MixTableT f = MixTableKey (C f (SqlSerial Int32))+    deriving (Generic, Beamable)+  primaryKey (MixTable { mtId = i }) = MixTableKey i++data MixTableDb entity+  = MixTableDb+  { dbMixTable :: entity (TableEntity MixTableT)+  } deriving (Generic, Database Sqlite)++mixDatabase :: DatabaseSettings be MixTableDb+mixDatabase = defaultDbSettings++-- | Test grouping logic for queries containing different DEFAULT column layouts.+testInsertSomeDefaults :: TestTree+testInsertSomeDefaults = testCase "insert mix of default values" $ do+  withTestDb $ \conn -> do+    execute_ conn "CREATE TABLE mix_table ( id INTEGER PRIMARY KEY AUTOINCREMENT, field1 INT DEFAULT 11, field2 INT DEFAULT 22, field3 INT DEFAULT 33)"+    inserted <-+      runBeamSqlite conn $ runInsertReturningList $+      insert (dbMixTable mixDatabase) $+      insertExpressions [ MixTable default_ default_ 1001     10001+                        , MixTable 202      2        default_ default_+                        , MixTable 303      3        default_ default_+                        , MixTable default_ default_ 4004     40004+                        ]++    let expected = [ MixTable 1   11 1001 10001+                   , MixTable 202 2  22   33+                   , MixTable 303 3  22   33+                   , MixTable 304 11 4004 40004+                   ]++    assertEqual "insert values" expected inserted

@@ -0,0 +1,178 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Beam.Sqlite.Test.Returning (tests) where++import Data.Int (Int32)+import Data.Text (Text)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))++import Database.Beam+import Database.Beam.Backend.SQL.BeamExtensions+  (conflictingFields, onConflictUpdateSet, onConflictUpdateSetWhere)+import Database.Beam.Migrate (defaultMigratableDbSettings)+import Database.Beam.Migrate.Simple (CheckedDatabaseSettings, autoMigrate)+import Database.Beam.Sqlite (Sqlite, runBeamSqlite, insertOnConflictReturning)+import Database.Beam.Sqlite.Migrate (migrationBackend)++import Database.Beam.Sqlite+    ( deleteReturning+    , insertReturning+    , runDeleteReturningList+    , runInsertReturningList+    , runUpdateReturningList+    , updateReturning+    )++import Database.Beam.Sqlite.Test (withTestDb)+++tests :: TestTree+tests =+    testGroup+        "SQLite RETURNING statement tests"+        [ testInsertOnConflictReturning+        , testUpdateReturning+        , testDeleteReturning+        ]++-- | Database Schema Definition+data TestDb f+    = TestDb+    { usersTable :: f (TableEntity User)+    }+    deriving stock (Generic)++deriving anyclass instance Database be TestDb++testDb :: DatabaseSettings be TestDb+testDb = defaultDbSettings++checkedDb :: CheckedDatabaseSettings Sqlite TestDb+checkedDb = defaultMigratableDbSettings++data User f+    = User+    { userId    :: !( Columnar f Int32 )+    , userName  :: !( Columnar f Text  )+    , userInfo1 :: !( Columnar f Text  )+    , userInfo2 :: !( Columnar f Int32 )+    }+    deriving stock (Generic)+deriving stock instance (Eq (Columnar f Int32), Eq (Columnar f Text)) => Eq (User f)+deriving stock instance (Show (Columnar f Int32), Show (Columnar f Text)) => Show (User f)++instance Table User where+    newtype PrimaryKey User f = UserId (Columnar f Int32)+        deriving stock (Generic)+    primaryKey = UserId . userId++deriving anyclass instance Beamable User+deriving anyclass instance Beamable (PrimaryKey User)++-- | Test @INSERT .. ON CONFLICT .. RETURNING@+testInsertOnConflictReturning :: TestTree+testInsertOnConflictReturning = testCase "INSERT .. ON CONFLICT .. RETURNING" $+  withTestDb $ \conn -> do+    results <-+      runBeamSqlite conn $ do+        autoMigrate migrationBackend checkedDb++        -- Seed data+        runInsert $+          insert+            (usersTable testDb)+            $ insertValues+              [ User {userId = 1, userName = "initial_user1", userInfo1 = "user1Info", userInfo2 = 11 }+              , User {userId = 3, userName = "initial_user3", userInfo1 = "user3Info", userInfo2 = 33 }+              , User {userId = 4, userName = "initial_user4", userInfo1 = "user4Info", userInfo2 = 44 }+              ]++        let+          newUsers =+            [ User {userId = 1, userName = "upserted_user1", userInfo1 = "user1Info2", userInfo2 = 111 }+            , User {userId = 2, userName = "new_user2"     , userInfo1 = "info1"     , userInfo2 = 222 }+            , User {userId = 3, userName = "upserted_user3", userInfo1 = "info1b"    , userInfo2 = 333 }+            , User {userId = 4, userName = "not_upserted_4", userInfo1 = "ignore"    , userInfo2 = 444 }+            ]++        -- Run 'INSERT .. ON CONFLICT (id) DO UPDATE SET .. WHERE .. RETURNING ..'+        runInsertReturningList $+          insertOnConflictReturning+            (usersTable testDb)+            (insertValues newUsers)+            (conflictingFields userId)+            (onConflictUpdateSetWhere+              ( \(User{userName = fld}) (User{userName = excl}) ->+                  fld <-. excl+              )+              ( \(User{userName = fld}) (User{userName = excl, userInfo1 = exclInfo1 }) ->+                  (current_ fld /=. excl) &&. (exclInfo1 /=. "ignore")+              )+            )+            (\u -> (userId u, userName u, userInfo2 u))++    results @?=+      [ (1, "upserted_user1",  11)+      , (2, "new_user2"     , 222)+      , (3, "upserted_user3",  33)+      ]++-- | Test @UPDATE ... RETURNING@+testUpdateReturning :: TestTree+testUpdateReturning = testCase "UPDATE .. RETURNING" $+  withTestDb $ \conn -> do+    updatedUsers <-+      runBeamSqlite conn $ do+        autoMigrate migrationBackend checkedDb++        -- Seed data+        runInsert $+          insert (usersTable testDb) $+            insertValues+              [ User {userId = 1, userName = "user1", userInfo1 = "user1Info1", userInfo2 = 11 }+              , User {userId = 2, userName = "user2", userInfo1 = "user2Info1", userInfo2 = 22 }+              , User {userId = 3, userName = "user3", userInfo1 = "user3Info1", userInfo2 = 33 }+              ]++        -- Update user 2 and return projected columns from the updated row+        runUpdateReturningList $+          updateReturning+            (usersTable testDb)+            (\u -> userName u <-. val_ "updated_user2")+            (\u -> userId u ==. val_ 2)+            (\u -> (userId u, userName u, userInfo2 u))++    updatedUsers @?= [(2, "updated_user2", 22)]++-- | Test @DELETE .. RETURNING@+testDeleteReturning :: TestTree+testDeleteReturning = testCase "DELETE .. RETURNING" $+  withTestDb $ \conn -> do+    deletedUsers <-+      runBeamSqlite conn $ do+        autoMigrate migrationBackend checkedDb++        -- Seed data+        runInsert $+          insert (usersTable testDb) $+            insertValues+              [ User { userId = 1, userName = "user1", userInfo1 = "user1Info1", userInfo2 = 11 }+              , User { userId = 2, userName = "user2", userInfo1 = "user2Info1", userInfo2 = 22 }+              , User { userId = 3, userName = "user3", userInfo1 = "user3Info1", userInfo2 = 33 }+              ]++        -- Delete user 3 and return projected columns from the deleted row+        runDeleteReturningList $+          deleteReturning+            (usersTable testDb)+            (\u -> userId u ==. val_ 3)+            (\u -> (userName u, userInfo2 u))++    deletedUsers @?= [("user3", 33)]

@@ -6,6 +6,7 @@ import qualified Database.Beam.Sqlite.Test.Insert as Insert import qualified Database.Beam.Sqlite.Test.InsertOnConflictReturning as InsertOnConflictReturning import qualified Database.Beam.Sqlite.Test.Select as Select+import qualified Database.Beam.Sqlite.Test.Returning as Returning  main :: IO () main = defaultMain $ testGroup "beam-sqlite tests"@@ -13,4 +14,5 @@       , Select.tests       , Insert.tests       , InsertOnConflictReturning.tests+      , Returning.tests       ]