persistent-postgresql 2.5 → 2.6
raw patch · 3 files changed
+67/−3 lines, 3 filesdep ~persistent
Dependency ranges changed: persistent
Files
- ChangeLog.md +4/−0
- Database/Persist/Postgresql.hs +61/−1
- persistent-postgresql.cabal +2/−2
ChangeLog.md view
@@ -1,3 +1,7 @@+## 2.6++* Atomic upsert support for postgreSQL backend+ ## 2.5 * changes for read/write typeclass split
Database/Persist/Postgresql.hs view
@@ -8,6 +8,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable #-} -- | A postgresql backend for persistent. module Database.Persist.Postgresql@@ -44,7 +45,7 @@ import Control.Exception (throw) import Control.Monad.IO.Class (MonadIO (..)) import Data.Data-import Data.Typeable+import Data.Typeable (Typeable) import Data.IORef import qualified Data.Map as Map import Data.Maybe@@ -61,6 +62,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T+import Data.Text.Read (rational) import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Blaze.ByteString.Builder.Char8 as BBB@@ -77,6 +79,7 @@ import Data.Monoid ((<>)) import Data.Pool (Pool) import Data.Time (utc, localTimeToUTC)+import Control.Exception (Exception, throwIO) -- | A @libpq@ connection string. A simple example of connection -- string would be @\"host=localhost port=5432 user=test@@ -86,7 +89,15 @@ -- for more details on how to create such strings. type ConnectionString = ByteString +-- | PostgresServerVersionError exception. This is thrown when persistent+-- is unable to find the version of the postgreSQL server.+data PostgresServerVersionError = PostgresServerVersionError String deriving Typeable +instance Show PostgresServerVersionError where+ show (PostgresServerVersionError uniqueMsg) =+ "Unexpected PostgreSQL server version, got " <> uniqueMsg+instance Exception PostgresServerVersionError+ -- | Create a PostgreSQL connection pool and run the given -- action. The pool is properly released after the action -- finishes using it. Note that you should not use the given@@ -148,16 +159,38 @@ modConn conn openSimpleConn logFunc conn +-- | Gets the PostgreSQL server version+getServerVersion :: PG.Connection -> IO (Maybe Double)+getServerVersion conn = do+ [PG.Only version] <- PG.query_ conn "show server_version";+ let version' = rational version+ --- λ> rational "9.8.3"+ --- Right (9.8,".3")+ --- λ> rational "9.8.3.5"+ --- Right (9.8,".3.5")+ case version' of+ Right (a,_) -> return $ Just a+ Left err -> throwIO $ PostgresServerVersionError err +-- | Choose upsert sql generation function based on postgresql version.+-- PostgreSQL version >= 9.5 supports native upsert feature,+-- so depending upon that we have to choose how the sql query is generated.+upsertFunction :: Double -> Maybe (EntityDef -> Text -> Text)+upsertFunction version = if (version >= 9.5)+ then Just upsertSql'+ else Nothing+ -- | Generate a 'Connection' from a 'PG.Connection' openSimpleConn :: (IsSqlBackend backend) => LogFunc -> PG.Connection -> IO backend openSimpleConn logFunc conn = do smap <- newIORef $ Map.empty+ serverVersion <- getServerVersion conn return . mkPersistBackend $ SqlBackend { connPrepare = prepare' conn , connStmtMap = smap , connInsertSql = insertSql' , connInsertManySql = Just insertManySql'+ , connUpsertSql = maybe Nothing upsertFunction serverVersion , connClose = PG.close conn , connMigrateSql = migrate' , connBegin = const $ PG.begin conn@@ -199,6 +232,32 @@ Just _pdef -> ISRManyKeys sql vals Nothing -> ISRSingle (sql <> " RETURNING " <> escape (fieldDB (entityId ent))) ++upsertSql' :: EntityDef -> Text -> Text+upsertSql' ent updateVal = T.concat+ [ "INSERT INTO "+ , escape (entityDB ent)+ , "("+ , T.intercalate "," $ map (escape . fieldDB) $ entityFields ent+ , ") VALUES ("+ , T.intercalate "," $ map (const "?") (entityFields ent)+ , ") ON CONFLICT ("+ , T.intercalate "," $ concat $ map (\x -> map escape (map snd $ uniqueFields x)) (entityUniques ent)+ , ") DO UPDATE SET "+ , updateVal+ , " WHERE "+ , wher+ , " RETURNING ??"+ ]+ where+ wher = T.intercalate " AND " $ map singleCondition $ entityUniques ent++ singleCondition :: UniqueDef -> Text+ singleCondition udef = T.intercalate " AND " (map singleClause $ map snd (uniqueFields udef))++ singleClause :: DBName -> Text+ singleClause field = escape (entityDB ent) <> "." <> (escape field) <> " =?"+ -- | SQL for inserting multiple rows at once and returning their primary keys. insertManySql' :: EntityDef -> [[PersistValue]] -> InsertSqlResult insertManySql' ent valss =@@ -1041,6 +1100,7 @@ }, connInsertManySql = Nothing, connInsertSql = undefined,+ connUpsertSql = Nothing, connStmtMap = smap, connClose = undefined, connMigrateSql = mockMigrate,
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 2.5+version: 2.6 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.5 && < 3+ , persistent >= 2.6 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.7