From 07d9730dc4808202e4a54829e896d49cecf95069 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Fri, 27 Sep 2019 11:02:10 -0500 Subject: [PATCH 1/7] add EsqueletoUpsert class and SqlBackend instance --- esqueleto.cabal | 1 + src/Database/Esqueleto.hs | 1 + src/Database/Esqueleto/Internal/Internal.hs | 87 +++++++++++++++++++ .../Esqueleto/Internal/PersistentImport.hs | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 1 + 5 files changed, 91 insertions(+), 1 deletion(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index b89ad99..965b082 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -49,6 +49,7 @@ library , bytestring , conduit >=1.3 , monad-logger + , mtl , persistent >=2.10.0 && <2.11 , resourcet >=1.2 , tagged >=0.2 diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index d082191..773fec1 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -100,6 +100,7 @@ module Database.Esqueleto -- * Helpers , valkey , valJ + , EsqueletoUpsert(..) -- * Re-exports -- $reexports diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index c464807..8db442f 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -56,6 +56,9 @@ import qualified Data.Text.Lazy.Builder as TLB import Data.Typeable (Typeable) import Text.Blaze.Html (Html) +import Database.Persist.Class (OnlyOneUniqueKey) +import Control.Monad.Reader (ReaderT) +import Data.List.NonEmpty( NonEmpty( (:|) ) ) -- | (Internal) Start a 'from' query with an entity. 'from' -- does two kinds of magic using 'fromStart', 'fromJoin' and @@ -2883,3 +2886,87 @@ insertSelect = void . insertSelectCount insertSelectCount :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64 insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal + +-- | A class for allowing the use of upsert operation using +-- esqueleto's types. +class (PersistUniqueWrite backend, + PersistQueryWrite backend, + IsPersistBackend (BaseBackend backend), + BackendCompatible SqlBackend backend, + BackendCompatible SqlBackend (BaseBackend backend)) => + EsqueletoUpsert backend where + upsert + :: (MonadIO m, PersistRecordBackend record backend, OnlyOneUniqueKey record) + => record + -- ^ new record to insert + -> [SqlExpr (Update record)] + -- ^ updates to perform if the record already exists + -> ReaderT backend m (Entity record) + -- ^ the record in the database after the operation + upsert record updates = do + uniqueKey <- onlyUnique record + upsertBy uniqueKey record updates + + upsertBy :: (MonadIO m, PersistRecordBackend record backend) + => Unique record + -- ^ uniqueness constraint to find by + -> record + -- ^ new record to insert + -> [SqlExpr (Update record)] + -- ^ updates to perform if the record already exists + -> ReaderT backend m (Entity record) + -- ^ the record in the database after the operation + upsertBy = defaultUpsert + +defaultUpsert + :: (MonadIO m, PersistRecordBackend record backend, + PersistQueryWrite backend, + PersistUniqueWrite backend, + IsPersistBackend (BaseBackend backend), + BackendCompatible SqlBackend backend, + BackendCompatible SqlBackend (BaseBackend backend)) + => Unique record + -> record + -> [SqlExpr (Update record)] + -> ReaderT backend m (Entity record) +defaultUpsert uniqueKey record updates = do + mrecord <- getBy uniqueKey + maybe (insertEntity record) updateGetEntity mrecord + where + updateGetEntity (Entity k _) = fmap head $ do + update $ \r -> do + set r updates + where_ (r ^. persistIdField ==. val k) + select $ from $ \r -> do + where_ (r ^. persistIdField ==. val k) + return r + +-- Currently only postgres implements connUpsertSql, check that '?' are +-- added in the same order as postgres when adding connUpsertSql to another +-- backend. +instance EsqueletoUpsert SqlBackend where + upsertBy uniqueKey record updates = do + sqlB <- R.ask + maybe + (defaultUpsert uniqueKey record updates) + (handler sqlB) + (connUpsertSql sqlB) + where + addVals l = map toPersistValue (toPersistFields record) ++ l ++ persistUniqueToValues uniqueKey + entDef = entityDef (Just record) + uDef = head $ filter ((==) (persistUniqueToFieldNames uniqueKey) . uniqueFields) $ entityUniques entDef + updatesText conn = first builderToText $ renderUpdates conn updates + handler conn f = fmap head $ uncurry rawSql $ + (***) (f entDef (uDef :| [])) addVals $ updatesText conn + +-- | Renders a [SqlExpr (Update val)] into a (TLB.Builder, [PersistValue]) with a given backend. +renderUpdates :: BackendCompatible SqlBackend backend => + backend + -> [SqlExpr (Update val)] + -> (TLB.Builder, [PersistValue]) +renderUpdates conn = uncommas' . concatMap renderUpdate + where + mk (ERaw _ f) = [f info] + mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME + renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused + info = (projectBackend conn, initialIdentState) \ No newline at end of file diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index 55e460b..43725b0 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -147,4 +147,4 @@ import Database.Persist.Sql hiding , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.) , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.) , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource - , update , count ) + , update , count , upsertBy, upsert) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 7818624..e50e6e4 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -71,6 +71,7 @@ module Database.Esqueleto.Internal.Sql , parens , toArgList , builderToText + , EsqueletoUpsert(..) ) where import Database.Esqueleto.Internal.Internal From 6acb8f07328c5be0bedf7ad7764f74b6e7450dc5 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Mon, 30 Sep 2019 14:10:41 -0500 Subject: [PATCH 2/7] add unique postgres tests --- test/Common/Test.hs | 31 +++++++++++++++++++++++++++++-- test/PostgreSQL/Test.hs | 20 +++++++++++++++++++- 2 files changed, 48 insertions(+), 3 deletions(-) diff --git a/test/Common/Test.hs b/test/Common/Test.hs index a5450fb..9c6d367 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -25,11 +25,14 @@ module Common.Test , testAscRandom , testRandomMath , migrateAll + , migrateUnique , cleanDB + , cleanUniques , RunDbMonad , Run , p1, p2, p3, p4, p5 , l1, l2, l3 + , u1, u2, u3, u4 , insert' , EntityField (..) , Foo (..) @@ -48,6 +51,7 @@ module Common.Test , Point (..) , Circle (..) , Numbers (..) + , OneUnique(..) ) where import Control.Monad (forM_, replicateM, replicateM_, void) @@ -157,8 +161,14 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| double Double |] - - +-- Unique Test schema +share [mkPersist sqlSettings, mkMigrate "migrateUnique"] [persistUpperCase| + OneUnique + name String + value Int + UniqueValue value + deriving Eq Show +|] -- | this could be achieved with S.fromList, but not all lists -- have Ord instances @@ -196,7 +206,17 @@ l2 = Lord "Dorset" Nothing l3 :: Lord l3 = Lord "Chester" (Just 17) +u1 :: OneUnique +u1 = OneUnique "First" 0 +u2 :: OneUnique +u2 = OneUnique "Second" 1 + +u3 :: OneUnique +u3 = OneUnique "Third" 0 + +u4 :: OneUnique +u4 = OneUnique "First" 2 testSelect :: Run -> Spec testSelect run = do @@ -1536,3 +1556,10 @@ cleanDB = do delete $ from $ \(_ :: SqlExpr (Entity Point)) -> return () delete $ from $ \(_ :: SqlExpr (Entity Numbers)) -> return () + + +cleanUniques + :: (forall m. RunDbMonad m + => SqlPersistT (R.ResourceT m) ()) +cleanUniques = + delete $ from $ \(_ :: SqlExpr (Entity OneUnique)) -> return () \ No newline at end of file diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index 8f2c4a2..316e058 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -11,6 +11,7 @@ module Main (main) where import Control.Arrow ((&&&)) +import Control.Exception (evaluate) import Control.Monad (void, when) import Control.Monad.Catch (MonadCatch, catch) import Control.Monad.IO.Class (MonadIO(liftIO)) @@ -33,7 +34,7 @@ import qualified Database.Esqueleto.PostgreSQL as EP import Database.Esqueleto.PostgreSQL.JSON hiding ((?.), (-.), (||.)) import qualified Database.Esqueleto.PostgreSQL.JSON as JSON import Database.Persist.Postgresql (withPostgresqlConn) -import Database.PostgreSQL.Simple (SqlError(..)) +import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..)) import System.Environment import Test.Hspec @@ -949,6 +950,20 @@ testHashMinusOperator = where_ $ v @>. jsonbVal (object []) where_ $ f v +testInsertUniqueViolation :: Spec +testInsertUniqueViolation = + describe "Unique Violation on Insert" $ + it "Unique throws exception" $ run (do + u1k <- insert u1 + u2k <- insert u2 + insert u3) `shouldThrow` (==) exception + where + exception = SqlError { + sqlState = "23505", + sqlExecStatus = FatalError, + sqlErrorMsg = "duplicate key value violates unique constraint \"UniqueValue\"", + sqlErrorDetail = "Key (value)=(0) already exists.", + sqlErrorHint = ""} type JSONValue = Maybe (JSONB A.Value) @@ -1021,6 +1036,7 @@ main = do testPostgresqlUpdate testPostgresqlCoalesce testPostgresqlTextFunctions + testInsertUniqueViolation describe "PostgreSQL JSON tests" $ do -- NOTE: We only clean the table once, so we -- can use its contents across all JSON tests @@ -1053,7 +1069,9 @@ run_worker act = withConn $ runSqlConn (migrateIt >> act) migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) () migrateIt = do void $ runMigrationSilent migrateAll + void $ runMigrationSilent migrateUnique cleanDB + cleanUniques withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a withConn = From 3ebb31af58b1748543146c92aedfe3146d8c20c9 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Mon, 30 Sep 2019 14:11:39 -0500 Subject: [PATCH 3/7] made upsert and upsertby postgres specific --- src/Database/Esqueleto.hs | 1 - src/Database/Esqueleto/Internal/Internal.hs | 90 +------------------ .../Esqueleto/Internal/PersistentImport.hs | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 1 - src/Database/Esqueleto/PostgreSQL.hs | 62 ++++++++++++- 5 files changed, 64 insertions(+), 92 deletions(-) diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index 773fec1..d082191 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -100,7 +100,6 @@ module Database.Esqueleto -- * Helpers , valkey , valJ - , EsqueletoUpsert(..) -- * Re-exports -- $reexports diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 8db442f..88ce078 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -56,9 +56,6 @@ import qualified Data.Text.Lazy.Builder as TLB import Data.Typeable (Typeable) import Text.Blaze.Html (Html) -import Database.Persist.Class (OnlyOneUniqueKey) -import Control.Monad.Reader (ReaderT) -import Data.List.NonEmpty( NonEmpty( (:|) ) ) -- | (Internal) Start a 'from' query with an entity. 'from' -- does two kinds of magic using 'fromStart', 'fromJoin' and @@ -1266,6 +1263,7 @@ data UnexpectedCaseError = | InsertionFinalError | NewIdentForError | UnsafeSqlCaseError + | OperationNotSupported deriving (Show) data SqlBinOpCompositeError = @@ -2885,88 +2883,4 @@ insertSelect = void . insertSelectCount -- | Insert a 'PersistField' for every selected value, return the count afterward insertSelectCount :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64 -insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal - --- | A class for allowing the use of upsert operation using --- esqueleto's types. -class (PersistUniqueWrite backend, - PersistQueryWrite backend, - IsPersistBackend (BaseBackend backend), - BackendCompatible SqlBackend backend, - BackendCompatible SqlBackend (BaseBackend backend)) => - EsqueletoUpsert backend where - upsert - :: (MonadIO m, PersistRecordBackend record backend, OnlyOneUniqueKey record) - => record - -- ^ new record to insert - -> [SqlExpr (Update record)] - -- ^ updates to perform if the record already exists - -> ReaderT backend m (Entity record) - -- ^ the record in the database after the operation - upsert record updates = do - uniqueKey <- onlyUnique record - upsertBy uniqueKey record updates - - upsertBy :: (MonadIO m, PersistRecordBackend record backend) - => Unique record - -- ^ uniqueness constraint to find by - -> record - -- ^ new record to insert - -> [SqlExpr (Update record)] - -- ^ updates to perform if the record already exists - -> ReaderT backend m (Entity record) - -- ^ the record in the database after the operation - upsertBy = defaultUpsert - -defaultUpsert - :: (MonadIO m, PersistRecordBackend record backend, - PersistQueryWrite backend, - PersistUniqueWrite backend, - IsPersistBackend (BaseBackend backend), - BackendCompatible SqlBackend backend, - BackendCompatible SqlBackend (BaseBackend backend)) - => Unique record - -> record - -> [SqlExpr (Update record)] - -> ReaderT backend m (Entity record) -defaultUpsert uniqueKey record updates = do - mrecord <- getBy uniqueKey - maybe (insertEntity record) updateGetEntity mrecord - where - updateGetEntity (Entity k _) = fmap head $ do - update $ \r -> do - set r updates - where_ (r ^. persistIdField ==. val k) - select $ from $ \r -> do - where_ (r ^. persistIdField ==. val k) - return r - --- Currently only postgres implements connUpsertSql, check that '?' are --- added in the same order as postgres when adding connUpsertSql to another --- backend. -instance EsqueletoUpsert SqlBackend where - upsertBy uniqueKey record updates = do - sqlB <- R.ask - maybe - (defaultUpsert uniqueKey record updates) - (handler sqlB) - (connUpsertSql sqlB) - where - addVals l = map toPersistValue (toPersistFields record) ++ l ++ persistUniqueToValues uniqueKey - entDef = entityDef (Just record) - uDef = head $ filter ((==) (persistUniqueToFieldNames uniqueKey) . uniqueFields) $ entityUniques entDef - updatesText conn = first builderToText $ renderUpdates conn updates - handler conn f = fmap head $ uncurry rawSql $ - (***) (f entDef (uDef :| [])) addVals $ updatesText conn - --- | Renders a [SqlExpr (Update val)] into a (TLB.Builder, [PersistValue]) with a given backend. -renderUpdates :: BackendCompatible SqlBackend backend => - backend - -> [SqlExpr (Update val)] - -> (TLB.Builder, [PersistValue]) -renderUpdates conn = uncommas' . concatMap renderUpdate - where - mk (ERaw _ f) = [f info] - mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME - renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused - info = (projectBackend conn, initialIdentState) \ No newline at end of file +insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal \ No newline at end of file diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index 43725b0..638d538 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -147,4 +147,4 @@ import Database.Persist.Sql hiding , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.) , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.) , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource - , update , count , upsertBy, upsert) + , update , count) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index e50e6e4..7818624 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -71,7 +71,6 @@ module Database.Esqueleto.Internal.Sql , parens , toArgList , builderToText - , EsqueletoUpsert(..) ) where import Database.Esqueleto.Internal.Internal diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index b89cac7..f9254dd 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -18,6 +18,8 @@ module Database.Esqueleto.PostgreSQL , chr , now_ , random_ + , upsert + , upsertBy -- * Internal , unsafeSqlAggregateFunction ) where @@ -28,8 +30,17 @@ import Data.Semigroup import qualified Data.Text.Internal.Builder as TLB import Data.Time.Clock (UTCTime) import Database.Esqueleto.Internal.Language hiding (random_) -import Database.Esqueleto.Internal.PersistentImport +import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy) import Database.Esqueleto.Internal.Sql +import Database.Esqueleto.Internal.Internal (EsqueletoError(..), CompositeKeyError(..), + UnexpectedCaseError(..)) +import Database.Persist.Class (OnlyOneUniqueKey) +import Data.List.NonEmpty ( NonEmpty( (:|) ) ) +import Control.Arrow ((***), first) +import Control.Exception (Exception, throw, throwIO) +import Control.Monad.IO.Class (MonadIO (..)) +import qualified Control.Monad.Trans.Reader as R + -- | (@random()@) Split out into database specific modules -- because MySQL uses `rand()`. @@ -152,3 +163,52 @@ chr = unsafeSqlFunction "chr" now_ :: SqlExpr (Value UTCTime) now_ = unsafeSqlValue "NOW()" + +upsert :: (MonadIO m, + PersistEntity record, + OnlyOneUniqueKey record, + PersistRecordBackend record SqlBackend, + IsPersistBackend (PersistEntityBackend record)) + => record + -- ^ new record to insert + -> [SqlExpr (Update record)] + -- ^ updates to perform if the record already exists + -> R.ReaderT SqlBackend m (Entity record) + -- ^ the record in the database after the operation +upsert record updates = do + uniqueKey <- onlyUnique record + upsertBy uniqueKey record updates + +upsertBy :: (MonadIO m, + PersistEntity record, + IsPersistBackend (PersistEntityBackend record)) + => Unique record + -- ^ uniqueness constraint to find by + -> record + -- ^ new record to insert + -> [SqlExpr (Update record)] + -- ^ updates to perform if the record already exists + -> R.ReaderT SqlBackend m (Entity record) + -- ^ the record in the database after the operation +upsertBy uniqueKey record updates = do + sqlB <- R.ask + maybe + (throw (UnexpectedCaseErr OperationNotSupported)) -- Postgres backend should have connUpsertSql, if this error is thrown, check changes on persistent + (handler sqlB) + (connUpsertSql sqlB) + where + addVals l = map toPersistValue (toPersistFields record) ++ l ++ persistUniqueToValues uniqueKey + entDef = entityDef (Just record) + uDef = head $ filter ((==) (persistUniqueToFieldNames uniqueKey) . uniqueFields) $ entityUniques entDef + updatesText conn = first builderToText $ renderUpdates conn updates + handler conn f = fmap head $ uncurry rawSql $ + (***) (f entDef (uDef :| [])) addVals $ updatesText conn + renderUpdates :: SqlBackend + -> [SqlExpr (Update val)] + -> (TLB.Builder, [PersistValue]) + renderUpdates conn = uncommas' . concatMap renderUpdate + where + mk (ERaw _ f) = [f info] + mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME + renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused + info = (projectBackend conn, initialIdentState) \ No newline at end of file From ba650748f0a6cb9a38ebd0caf8f01d0e83d193b1 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Mon, 30 Sep 2019 15:12:15 -0500 Subject: [PATCH 4/7] add upsert postgres test --- test/PostgreSQL/Test.hs | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) diff --git a/test/PostgreSQL/Test.hs b/test/PostgreSQL/Test.hs index 316e058..407cb41 100644 --- a/test/PostgreSQL/Test.hs +++ b/test/PostgreSQL/Test.hs @@ -11,7 +11,6 @@ module Main (main) where import Control.Arrow ((&&&)) -import Control.Exception (evaluate) import Control.Monad (void, when) import Control.Monad.Catch (MonadCatch, catch) import Control.Monad.IO.Class (MonadIO(liftIO)) @@ -954,8 +953,8 @@ testInsertUniqueViolation :: Spec testInsertUniqueViolation = describe "Unique Violation on Insert" $ it "Unique throws exception" $ run (do - u1k <- insert u1 - u2k <- insert u2 + _ <- insert u1 + _ <- insert u2 insert u3) `shouldThrow` (==) exception where exception = SqlError { @@ -965,6 +964,20 @@ testInsertUniqueViolation = sqlErrorDetail = "Key (value)=(0) already exists.", sqlErrorHint = ""} +testUpsert :: Spec +testUpsert = + describe "Upsert test" $ do + it "Upsert can insert like normal" $ run $ do + u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"] + liftIO $ entityVal u1e `shouldBe` u1 + it "Upsert performs update on collision" $ run $ 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"} + type JSONValue = Maybe (JSONB A.Value) createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO () @@ -1037,6 +1050,7 @@ main = do testPostgresqlCoalesce testPostgresqlTextFunctions testInsertUniqueViolation + testUpsert describe "PostgreSQL JSON tests" $ do -- NOTE: We only clean the table once, so we -- can use its contents across all JSON tests From ced45b0c4eec332077f4ce8c6c34a9e2337a9770 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Mon, 30 Sep 2019 15:19:20 -0500 Subject: [PATCH 5/7] style fix --- esqueleto.cabal | 1 - src/Database/Esqueleto/Internal/Internal.hs | 2 +- src/Database/Esqueleto/Internal/PersistentImport.hs | 2 +- 3 files changed, 2 insertions(+), 3 deletions(-) diff --git a/esqueleto.cabal b/esqueleto.cabal index 965b082..b89ad99 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -49,7 +49,6 @@ library , bytestring , conduit >=1.3 , monad-logger - , mtl , persistent >=2.10.0 && <2.11 , resourcet >=1.2 , tagged >=0.2 diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 88ce078..d6d165b 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -2883,4 +2883,4 @@ insertSelect = void . insertSelectCount -- | Insert a 'PersistField' for every selected value, return the count afterward insertSelectCount :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m Int64 -insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal \ No newline at end of file +insertSelectCount = rawEsqueleto INSERT_INTO . fmap EInsertFinal diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index 638d538..55e460b 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -147,4 +147,4 @@ import Database.Persist.Sql hiding , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.) , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.) , listToJSON, mapToJSON, getPersistMap, limitOffsetOrder, selectSource - , update , count) + , update , count ) From 5ff34fc8f848217fb975b4d152486149dd9b3f09 Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Wed, 9 Oct 2019 21:04:14 -0500 Subject: [PATCH 6/7] fix build on 8.4 and 8.2 --- src/Database/Esqueleto/PostgreSQL.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Database/Esqueleto/PostgreSQL.hs b/src/Database/Esqueleto/PostgreSQL.hs index f9254dd..cbbf788 100644 --- a/src/Database/Esqueleto/PostgreSQL.hs +++ b/src/Database/Esqueleto/PostgreSQL.hs @@ -33,7 +33,7 @@ import Database.Esqueleto.Internal.Language hiding (random_) import Database.Esqueleto.Internal.PersistentImport hiding (upsert, upsertBy) import Database.Esqueleto.Internal.Sql import Database.Esqueleto.Internal.Internal (EsqueletoError(..), CompositeKeyError(..), - UnexpectedCaseError(..)) + UnexpectedCaseError(..), SetClause) import Database.Persist.Class (OnlyOneUniqueKey) import Data.List.NonEmpty ( NonEmpty( (:|) ) ) import Control.Arrow ((***), first) @@ -208,7 +208,9 @@ upsertBy uniqueKey record updates = do -> (TLB.Builder, [PersistValue]) renderUpdates conn = uncommas' . concatMap renderUpdate where + mk :: SqlExpr (Value ()) -> [(TLB.Builder, [PersistValue])] mk (ERaw _ f) = [f info] mk (ECompositeKey _) = throw (CompositeKeyErr MakeSetError) -- FIXME + renderUpdate :: SqlExpr (Update val) -> [(TLB.Builder, [PersistValue])] renderUpdate (ESet f) = mk (f undefined) -- second parameter of f is always unused info = (projectBackend conn, initialIdentState) \ No newline at end of file From 9512cbe270aa406b9dac2c01b11a6e8ad0020c3a Mon Sep 17 00:00:00 2001 From: Jose Duran Date: Thu, 10 Oct 2019 09:23:24 -0500 Subject: [PATCH 7/7] add changelog entry --- changelog.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/changelog.md b/changelog.md index 1eec4fa..d0b74ad 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,9 @@ Unreleased (3.1.1) ======== +- @JoseD92 + - [#149](https://github.com/bitemyapp/esqueleto/pull/149): Added `upsert` support. + - @parsonsmatt - [#133](https://github.com/bitemyapp/esqueleto/pull/133): Added `renderQueryToText` and related functions.