persistent-postgresql 2.8.2.0 → 2.9.0
raw patch · 3 files changed
+55/−27 lines, 3 filesdep ~persistentdep ~postgresql-simple
Dependency ranges changed: persistent, postgresql-simple
Files
- ChangeLog.md +7/−0
- Database/Persist/Postgresql.hs +46/−25
- persistent-postgresql.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,10 @@+# Changelog for persistent-postgresql++## 2.9.0++* Added support for SQL isolation levels to via SqlBackend. [#812]+* Fix [832](https://github.com/yesodweb/persistent/issues/832): `repsertMany` now matches `mapM_ (uncurry repsert)` and is atomic.+ ## 2.8.2 Added module `Database.Persist.Postgres.JSON` [#793](https://github.com/yesodweb/persistent/pull/793)
Database/Persist/Postgresql.hs view
@@ -31,7 +31,7 @@ ) where import Database.Persist.Sql-import Database.Persist.Sql.Util (dbIdColumnsEsc, commaSeparated, parenWrapped)+import qualified Database.Persist.Sql.Util as Util import Database.Persist.Sql.Types.Internal (mkPersistBackend) import Data.Fixed (Pico) @@ -40,6 +40,7 @@ import qualified Database.PostgreSQL.Simple.Internal as PG import qualified Database.PostgreSQL.Simple.ToField as PGTF import qualified Database.PostgreSQL.Simple.FromField as PGFF+import qualified Database.PostgreSQL.Simple.Transaction as PG import qualified Database.PostgreSQL.Simple.Types as PG import Database.PostgreSQL.Simple.Ok (Ok (..)) @@ -239,6 +240,7 @@ serverVersion <- getServerVersion conn return $ createBackend logFunc serverVersion smap conn + -- | Create the backend given a logging function, server version, mutable statement cell, -- and connection. createBackend :: IsSqlBackend backend => LogFunc -> Maybe Double@@ -253,7 +255,13 @@ , connPutManySql = serverVersion >>= upsertFunction putManySql , connClose = PG.close conn , connMigrateSql = migrate'- , connBegin = const $ PG.begin conn+ , connBegin = \_ mIsolation -> case mIsolation of+ Nothing -> PG.begin conn+ Just iso -> PG.beginLevel (case iso of+ ReadUncommitted -> PG.ReadCommitted -- PG Upgrades uncommitted reads to committed anyways+ ReadCommitted -> PG.ReadCommitted+ RepeatableRead -> PG.RepeatableRead+ Serializable -> PG.Serializable) conn , connCommit = const $ PG.commit conn , connRollback = const $ PG.rollback conn , connEscapeName = escape@@ -262,6 +270,7 @@ , connLimitOffset = decorateSQLWithLimitOffset "LIMIT ALL" , connLogFunc = logFunc , connMaxParams = Nothing+ , connRepsertManySql = serverVersion >>= upsertFunction repsertManySql } prepare' :: PG.Connection -> Text -> IO Statement@@ -330,7 +339,7 @@ , ") VALUES (" , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (entityFields ent) , ") RETURNING "- , commaSeparated $ dbIdColumnsEsc escape ent+ , Util.commaSeparated $ Util.dbIdColumnsEsc escape ent ] in ISRSingle sql @@ -862,7 +871,7 @@ refAdd Nothing = [] refAdd (Just (tname, a)) = case find ((==tname) . entityDB) defs of- Just refdef -> [(tname, AddReference a [name] (dbIdColumnsEsc escape refdef))]+ Just refdef -> [(tname, AddReference a [name] (Util.dbIdColumnsEsc escape refdef))] Nothing -> error $ "could not find the entityDef for reftable[" ++ show tname ++ "]" modRef = if fmap snd ref == fmap snd ref'@@ -907,7 +916,7 @@ id_ = fromMaybe (error $ "Could not find ID of entity " ++ show reftable) $ do entDef <- find ((== reftable) . entityDB) allDefs- return $ dbIdColumnsEsc escape entDef+ return $ Util.dbIdColumnsEsc escape entDef showColumn :: Column -> Text@@ -1206,37 +1215,49 @@ connRDBMS = undefined, connLimitOffset = undefined, connLogFunc = undefined,- connMaxParams = Nothing}+ connMaxParams = Nothing,+ connRepsertManySql = Nothing+ } result = runReaderT $ runWriterT $ runWriterT mig resp <- result sqlbackend mapM_ T.putStrLn $ map snd $ snd resp putManySql :: EntityDef -> Int -> Text-putManySql entityDef' numRecords- | numRecords > 0 = q- | otherwise = error "putManySql: numRecords MUST be greater than 0!"+putManySql ent n = putManySql' conflictColumns fields ent n where- tableName' = escape . entityDB $ entityDef'+ fields = entityFields ent+ conflictColumns = concatMap (map (escape . snd) . uniqueFields) (entityUniques ent)++repsertManySql :: EntityDef -> Int -> Text+repsertManySql ent n = putManySql' conflictColumns fields ent n+ where+ fields = keyAndEntityFields ent+ conflictColumns = escape . fieldDB <$> entityKeyFields ent++putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text+putManySql' conflictColumns fields ent n = q+ where fieldDbToText = escape . fieldDB- entityFieldNames = map fieldDbToText (entityFields entityDef')- recordPlaceholders= parenWrapped . commaSeparated- $ map (const "?") (entityFields entityDef')- mkAssignment n = T.concat [n, "=EXCLUDED.", n]- fieldSets = map (mkAssignment . fieldDbToText) (entityFields entityDef')- uniqueFields' = concat $ map (\x -> map escape (map snd $ uniqueFields x)) (entityUniques entityDef')+ mkAssignment f = T.concat [f, "=EXCLUDED.", f]++ table = escape . entityDB $ ent+ columns = Util.commaSeparated $ map fieldDbToText fields+ placeholders = map (const "?") fields+ updates = map (mkAssignment . fieldDbToText) fields+ q = T.concat [ "INSERT INTO "- , tableName'- , " ("- , commaSeparated entityFieldNames- , ") "+ , table+ , Util.parenWrapped columns , " VALUES "- , commaSeparated (replicate numRecords recordPlaceholders)- , " ON CONFLICT ("- , commaSeparated uniqueFields'- , ") DO UPDATE SET "- , commaSeparated fieldSets+ , Util.commaSeparated . replicate n+ . Util.parenWrapped . Util.commaSeparated $ placeholders+ , " ON CONFLICT "+ , Util.parenWrapped . Util.commaSeparated $ conflictColumns+ , " DO UPDATE SET "+ , Util.commaSeparated updates ]+ -- | Enable a Postgres extension. See https://www.postgresql.org/docs/current/static/contrib.html -- for a list.
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 2.8.2.0+version: 2.9.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>@@ -19,7 +19,7 @@ , transformers >= 0.2.1 , postgresql-simple >= 0.4.0 && < 0.6 , postgresql-libpq >= 0.6.1 && < 0.10- , persistent >= 2.8.1 && < 3+ , persistent >= 2.9 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.7