Hello community, here is the log from the commit of package ghc-persistent-postgresql for openSUSE:Factory checked in at 2016-11-02 12:46:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-persistent-postgresql (Old) and /work/SRC/openSUSE:Factory/.ghc-persistent-postgresql.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-persistent-postgresql" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-persistent-postgresql/ghc-persistent-postgresql.changes 2016-10-22 13:15:44.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-persistent-postgresql.new/ghc-persistent-postgresql.changes 2016-11-02 12:46:52.000000000 +0100 @@ -1,0 +2,5 @@ +Thu Sep 15 06:58:13 UTC 2016 - psimons@suse.com + +- Update to version 2.6 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- persistent-postgresql-2.2.2.tar.gz New: ---- persistent-postgresql-2.6.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-persistent-postgresql.spec ++++++ --- /var/tmp/diff_new_pack.pdlppU/_old 2016-11-02 12:46:53.000000000 +0100 +++ /var/tmp/diff_new_pack.pdlppU/_new 2016-11-02 12:46:53.000000000 +0100 @@ -18,15 +18,14 @@ %global pkg_name persistent-postgresql Name: ghc-%{pkg_name} -Version: 2.2.2 +Version: 2.6 Release: 0 Summary: Backend for the persistent library using postgresql License: MIT -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-aeson-devel BuildRequires: ghc-blaze-builder-devel BuildRequires: ghc-bytestring-devel @@ -37,13 +36,13 @@ BuildRequires: ghc-persistent-devel BuildRequires: ghc-postgresql-libpq-devel BuildRequires: ghc-postgresql-simple-devel +BuildRequires: ghc-resource-pool-devel BuildRequires: ghc-resourcet-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-text-devel BuildRequires: ghc-time-devel BuildRequires: ghc-transformers-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Based on the postgresql-simple package. @@ -63,15 +62,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ persistent-postgresql-2.2.2.tar.gz -> persistent-postgresql-2.6.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-postgresql-2.2.2/ChangeLog.md new/persistent-postgresql-2.6/ChangeLog.md --- old/persistent-postgresql-2.2.2/ChangeLog.md 2016-01-19 10:46:00.000000000 +0100 +++ new/persistent-postgresql-2.6/ChangeLog.md 2016-08-10 05:20:24.000000000 +0200 @@ -1,3 +1,11 @@ +## 2.6 + +* Atomic upsert support for postgreSQL backend + +## 2.5 + +* changes for read/write typeclass split + ## 2.2.2 * Postgresql primary key is Int4, not Int8 [#519](https://github.com/yesodweb/persistent/issues/519) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-postgresql-2.2.2/Database/Persist/Postgresql.hs new/persistent-postgresql-2.6/Database/Persist/Postgresql.hs --- old/persistent-postgresql-2.2.2/Database/Persist/Postgresql.hs 2016-01-19 10:46:00.000000000 +0100 +++ new/persistent-postgresql-2.6/Database/Persist/Postgresql.hs 2016-08-10 05:20:24.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -7,6 +8,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE DeriveDataTypeable #-} -- | A postgresql backend for persistent. module Database.Persist.Postgresql @@ -25,6 +27,7 @@ import Database.Persist.Sql import Database.Persist.Sql.Util (dbIdColumnsEsc) +import Database.Persist.Sql.Types.Internal (mkPersistBackend) import Data.Fixed (Pico) import qualified Database.PostgreSQL.Simple as PG @@ -42,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 @@ -59,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 @@ -73,7 +77,9 @@ import System.Environment (getEnvironment) import Data.Int (Int64) 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 @@ -83,19 +89,27 @@ -- 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 -- 'ConnectionPool' outside the action since it may be already -- been released. -withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m) +withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m, IsSqlBackend backend) => ConnectionString -- ^ Connection string to the database. -> Int -- ^ Number of connections to be kept open in -- the pool. - -> (ConnectionPool -> m a) + -> (Pool backend -> m a) -- ^ Action to be executed that uses the -- connection pool. -> m a @@ -106,13 +120,13 @@ -- responsibility to properly close the connection pool when -- unneeded. Use 'withPostgresqlPool' for an automatic resource -- control. -createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) +createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) => ConnectionString -- ^ Connection string to the database. -> Int -- ^ Number of connections to be kept open -- in the pool. - -> m ConnectionPool + -> m (Pool backend) createPostgresqlPool = createPostgresqlPoolModified (const $ return ()) -- | Same as 'createPostgresqlPool', but additionally takes a callback function @@ -124,36 +138,59 @@ -- -- Since 2.1.3 createPostgresqlPoolModified - :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) + :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) => (PG.Connection -> IO ()) -- ^ action to perform after connection is created -> ConnectionString -- ^ Connection string to the database. -> Int -- ^ Number of connections to be kept open in the pool. - -> m ConnectionPool + -> m (Pool backend) createPostgresqlPoolModified modConn ci = createSqlPool $ open' modConn ci -- | Same as 'withPostgresqlPool', but instead of opening a pool -- of connections, only one connection is opened. -withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) - => ConnectionString -> (SqlBackend -> m a) -> m a +withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, IsSqlBackend backend) + => ConnectionString -> (backend -> m a) -> m a withPostgresqlConn = withSqlConn . open' (const $ return ()) -open' :: (PG.Connection -> IO ()) - -> ConnectionString -> LogFunc -> IO SqlBackend +open' + :: (IsSqlBackend backend) + => (PG.Connection -> IO ()) -> ConnectionString -> LogFunc -> IO backend open' modConn cstr logFunc = do conn <- PG.connectPostgreSQL cstr 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 :: LogFunc -> PG.Connection -> IO SqlBackend +openSimpleConn :: (IsSqlBackend backend) => LogFunc -> PG.Connection -> IO backend openSimpleConn logFunc conn = do smap <- newIORef $ Map.empty - return SqlBackend + 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 @@ -195,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 = @@ -899,18 +962,12 @@ -- | get the SQL string for the table that a PeristEntity represents -- Useful for raw SQL queries -tableName :: forall record. - ( PersistEntity record - , PersistEntityBackend record ~ SqlBackend - ) => record -> Text +tableName :: (PersistEntity record) => record -> Text tableName = escape . tableDBName -- | get the SQL string for the field that an EntityField represents -- Useful for raw SQL queries -fieldName :: forall record typ. - ( PersistEntity record - , PersistEntityBackend record ~ SqlBackend - ) => EntityField record typ -> Text +fieldName :: (PersistEntity record) => EntityField record typ -> Text fieldName = escape . fieldDBName escape :: DBName -> Text @@ -1043,6 +1100,7 @@ }, connInsertManySql = Nothing, connInsertSql = undefined, + connUpsertSql = Nothing, connStmtMap = smap, connClose = undefined, connMigrateSql = mockMigrate, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-postgresql-2.2.2/persistent-postgresql.cabal new/persistent-postgresql-2.6/persistent-postgresql.cabal --- old/persistent-postgresql-2.2.2/persistent-postgresql.cabal 2016-01-19 10:46:00.000000000 +0100 +++ new/persistent-postgresql-2.6/persistent-postgresql.cabal 2016-08-14 00:03:58.000000000 +0200 @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 2.2.2 +version: 2.6 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman @@ -19,7 +19,7 @@ , transformers >= 0.2.1 , postgresql-simple >= 0.4.0 && < 0.6 , postgresql-libpq >= 0.6.1 && < 0.10 - , persistent >= 2.2 && < 3 + , persistent >= 2.6 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.7 @@ -30,6 +30,7 @@ , conduit >= 0.5.3 , resourcet >= 1.1 , monad-logger >= 0.3.4 + , resource-pool exposed-modules: Database.Persist.Postgresql ghc-options: -Wall