Support upsert with empty updates

Makefile

@@ -33,8 +33,6 @@ test-ghcid-build:
 		--restart "stack.yaml" \
 		--restart "esqueleto.cabal"
 
-
-
 init-pgsql:
 	sudo -u postgres -- createuser -s esqutest
 

changelog.md

@@ -1,10 +1,18 @@
+3.5.3.1
+=======
+- @parsonsmatt
+    - [#301](https://github.com/bitemyapp/esqueleto/pull/301)
+        - Fix `upsert` and `upsertBy` to produce `INSERT ... ON CONFLICT DO
+          NOTHING` code when given an empty list.
+
+
 3.5.3.0
 =======
 - @m4dc4p
   - [#291](https://github.com/bitemyapp/esqueleto/pull/291)
          - Added `ToAlias` and `ToAliasReference` instaces to the `:&` type, mirroring
          the tuple instances for the same classes. See [Issue #290](https://github.com/bitemyapp/esqueleto/issues/290)
-         for discussion.       
+         for discussion.
 - @NikitaRazmakhnin
   - [#284](https://github.com/bitemyapp/esqueleto/pull/284)
         - Add PostgreSQL-specific support of VALUES(..) literals

esqueleto.cabal

@@ -1,7 +1,7 @@
 cabal-version: 1.12
 
 name:           esqueleto
-version:        3.5.3.0
+version:        3.5.3.1
 synopsis:       Type-safe EDSL for SQL queries on persistent backends.
 description:    @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends.  Its language closely resembles SQL, so you don't have to learn new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime.
                 .

src/Database/Esqueleto/PostgreSQL.hs

@@ -45,15 +45,16 @@ import Data.Int (Int64)
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
 import Data.Proxy (Proxy(..))
+import qualified Data.Text as Text
 import qualified Data.Text.Internal.Builder as TLB
 import qualified Data.Text.Lazy as TL
 import Data.Time.Clock (UTCTime)
 import qualified Database.Esqueleto.Experimental as Ex
 import qualified Database.Esqueleto.Experimental.From as Ex
 import Database.Esqueleto.Internal.Internal hiding (random_)
 import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy)
-import Database.Persist.Class (OnlyOneUniqueKey)
 import Database.Persist (ConstraintNameDB(..), EntityNameDB(..))
+import Database.Persist.Class (OnlyOneUniqueKey)
 import Database.Persist.SqlBackend
 
 -- | (@random()@) Split out into database specific modules
@@ -222,18 +223,40 @@ upsertBy uniqueKey record updates = do
         Just upsertSql ->
             handler sqlB upsertSql
   where
-    addVals l = map toPersistValue (toPersistFields record) ++ l ++ persistUniqueToValues uniqueKey
-    entDef = entityDef (Just record)
-    updatesText conn = first builderToText $ renderUpdates conn updates
+    addVals l =
+        map toPersistValue (toPersistFields record) ++ l ++ case updates of
+            [] ->
+                []
+            _ ->
+                persistUniqueToValues uniqueKey
+    entDef =
+        entityDef (Just record)
+    updatesText conn =
+        first builderToText $ renderUpdates conn updates
 #if MIN_VERSION_persistent(2,11,0)
     uniqueFields = persistUniqueToFieldNames uniqueKey
     handler sqlB upsertSql = do
         let (updateText, updateVals) =
                 updatesText sqlB
-            queryText =
+            queryTextUnmodified =
                 upsertSql entDef uniqueFields updateText
+            queryText =
+                case updates of
+                    [] ->
+                        let
+                            (okay, _bad) =
+                                Text.breakOn "DO UPDATE" queryTextUnmodified
+                            good =
+                                okay <> "DO NOTHING RETURNING ??"
+                        in
+                            good
+                    _ ->
+                        queryTextUnmodified
+
             queryVals =
-                addVals updateVals
+                addVals $ case updates of
+                    [] -> []
+                    _ -> updateVals
         xs <- rawSql queryText queryVals
         pure (head xs)
 #else
@@ -248,10 +271,7 @@ upsertBy uniqueKey record updates = do
 -- Example of usage:
 --
 -- @
--- share [ mkPersist sqlSettings
---       , mkDeleteCascade sqlSettings
---       , mkMigrate "migrate"
---       ] [persistLowerCase|
+-- 'mkPersist' 'sqlSettings' ['persistLowerCase'|
 --   Bar
 --     num Int
 --     deriving Eq Show
@@ -261,17 +281,19 @@ upsertBy uniqueKey record updates = do
 --     deriving Eq Show
 -- |]
 --
--- insertSelectWithConflict
---   UniqueFoo -- (UniqueFoo undefined) or (UniqueFoo anyNumber) would also work
---   (from $ \b ->
---     return $ Foo <# (b ^. BarNum)
---   )
---   (\current excluded ->
---     [FooNum =. (current ^. FooNum) +. (excluded ^. FooNum)]
---   )
+-- action = do
+--     'insertSelectWithConflict'
+--         UniqueFoo -- (UniqueFoo undefined) or (UniqueFoo anyNumber) would also work
+--         (do
+--             b <- from $ table \@Bar
+--             return $ Foo <# (b ^. BarNum)
+--         )
+--         (\\current excluded ->
+--             [FooNum =. (current ^. FooNum) +. (excluded ^. FooNum)]
+--         )
 -- @
 --
--- Inserts to table Foo all Bar.num values and in case of conflict SomeFooUnique,
+-- Inserts to table @Foo@ all @Bar.num@ values and in case of conflict @SomeFooUnique@,
 -- the conflicting value is updated to the current plus the excluded.
 --
 -- @since 3.1.3

test/PostgreSQL/Test.hs

@@ -51,6 +51,34 @@ import Common.Test
 import Common.Test.Import hiding (from, on)
 import PostgreSQL.MigrateJSON
 
+spec :: Spec
+spec = beforeAll mkConnectionPool $ do
+    tests
+
+    describe "PostgreSQL specific tests" $ do
+        testAscRandom random_
+        testRandomMath
+        testSelectDistinctOn
+        testPostgresModule
+        testPostgresqlOneAscOneDesc
+        testPostgresqlTwoAscFields
+        testPostgresqlSum
+        testPostgresqlRandom
+        testPostgresqlUpdate
+        testPostgresqlCoalesce
+        testPostgresqlTextFunctions
+        testInsertUniqueViolation
+        testUpsert
+        testInsertSelectWithConflict
+        testFilterWhere
+        testCommonTableExpressions
+        setDatabaseState insertJsonValues cleanJSON
+            $ describe "PostgreSQL JSON tests" $ do
+                testJSONInsertions
+                testJSONOperators
+        testLateralQuery
+        testValuesExpression
+
 returningType :: forall a m . m a -> m a
 returningType a = a
 
@@ -1038,18 +1066,27 @@ testInsertUniqueViolation =
       sqlErrorHint = ""}
 
 testUpsert :: SpecDb
-testUpsert =
-  describe "Upsert test" $ do
+testUpsert = focus $ describe "Upsert test" $ do
     itDb "Upsert can insert like normal" $  do
-      u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
-      liftIO $ entityVal u1e `shouldBe` u1
+        u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
+        liftIO $ entityVal u1e `shouldBe` u1
     itDb "Upsert performs update on collision" $  do
-      u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
-      liftIO $ entityVal u1e `shouldBe` u1
-      u2e <- EP.upsert u2 [OneUniqueName =. val "fifth"]
-      liftIO $ entityVal u2e `shouldBe` u2
-      u3e <- EP.upsert u3 [OneUniqueName =. val "fifth"]
-      liftIO $ entityVal u3e `shouldBe` u1{oneUniqueName="fifth"}
+        u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
+        liftIO $ entityVal u1e `shouldBe` u1
+        u2e <- EP.upsert u2 [OneUniqueName =. val "fifth"]
+        liftIO $ entityVal u2e `shouldBe` u2
+        u3e <- EP.upsert u3 [OneUniqueName =. val "fifth"]
+        liftIO $ entityVal u3e `shouldBe` u1{oneUniqueName="fifth"}
+    describe "With no updates" $ do
+        itDb "Works with no updates" $ do
+            _ <- EP.upsert u1 []
+            pure ()
+        itDb "Works with no updates, twice" $ do
+            Entity u1Key u1' <- EP.upsert u1 []
+            Entity u1Key_ u1'' <- EP.upsert u1 { oneUniqueName = "Something Else" } []
+            pure ()
+            -- liftIO $ do
+            --     u1 `shouldBe` u1'
 
 testInsertSelectWithConflict :: SpecDb
 testInsertSelectWithConflict =
@@ -1378,39 +1415,6 @@ selectJSON f = select $ from $ \v -> do
     f $ just (v ^. JsonValue)
     return v
 
---------------- JSON --------------- JSON --------------- JSON ---------------
---------------- JSON --------------- JSON --------------- JSON ---------------
---------------- JSON --------------- JSON --------------- JSON ---------------
-
-
-
-spec :: Spec
-spec = beforeAll mkConnectionPool $ do
-    tests
-
-    describe "PostgreSQL specific tests" $ do
-        testAscRandom random_
-        testRandomMath
-        testSelectDistinctOn
-        testPostgresModule
-        testPostgresqlOneAscOneDesc
-        testPostgresqlTwoAscFields
-        testPostgresqlSum
-        testPostgresqlRandom
-        testPostgresqlUpdate
-        testPostgresqlCoalesce
-        testPostgresqlTextFunctions
-        testInsertUniqueViolation
-        testUpsert
-        testInsertSelectWithConflict
-        testFilterWhere
-        testCommonTableExpressions
-        setDatabaseState insertJsonValues cleanJSON
-            $ describe "PostgreSQL JSON tests" $ do
-                testJSONInsertions
-                testJSONOperators
-        testLateralQuery
-        testValuesExpression
 
 insertJsonValues :: SqlPersistT IO ()
 insertJsonValues = do

test/Spec.hs

@@ -19,4 +19,3 @@ spec = do
             sequential $ MySQL.spec
         describe "Postgresql" $ do
             sequential $ Postgres.spec
-