Hello community, here is the log from the commit of package ghc-persistent for openSUSE:Factory checked in at 2018-10-25 08:17:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-persistent (Old) and /work/SRC/openSUSE:Factory/.ghc-persistent.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent" Thu Oct 25 08:17:53 2018 rev:12 rq:642887 version:2.9.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-persistent/ghc-persistent.changes 2018-07-21 10:22:23.710998380 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-persistent.new/ghc-persistent.changes 2018-10-25 08:18:11.004022396 +0200 @@ -1,0 +2,12 @@ +Mon Oct 15 02:01:23 UTC 2018 - [email protected] + +- Update persistent to version 2.9.0. + # Changelog for persistent + + ## 2.9.0 + + * Added support for SQL isolation levels to via SqlBackend. [#812] + * Move `Database.Persist.Sql.Raw.QQ` to a separate `persistent-qq` package [#827](https://github.com/yesodweb/persistent/issues/827) + * Fix [832](https://github.com/yesodweb/persistent/issues/832): `repsertMany` now matches `mapM_ (uncurry repsert)` and is atomic for supported sql back-ends. + +------------------------------------------------------------------- Old: ---- persistent-2.8.2.tar.gz persistent.cabal New: ---- persistent-2.9.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-persistent.spec ++++++ --- /var/tmp/diff_new_pack.wJcHJa/_old 2018-10-25 08:18:12.296021829 +0200 +++ /var/tmp/diff_new_pack.wJcHJa/_new 2018-10-25 08:18:12.296021829 +0200 @@ -12,21 +12,20 @@ # license that conforms to the Open Source Definition (Version 1.9) # published by the Open Source Initiative. -# Please submit bugfixes or comments via http://bugs.opensuse.org/ +# Please submit bugfixes or comments via https://bugs.opensuse.org/ # %global pkg_name persistent %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.8.2 +Version: 2.9.0 Release: 0 Summary: Type-safe, multi-backend data serialization License: MIT Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-attoparsec-devel @@ -37,7 +36,6 @@ BuildRequires: ghc-conduit-devel BuildRequires: ghc-containers-devel BuildRequires: ghc-fast-logger-devel -BuildRequires: ghc-haskell-src-meta-devel BuildRequires: ghc-http-api-data-devel BuildRequires: ghc-monad-logger-devel BuildRequires: ghc-mtl-devel @@ -79,7 +77,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ persistent-2.8.2.tar.gz -> persistent-2.9.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/ChangeLog.md new/persistent-2.9.0/ChangeLog.md --- old/persistent-2.8.2/ChangeLog.md 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/ChangeLog.md 2018-10-14 08:52:58.000000000 +0200 @@ -1,3 +1,11 @@ +# Changelog for persistent + +## 2.9.0 + +* Added support for SQL isolation levels to via SqlBackend. [#812] +* Move `Database.Persist.Sql.Raw.QQ` to a separate `persistent-qq` package [#827](https://github.com/yesodweb/persistent/issues/827) +* Fix [832](https://github.com/yesodweb/persistent/issues/832): `repsertMany` now matches `mapM_ (uncurry repsert)` and is atomic for supported sql back-ends. + ## 2.8.2 * Added support for `sql=` to the unique constraints quasi-quoter so that users can specify the database names of the constraints. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Class/PersistStore.hs new/persistent-2.9.0/Database/Persist/Class/PersistStore.hs --- old/persistent-2.8.2/Database/Persist/Class/PersistStore.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Class/PersistStore.hs 2018-10-14 08:50:22.000000000 +0200 @@ -132,12 +132,48 @@ , PersistField (BackendKey backend), A.ToJSON (BackendKey backend), A.FromJSON (BackendKey backend) ) => PersistStoreRead backend where -- | Get a record by identifier, if available. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > getSpj :: MonadIO m => ReaderT SqlBackend m (Maybe User) + -- > getSpj = get spjId + -- + -- > mspj <- getSpj + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this: + -- + -- > +------+-----+ + -- > | name | age | + -- > +------+-----+ + -- > | SPJ | 40 | + -- > +------+-----+ get :: (MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) -- | Get many records by their respective identifiers, if available. -- -- @since 2.8.1 + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>: + -- + -- > getUsers :: MonadIO m => ReaderT SqlBackend m (Map (Key User) User) + -- > getUsers = getMany allkeys + -- + -- > musers <- getUsers + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get these records: + -- + -- > +----+-------+-----+ + -- > | id | name | age | + -- > +----+-------+-----+ + -- > | 1 | SPJ | 40 | + -- > +----+-------+-----+ + -- > | 2 | Simon | 41 | + -- > +----+-------+-----+ getMany :: (MonadIO m, PersistRecordBackend record backend) => [Key record] -> ReaderT backend m (Map (Key record) record) @@ -157,10 +193,50 @@ -- | Create a new record in the database, returning an automatically created -- key (in SQL an auto-increment id). + -- + -- === __Example usage__ + -- + -- Using <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, let's insert a new user 'John'. + -- + -- > insertJohn :: MonadIO m => ReaderT SqlBackend m (Key User) + -- > insertJohn = insert $ User "John" 30 + -- + -- > johnId <- insertJohn + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |John |30 | + -- > +-----+------+-----+ insert :: (MonadIO m, PersistRecordBackend record backend) => record -> ReaderT backend m (Key record) -- | Same as 'insert', but doesn't return a @Key@. + -- + -- === __Example usage__ + -- + -- with <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > insertJohn :: MonadIO m => ReaderT SqlBackend m (Key User) + -- > insertJohn = insert_ $ User "John" 30 + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |John |30 | + -- > +-----+------+-----+ insert_ :: (MonadIO m, PersistRecordBackend record backend) => record -> ReaderT backend m () insert_ record = insert record >> return () @@ -174,6 +250,31 @@ -- -- The SQLite and MySQL backends use the slow, default implementation of -- @mapM insert@. + -- + -- === __Example usage__ + -- + -- with <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > insertUsers :: MonadIO m => ReaderT SqlBackend m [Key User] + -- > insertUsers = insertMany [User "John" 30, User "Nick" 32, User "Jane" 20] + -- + -- > userIds <- insertUsers + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |John |30 | + -- > +-----+------+-----+ + -- > |4 |Nick |32 | + -- > +-----+------+-----+ + -- > |5 |Jane |20 | + -- > +-----+------+-----+ insertMany :: (MonadIO m, PersistRecordBackend record backend) => [record] -> ReaderT backend m [Key record] insertMany = mapM insert @@ -182,6 +283,29 @@ -- -- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in -- one database query. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > insertUsers_ :: MonadIO m => ReaderT SqlBackend m () + -- > insertUsers_ = insertMany_ [User "John" 30, User "Nick" 32, User "Jane" 20] + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |John |30 | + -- > +-----+------+-----+ + -- > |4 |Nick |32 | + -- > +-----+------+-----+ + -- > |5 |Jane |20 | + -- > +-----+------+-----+ insertMany_ :: (MonadIO m, PersistRecordBackend record backend) => [record] -> ReaderT backend m () insertMany_ x = insertMany x >> return () @@ -193,17 +317,115 @@ -- -- The MongoDB, PostgreSQL, SQLite and MySQL backends insert all records in -- one database query. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > insertUserEntityMany :: MonadIO m => ReaderT SqlBackend m () + -- > insertUserEntityMany = insertEntityMany [SnakeEntity, EvaEntity] + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |Snake |38 | + -- > +-----+------+-----+ + -- > |4 |Eva |38 | + -- > +-----+------+-----+ insertEntityMany :: (MonadIO m, PersistRecordBackend record backend) => [Entity record] -> ReaderT backend m () insertEntityMany = mapM_ (\(Entity k record) -> insertKey k record) -- | Create a new record in the database using the given key. + -- + -- === __Example usage__ + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > insertAliceKey :: MonadIO m => Key User -> ReaderT SqlBackend m () + -- > insertAliceKey key = insertKey key $ User "Alice" 20 + -- + -- > insertAliceKey $ UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 3}} + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |Alice |20 | + -- > +-----+------+-----+ insertKey :: (MonadIO m, PersistRecordBackend record backend) => Key record -> record -> ReaderT backend m () -- | Put the record in the database with the given key. -- Unlike 'replace', if a record with the given key does not -- exist then a new record will be inserted. + -- + -- === __Example usage__ + -- + -- We try to explain 'upsertBy' using <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>. + -- + -- First, we insert Philip to <#dataset-persist-store-1 dataset-1>. + -- + -- > insertPhilip :: MonadIO m => ReaderT SqlBackend m (Key User) + -- > insertPhilip = insert $ User "Philip" 42 + -- + -- > philipId <- insertPhilip + -- + -- This query will produce: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |Philip|42 | + -- > +-----+------+-----+ + -- + -- > repsertHaskell :: MonadIO m => Key record -> ReaderT SqlBackend m () + -- > repsertHaskell id = repsert id $ User "Haskell" 81 + -- + -- > repsertHaskell philipId + -- + -- This query will replace Philip's record with Haskell's one: + -- + -- > +-----+-----------------+--------+ + -- > |id |name |age | + -- > +-----+-----------------+--------+ + -- > |1 |SPJ |40 | + -- > +-----+-----------------+--------+ + -- > |2 |Simon |41 | + -- > +-----+-----------------+--------+ + -- > |3 |Philip -> Haskell|42 -> 81| + -- > +-----+-----------------+--------+ + -- + -- 'repsert' inserts the given record if the key doesn't exist. + -- + -- > repsertXToUnknown :: MonadIO m => ReaderT SqlBackend m () + -- > repsertXToUnknown = repsert unknownId $ User "X" 999 + -- + -- For example, applying the above query to <#dataset-persist-store-1 dataset-1> will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |X |999 | + -- > +-----+------+-----+ repsert :: (MonadIO m, PersistRecordBackend record backend) => Key record -> record -> ReaderT backend m () @@ -214,9 +436,26 @@ -- Useful when migrating data from one entity to another -- and want to preserve ids. -- - -- Differs from @insertEntityMany@ by gracefully skipping - -- pre-existing records matching key(s). -- @since 2.8.1 + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > repsertManyUsers :: MonadIO m =>ReaderT SqlBackend m () + -- > repsertManyusers = repsertMany [(simonId, User "Philip" 20), (unknownId999, User "Mr. X" 999)] + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+----------------+---------+ + -- > |id |name |age | + -- > +-----+----------------+---------+ + -- > |1 |SPJ |40 | + -- > +-----+----------------+---------+ + -- > |2 |Simon -> Philip |41 -> 20 | + -- > +-----+----------------+---------+ + -- > |999 |Mr. X |999 | + -- > +-----+----------------+---------+ repsertMany :: (MonadIO m, PersistRecordBackend record backend) => [(Key record, record)] -> ReaderT backend m () @@ -224,17 +463,68 @@ -- | Replace the record in the database with the given -- key. Note that the result is undefined if such record does - -- not exist, so you must use 'insertKey or 'repsert' in + -- not exist, so you must use 'insertKey' or 'repsert' in -- these cases. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1 schama-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > replaceSpj :: MonadIO m => User -> ReaderT SqlBackend m () + -- > replaceSpj record = replace spjId record + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |Mike |45 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ replace :: (MonadIO m, PersistRecordBackend record backend) => Key record -> record -> ReaderT backend m () -- | Delete a specific record by identifier. Does nothing if record does -- not exist. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > deleteSpj :: MonadIO m => ReaderT SqlBackend m () + -- > deleteSpj = delete spjId + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ delete :: (MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m () -- | Update individual fields on a specific record. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > updateSpj :: MonadIO m => [Update User] -> ReaderT SqlBackend m () + -- > updateSpj updates = update spjId updates + -- + -- > updateSpj [UserAge +=. 100] + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |140 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ update :: (MonadIO m, PersistRecordBackend record backend) => Key record -> [Update record] -> ReaderT backend m () @@ -243,6 +533,25 @@ -- -- Note that this function will throw an exception if the given key is not -- found in the database. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, + -- + -- > updateGetSpj :: MonadIO m => [Update User] -> ReaderT SqlBackend m User + -- > updateGetSpj updates = updateGet spjId updates + -- + -- > spj <- updateGetSpj [UserAge +=. 100] + -- + -- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |140 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ updateGet :: (MonadIO m, PersistRecordBackend record backend) => Key record -> [Update record] -> ReaderT backend m record updateGet key ups = do @@ -252,6 +561,30 @@ -- | Same as 'get', but for a non-null (not Maybe) foreign key. -- Unsafe unless your database is enforcing that the foreign key is valid. +-- +-- === __Example usage__ +-- +-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, +-- +-- > getJustSpj :: MonadIO m => ReaderT SqlBackend m User +-- > getJustSpj = getJust spjId +-- +-- > spj <- getJust spjId +-- +-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this record: +-- +-- > +----+------+-----+ +-- > | id | name | age | +-- > +----+------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+------+-----+ +-- +-- > getJustUnknown :: MonadIO m => ReaderT SqlBackend m User +-- > getJustUnknown = getJust unknownId +-- +-- mrx <- getJustUnknown +-- +-- This just throws an error. getJust :: ( PersistStoreRead backend , Show (Key record) , PersistRecordBackend record backend @@ -264,6 +597,23 @@ -- | Same as 'getJust', but returns an 'Entity' instead of just the record. -- -- @since 2.6.1 +-- +-- === __Example usage__ +-- +-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, +-- +-- > getJustEntitySpj :: MonadIO m => ReaderT SqlBackend m (Entity User) +-- > getJustEntitySpj = getJustEntity spjId +-- +-- > spjEnt <- getJustEntitySpj +-- +-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this entity: +-- +-- > +----+------+-----+ +-- > | id | name | age | +-- > +----+------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+------+-----+ getJustEntity :: (PersistEntityBackend record ~ BaseBackend backend ,MonadIO m @@ -302,6 +652,27 @@ belongsToJust getForeignKey model = getJust $ getForeignKey model -- | Like @insert@, but returns the complete @Entity@. +-- +-- === __Example usage__ +-- +-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, +-- +-- > insertHaskellEntity :: MonadIO m => ReaderT SqlBackend m (Entity User) +-- > insertHaskellEntity = insertEntity $ User "Haskell" 81 +-- +-- > haskellEnt <- insertHaskellEntity +-- +-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: +-- +-- > +----+---------+-----+ +-- > | id | name | age | +-- > +----+---------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+---------+-----+ +-- > | 2 | Simon | 41 | +-- > +----+---------+-----+ +-- > | 3 | Haskell | 81 | +-- > +----+---------+-----+ insertEntity :: ( PersistStoreWrite backend , PersistRecordBackend e backend @@ -312,6 +683,23 @@ return $ Entity eid e -- | Like @get@, but returns the complete @Entity@. +-- +-- === __Example usage__ +-- +-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, +-- +-- > getSpjEntity :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User)) +-- > getSpjEntity = getEntity spjId +-- +-- > mSpjEnt <- getSpjEntity +-- +-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will get this entity: +-- +-- > +----+------+-----+ +-- > | id | name | age | +-- > +----+------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+------+-----+ getEntity :: ( PersistStoreRead backend , PersistRecordBackend e backend @@ -324,6 +712,27 @@ -- | Like 'insertEntity' but just returns the record instead of 'Entity'. -- -- @since 2.6.1 +-- +-- === __Example usage__ +-- +-- With <#schema-persist-store-1 schema-1> and <#dataset-persist-store-1 dataset-1>, +-- +-- > insertDaveRecord :: MonadIO m => ReaderT SqlBackend m User +-- > insertDaveRecord = insertRecord $ User "Dave" 50 +-- +-- > dave <- insertDaveRecord +-- +-- The above query when applied on <#dataset-persist-store-1 dataset-1>, will produce this: +-- +-- > +-----+------+-----+ +-- > |id |name |age | +-- > +-----+------+-----+ +-- > |1 |SPJ |40 | +-- > +-----+------+-----+ +-- > |2 |Simon |41 | +-- > +-----+------+-----+ +-- > |3 |Dave |50 | +-- > +-----+------+-----+ insertRecord :: (PersistEntityBackend record ~ BaseBackend backend ,PersistEntity record diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Class/PersistUnique.hs new/persistent-2.9.0/Database/Persist/Class/PersistUnique.hs --- old/persistent-2.8.2/Database/Persist/Class/PersistUnique.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Class/PersistUnique.hs 2018-08-23 05:29:55.000000000 +0200 @@ -46,6 +46,23 @@ class (PersistCore backend, PersistStoreRead backend) => PersistUniqueRead backend where -- | Get a record by unique key, if available. Returns also the identifier. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>: + -- + -- > getBySpjName :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User)) + -- > getBySpjName = getBy $ UniqueUserName "SPJ" + -- + -- > mSpjEnt <- getBySpjName + -- + -- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will get this entity: + -- + -- > +----+------+-----+ + -- > | id | name | age | + -- > +----+------+-----+ + -- > | 1 | SPJ | 40 | + -- > +----+------+-----+ getBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record -> ReaderT backend m (Maybe (Entity record)) @@ -63,11 +80,45 @@ PersistUniqueWrite backend where -- | Delete a specific record by unique key. Does nothing if no record -- matches. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>, + -- + -- > deleteBySpjName :: MonadIO m => ReaderT SqlBackend m () + -- > deleteBySpjName = deleteBy UniqueUserName "SPJ" + -- + -- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will produce this: + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ deleteBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record -> ReaderT backend m () -- | Like 'insert', but returns 'Nothing' when the record -- couldn't be inserted because of a uniqueness constraint. + -- + -- === __Example usage__ + -- + -- With <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>, we try to insert the following two records: + -- + -- > linusId <- insertUnique $ User "Linus" 48 + -- > spjId <- insertUnique $ User "SPJ" 90 + -- + -- > +-----+------+-----+ + -- > |id |name |age | + -- > +-----+------+-----+ + -- > |1 |SPJ |40 | + -- > +-----+------+-----+ + -- > |2 |Simon |41 | + -- > +-----+------+-----+ + -- > |3 |Linus |48 | + -- > +-----+------+-----+ + -- + -- Linus's record was inserted to <#dataset-persist-unique-1 dataset-1>, while SPJ wasn't because SPJ already exists in <#dataset-persist-unique-1 dataset-1>. insertUnique :: (MonadIO m, PersistRecordBackend record backend) => record -> ReaderT backend m (Maybe (Key record)) @@ -82,12 +133,53 @@ -- * If the record exists (matched via it's uniqueness constraint), then update the existing record with the parameters which is passed on as list to the function. -- -- Throws an exception if there is more than 1 uniqueness constraint. + -- + -- === __Example usage__ + -- + -- First, we try to explain 'upsert' using <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>. + -- + -- > upsertSpj :: MonadIO m => [Update User] -> ReaderT SqlBackend m (Maybe (Entity User)) + -- > upsertSpj updates = upsert (User "SPJ" 999) upadtes + -- + -- > mSpjEnt <- upsertSpj [UserAge +=. 15] + -- + -- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will produce this: + -- + -- > +-----+-----+--------+ + -- > |id |name |age | + -- > +-----+-----+--------+ + -- > |1 |SPJ |40 -> 55| + -- > +-----+-----+--------+ + -- > |2 |Simon|41 | + -- > +-----+-----+--------+ + -- + -- > upsertX :: MonadIO m => [Update User] -> ReaderT SqlBackend m (Maybe (Entity User)) + -- > upsertX updates = upsert (User "X" 999) upadtes + -- + -- > mXEnt <- upsertX [UserAge +=. 15] + -- + -- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will produce this: + -- + -- > +-----+-----+--------+ + -- > |id |name |age | + -- > +-----+-----+--------+ + -- > |1 |SPJ |40 | + -- > +-----+-----+--------+ + -- > |2 |Simon|41 | + -- > +-----+-----+--------+ + -- > |3 |X |999 | + -- > +-----+-----+--------+ + -- + -- Next, what if the schema has two uniqueness constraints? + -- Let's check it out using <#schema-persist-unique-2 schema-2>: + -- + -- > mSpjEnt <- upsertSpj [UserAge +=. 15] + -- + -- Then, it throws an error message something like "Expected only one unique key, got" upsert :: (MonadIO m, PersistRecordBackend record backend) => record -- ^ new record to insert - -> [Update record] -- ^ updates to perform if the record already exists (leaving - -- this empty is the equivalent of performing a 'repsert' on a - -- unique key) + -> [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 @@ -96,13 +188,62 @@ -- -- * insert the new record if it does not exist; -- * update the existing record that matches the given uniqueness constraint. + -- + -- === __Example usage__ + -- + -- We try to explain 'upsertBy' using <#schema-persist-unique-2 schema-2> and <#dataset-persist-unique-1 dataset-1>. + -- + -- > upsertBySpjName :: MonadIO m => User -> [Update User] -> ReaderT SqlBackend m (Entity User) + -- > upsertBySpjName record updates = upsertBy (UniqueUserName "SPJ") record updates + -- + -- > mSpjEnt <- upsertBySpjName (Person "X" 999) [PersonAge += .15] + -- + -- The above query will alter <#dataset-persist-unique-1 dataset-1> to: + -- + -- > +-----+-----+--------+ + -- > |id |name |age | + -- > +-----+-----+--------+ + -- > |1 |SPJ |40 -> 55| + -- > +-----+-----+--------+ + -- > |2 |Simon|41 | + -- > +-----+-----+--------+ + -- + -- > upsertBySimonAge :: MonadIO m => User -> [Update User] -> ReaderT SqlBackend m (Entity User) + -- > upsertBySimonAge record updates = upsertBy (UniqueUserName "SPJ") record updates + -- + -- > mPhilipEnt <- upsertBySimonAge (User "X" 999) [UserName =. "Philip"] + -- + -- The above query will alter <#dataset-persist-unique-1 dataset-1> to: + -- + -- > +----+-----------------+-----+ + -- > | id | name | age | + -- > +----+-----------------+-----+ + -- > | 1 | SPJ | 40 | + -- > +----+-----------------+-----+ + -- > | 2 | Simon -> Philip | 41 | + -- > +----+-----------------+-----+ + -- + -- > upsertByUnknownName :: MonadIO m => User -> [Update User] -> ReaderT SqlBackend m (Entity User) + -- > upsertByUnknownName record updates = upsertBy (UniqueUserName "Unknown") record updates + -- + -- > mXEnt <- upsertByUnknownName (User "X" 999) [UserAge +=. 15] + -- + -- This query will alter <#dataset-persist-unique-1 dataset-1> to: + -- + -- > +-----+-----+-----+ + -- > |id |name |age | + -- > +-----+-----+-----+ + -- > |1 |SPJ |40 | + -- > +-----+-----+-----+ + -- > |2 |Simon|41 | + -- > +-----+-----+-----+ + -- > |3 |X |999 | + -- > +-----+-----+-----+ upsertBy :: (MonadIO m, PersistRecordBackend record backend) => Unique record -- ^ uniqueness constraint to find by -> record -- ^ new record to insert - -> [Update record] -- ^ updates to perform if the record already exists (leaving - -- this empty is the equivalent of performing a 'repsert' on a - -- unique key) + -> [Update record] -- ^ updates to perform if the record already exists -> ReaderT backend m (Entity record) -- ^ the record in the database after the operation upsertBy uniqueKey record updates = do mrecord <- getBy uniqueKey @@ -125,6 +266,17 @@ -- | Insert a value, checking for conflicts with any unique constraints. If a -- duplicate exists in the database, it is returned as 'Left'. Otherwise, the -- new 'Key is returned as 'Right'. +-- +-- === __Example usage__ +-- +-- With <#schema-persist-unique-2 schema-2> and <#dataset-persist-unique-1 dataset-1>, we have following lines of code: +-- +-- > l1 <- insertBy $ User "SPJ" 20 +-- > l2 <- insertBy $ User "XXX" 41 +-- > l3 <- insertBy $ User "SPJ" 40 +-- > r1 <- insertBy $ User "XXX" 100 +-- +-- First three lines return 'Left' because there're duplicates in given record's uniqueness constraints. While the last line returns a new key as 'Right'. insertBy :: (MonadIO m ,PersistUniqueWrite backend @@ -151,6 +303,35 @@ -- couldn't be inserted because of a uniqueness constraint. -- -- @since 2.7.1 +-- +-- === __Example usage__ +-- +-- We use <#schema-persist-unique-2 schema-2> and <#dataset-persist-unique-1 dataset-1> here. +-- +-- > insertUniqueSpjEntity :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User)) +-- > insertUniqueSpjEntity = insertUniqueEntity $ User "SPJ" 50 +-- +-- > mSpjEnt <- insertUniqueSpjEntity +-- +-- The above query results 'Nothing' as SPJ already exists. +-- +-- > insertUniqueAlexaEntity :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User)) +-- > insertUniqueAlexaEntity = insertUniqueEntity $ User "Alexa" 3 +-- +-- > mAlexaEnt <- insertUniqueSpjEntity +-- +-- Because there's no such unique keywords of the given record, the above query when applied on <#dataset-persist-unique-1 dataset-1>, will produce this: +-- +-- > +----+-------+-----+ +-- > | id | name | age | +-- > +----+-------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+-------+-----+ +-- > | 2 | Simon | 41 | +-- > +----+-------+-----+ +-- > | 3 | Alexa | 3 | +-- > +----+-------+-----+ + insertUniqueEntity :: (MonadIO m ,PersistRecordBackend record backend @@ -160,6 +341,17 @@ fmap (\key -> Entity key datum) `liftM` insertUnique datum -- | Return the single unique key for a record. +-- +-- === __Example usage__ +-- +-- We use shcema-1 and <#dataset-persist-unique-1 dataset-1> here. +-- +-- > onlySimonConst :: MonadIO m => ReaderT SqlBackend m (Unique User) +-- > onlySimonConst = onlyUnique $ User "Simon" 999 +-- +-- > mSimonConst <- onlySimonConst +-- +-- @mSimonConst@ would be Simon's uniqueness constraint. Note that @onlyUnique@ doesn't work if there're more than two constraints. onlyUnique :: (MonadIO m ,PersistUniqueWrite backend @@ -184,6 +376,23 @@ -- of a 'Unique' record. Returns a record matching /one/ of the unique keys. This -- function makes the most sense on entities with a single 'Unique' -- constructor. +-- +-- === __Example usage__ +-- +-- With <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>, +-- +-- getBySpjValue :: MonadIO m => ReaderT SqlBackend m (Maybe (Entity User)) +-- getBySpjValue = getByValue $ User "SPJ" 999 +-- +-- > mSpjEnt <- getBySpjValue +-- +-- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will get this record: +-- +-- > +----+------+-----+ +-- > | id | name | age | +-- > +----+------+-----+ +-- > | 1 | SPJ | 40 | +-- > +----+------+-----+ getByValue :: (MonadIO m ,PersistUniqueRead backend @@ -246,6 +455,18 @@ -- -- Returns 'Nothing' if the entity would be unique, and could thus safely be inserted. -- on a conflict returns the conflicting key +-- +-- === __Example usage__ +-- +-- We use <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1> here. +-- +-- This would be 'Nothing': +-- +-- > mAlanConst <- checkUnique $ User "Alan" 70 +-- +-- While this would be 'Just' because SPJ already exists: +-- +-- > mSpjConst <- checkUnique $ User "SPJ" 60 checkUnique :: (MonadIO m ,PersistRecordBackend record backend diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Class.hs new/persistent-2.9.0/Database/Persist/Class.hs --- old/persistent-2.8.2/Database/Persist/Class.hs 2017-12-20 19:38:43.000000000 +0100 +++ new/persistent-2.9.0/Database/Persist/Class.hs 2018-08-23 05:29:55.000000000 +0200 @@ -4,6 +4,33 @@ ( ToBackendKey (..) -- * PersistStore + -- | + -- + -- All the examples present here will be explained based on these schemas, datasets and functions: + -- + -- = schema-1 + -- + -- #schema-persist-store-1# + -- + -- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| + -- > User + -- > name String + -- > age Int + -- > deriving Show + -- > |] + -- + -- = dataset-1 + -- + -- #dataset-persist-store-1# + -- + -- > +----+-------+-----+ + -- > | id | name | age | + -- > +----+-------+-----+ + -- > | 1 | SPJ | 40 | + -- > +----+-------+-----+ + -- > | 2 | Simon | 41 | + -- > +----+-------+-----+ + , PersistCore (..) , PersistStore , PersistStoreRead (..) @@ -18,6 +45,49 @@ , insertRecord -- * PersistUnique + -- | + -- + -- All the examples present here will be explained based on these two schemas and the dataset: + -- + -- = schema-1 + -- This schema has single unique constraint. + -- + -- #schema-persist-unique-1# + -- + -- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| + -- > User + -- > name String + -- > age Int + -- > UniqueUserName name + -- > deriving Show + -- > |] + -- + -- = schema-2 + -- This schema has two unique constraints. + -- + -- #schema-persist-unique-2# + -- + -- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| + -- > User + -- > name String + -- > age Int + -- > UniqueUserName name + -- > UniqueUserAge age + -- > deriving Show + -- > |] + -- + -- = dataset-1 + -- + -- #dataset-persist-unique-1# + -- + -- > +-----+-----+-----+ + -- > |id |name |age | + -- > +-----+-----+-----+ + -- > |1 |SPJ |40 | + -- > +-----+-----+-----+ + -- > |2 |Simon|41 | + -- > +-----+-----+-----+ + , PersistUnique , PersistUniqueRead (..) , PersistUniqueWrite (..) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistQuery.hs new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistQuery.hs --- old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistQuery.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistQuery.hs 2018-10-14 08:50:22.000000000 +0200 @@ -12,11 +12,10 @@ import Database.Persist hiding (updateField) import Database.Persist.Sql.Util ( entityColumnNames, parseEntityValues, isIdField, updatePersistValue - , mkUpdateText, commaSeparated) + , mkUpdateText, commaSeparated, dbIdColumns) import Database.Persist.Sql.Types import Database.Persist.Sql.Raw import Database.Persist.Sql.Orphan.PersistStore (withRawQuery) -import Database.Persist.Sql.Util (dbIdColumns) import qualified Data.Text as T import Data.Text (Text) import Data.Monoid (Monoid (..), (<>)) @@ -329,7 +328,7 @@ OrNullYes -> mconcat [" OR ", name, " IS NULL"] OrNullNo -> "" - isNull = any (== PersistNull) allVals + isNull = PersistNull `elem` allVals notNullVals = filter (/= PersistNull) allVals allVals = filterValueToPersistValues value tn = connEscapeName conn $ entityDB diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistStore.hs new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistStore.hs --- old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistStore.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistStore.hs 2018-10-14 08:50:22.000000000 +0200 @@ -5,7 +5,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} @@ -35,7 +34,7 @@ import Control.Monad.IO.Class import Data.ByteString.Char8 (readInteger) import Data.Maybe (isJust) -import Data.List (find) +import Data.List (find, nubBy) import Data.Void (Void) import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT) import Data.Acquire (with) @@ -48,6 +47,7 @@ import Database.Persist.Class () import qualified Data.Map as Map import qualified Data.Foldable as Foldable +import Data.Function (on) withRawQuery :: MonadIO m => Text @@ -214,7 +214,7 @@ case connInsertManySql conn of Nothing -> mapM insert vals - Just insertManyFn -> do + Just insertManyFn -> case insertManyFn ent valss of ISRSingle sql -> rawSql sql (concat valss) _ -> error "ISRSingle is expected from the connInsertManySql function" @@ -264,7 +264,7 @@ let columnNames = keyAndEntityColumnNames entDef conn runChunked (length columnNames) go es' where - go es = insrepHelper "INSERT" es + go = insrepHelper "INSERT" repsert key value = do mExisting <- get key @@ -272,14 +272,20 @@ Nothing -> insertKey key value Just _ -> replace key value - repsertMany krs = do - let es = (uncurry Entity) `fmap` krs - let ks = entityKey `fmap` es - let mEs = Map.fromList $ zip ks es - mRsExisting <- getMany ks - let mEsNew = Map.difference mEs mRsExisting - let esNew = snd `fmap` Map.toList mEsNew - insertEntityMany esNew + repsertMany [] = return () + repsertMany krsDups = do + conn <- ask + let krs = nubBy ((==) `on` fst) (reverse krsDups) + let rs = snd `fmap` krs + let ent = entityDef rs + let nr = length krs + let toVals (k,r) + = case entityPrimary ent of + Nothing -> keyToValues k <> (toPersistValue <$> toPersistFields r) + Just _ -> toPersistValue <$> toPersistFields r + case connRepsertManySql conn of + (Just mkSql) -> rawExecute (mkSql ent nr) (concatMap toVals krs) + Nothing -> mapM_ (uncurry repsert) krs delete k = do conn <- ask @@ -385,4 +391,4 @@ -- Implement this here to avoid depending on the split package chunksOf :: Int -> [a] -> [[a]] chunksOf _ [] = [] -chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk : chunksOf size rest \ No newline at end of file +chunksOf size xs = let (chunk, rest) = splitAt size xs in chunk : chunksOf size rest diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistUnique.hs new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistUnique.hs --- old/persistent-2.8.2/Database/Persist/Sql/Orphan/PersistUnique.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Sql/Orphan/PersistUnique.hs 2018-10-14 08:50:22.000000000 +0200 @@ -10,7 +10,6 @@ import Control.Exception (throwIO) import Control.Monad.IO.Class (liftIO, MonadIO) -import Control.Monad.Trans.Reader (ReaderT) import Database.Persist import Database.Persist.Class.PersistUnique (defaultPutMany, persistUniqueKeyValues) import Database.Persist.Sql.Types @@ -20,7 +19,7 @@ import qualified Data.Text as T import Data.Monoid (mappend) import qualified Data.Conduit.List as CL -import Control.Monad.Trans.Reader (ask, withReaderT) +import Control.Monad.Trans.Reader (ask, withReaderT, ReaderT) import Data.List (nubBy) import Data.Function (on) @@ -47,14 +46,16 @@ _:_ -> do let upds = T.intercalate "," $ map mkUpdateText updates sql = upsertSql t upds - vals = (map toPersistValue $ toPersistFields record) ++ (map updatePersistValue updates) ++ (unqs uniqueKey) + vals = map toPersistValue (toPersistFields record) + ++ map updatePersistValue updates + ++ unqs uniqueKey x <- rawSql sql vals return $ head x Nothing -> defaultUpsert record updates where t = entityDef $ Just record - unqs uniqueKey = concat $ map (persistUniqueToValues) [uniqueKey] + unqs uniqueKey = concatMap persistUniqueToValues [uniqueKey] deleteBy uniq = do conn <- ask @@ -78,9 +79,9 @@ let rs = nubBy ((==) `on` persistUniqueKeyValues) (reverse rsD) let ent = entityDef rs let nr = length rs - let toVals r = (map toPersistValue $ toPersistFields r) + let toVals r = map toPersistValue $ toPersistFields r case connPutManySql conn of - (Just mkSql) -> rawExecute (mkSql ent nr) (concat (map toVals rs)) + (Just mkSql) -> rawExecute (mkSql ent nr) (concatMap toVals rs) Nothing -> defaultPutMany rs instance PersistUniqueWrite SqlWriteBackend where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Raw/QQ.hs new/persistent-2.9.0/Database/Persist/Sql/Raw/QQ.hs --- old/persistent-2.8.2/Database/Persist/Sql/Raw/QQ.hs 2017-12-20 19:38:43.000000000 +0100 +++ new/persistent-2.9.0/Database/Persist/Sql/Raw/QQ.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,196 +0,0 @@ -{-| -@since 2.7.2 - -Module: module Database.Persist.Sql.Raw.QQ -Description: QuasiQuoters for performing raw sql queries - -This module exports convenient QuasiQuoters to perform raw SQL queries. -All QuasiQuoters follow the same pattern and are analogous to the similar named -functions exported from 'Database.Persist.Sql.Raw'. Neither the quoted -function's behaviour, nor it's return value is altered during the translation -and all documentation provided with it holds. - -The QuasiQuoters in this module perform a simple substitution on the query text, -that allows value substitutions, table name substitutions as well as column name -substitutions. --} - -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - -module Database.Persist.Sql.Raw.QQ ( - -- * Sql QuasiQuoters - queryQQ - , queryResQQ - , sqlQQ - , executeQQ - , executeCountQQ - ) where - -import Prelude -import Control.Arrow (first, second) -import Control.Monad.Reader (ask) -import Data.Text (pack, unpack) -import Data.Maybe (fromMaybe, Maybe(..)) -import Data.Monoid (mempty, (<>)) -import qualified Language.Haskell.TH as TH -import Language.Haskell.TH.Quote -import Language.Haskell.Meta.Parse - -import Database.Persist.Class (toPersistValue) -import Database.Persist.Sql.Raw (rawSql, rawQuery, rawQueryRes, rawExecute, rawExecuteCount) -import Database.Persist.Sql.Types (connEscapeName) -import Database.Persist.Sql.Orphan.PersistStore (getFieldName, getTableName) - -data Token - = Literal String - | Value String - | TableName String - | ColumnName String - deriving Show - -parseHaskell :: (String -> Token) -> String -> String -> [Token] -parseHaskell cons = go - where - go a [] = [Literal (reverse a)] - go a ('\\':x:xs) = go (x:a) xs - go a ['\\'] = go ('\\':a) [] - go a ('}':xs) = cons (reverse a) : parseStr [] xs - go a (x:xs) = go (x:a) xs - -parseStr :: String -> String -> [Token] -parseStr a [] = [Literal (reverse a)] -parseStr a ('\\':x:xs) = parseStr (x:a) xs -parseStr a ['\\'] = parseStr ('\\':a) [] -parseStr a ('#':'{':xs) = Literal (reverse a) : parseHaskell Value [] xs -parseStr a ('^':'{':xs) = Literal (reverse a) : parseHaskell TableName [] xs -parseStr a ('@':'{':xs) = Literal (reverse a) : parseHaskell ColumnName [] xs -parseStr a (x:xs) = parseStr (x:a) xs - -makeExpr :: TH.ExpQ -> [Token] -> TH.ExpQ -makeExpr fun toks = do - TH.infixE - (Just [| uncurry $(fun) |]) - ([| (=<<) |]) - (Just $ go toks) - - where - go :: [Token] -> TH.ExpQ - go [] = [| return (mempty, mempty) |] - go (Literal a:xs) = - TH.appE - [| fmap $ first (pack a <>) |] - (go xs) - go (Value a:xs) = - TH.appE - [| fmap $ first ("?" <>) . second (toPersistValue $(reifyExp a) :) |] - (go xs) - go (ColumnName a:xs) = do - colN <- TH.newName "field" - TH.infixE - (Just [| getFieldName $(reifyExp a) |]) - [| (>>=) |] - (Just $ TH.lamE [ TH.varP colN ] $ - TH.appE - [| fmap $ first ($(TH.varE colN) <>) |] - (go xs)) - go (TableName a:xs) = do - typeN <- TH.lookupTypeName a >>= \case - Just t -> return t - Nothing -> fail $ "Type not in scope: " ++ show a - tableN <- TH.newName "table" - TH.infixE - (Just $ - TH.appE - [| getTableName |] - (TH.sigE - [| error "record" |] $ - (TH.conT typeN))) - [| (>>=) |] - (Just $ TH.lamE [ TH.varP tableN ] $ - TH.appE - [| fmap $ first ($(TH.varE tableN) <>) |] - (go xs)) - -reifyExp :: String -> TH.Q TH.Exp -reifyExp s = - case parseExp s of - Left e -> TH.reportError e >> [| mempty |] - Right v -> return v - -makeQQ :: TH.Q TH.Exp -> QuasiQuoter -makeQQ x = QuasiQuoter - (makeExpr x . parseStr []) - (error "Cannot use qc as a pattern") - (error "Cannot use qc as a type") - (error "Cannot use qc as a dec") - --- | QuasiQuoter for performing raw sql queries, analoguous to --- 'Database.Persist.Sql.Raw.rawSql' --- --- This and the following are convenient QuasiQuoters to perform raw SQL --- queries. They each follow the same pattern and are analogous to --- the similarly named @raw@ functions. Neither the quoted function's --- behaviour, nor it's return value is altered during the translation and --- all documentation provided with it holds. --- --- These QuasiQuoters perform a simple substitution on the query text, that --- allows value substitutions, table name substitutions as well as column name --- substitutions. --- --- Here is a small example: --- --- Given the following simple model: --- --- @ --- Category --- rgt Int --- lft Int --- @ --- --- We can now execute this raw query: --- --- @ --- let lft = 10 :: Int --- rgt = 20 :: Int --- width = rgt - lft --- in [sqlQQ| --- DELETE FROM ^{Category} WHERE @{CategoryLft} BETWEEN #{lft} AND #{rgt}; --- UPDATE category SET @{CategoryRgt} = @{CategoryRgt} - #{width} WHERE @{CategoryRgt} > #{rgt}; --- UPDATE category SET @{CategoryLft} = @{CategoryLft} - #{width} WHERE @{CategoryLft} > #{rgt}; --- |] --- @ --- --- @^{TableName}@ looks up the table's name and escapes it, @\@{ColumnName}@ --- looks up the column's name and properly escapes it and @#{value}@ inserts --- the value via the usual parameter substitution mechanism. --- --- @since 2.7.2 -sqlQQ :: QuasiQuoter -sqlQQ = makeQQ [| rawSql |] - --- | Analoguous to 'Database.Persist.Sql.Raw.rawExecute' --- --- @since 2.7.2 -executeQQ :: QuasiQuoter -executeQQ = makeQQ [| rawExecute |] - --- | Analoguous to 'Database.Persist.Sql.Raw.rawExecuteCount' --- --- @since 2.7.2 -executeCountQQ :: QuasiQuoter -executeCountQQ = makeQQ [| rawExecuteCount |] - --- | Analoguous to 'Database.Persist.Sql.Raw.rawQuery' --- --- @since 2.7.2 -queryQQ :: QuasiQuoter -queryQQ = makeQQ [| rawQuery |] - --- | Analoguous to 'Database.Persist.Sql.Raw.rawQueryRes' --- --- @since 2.7.2 -queryResQQ :: QuasiQuoter -queryResQQ = makeQQ [| rawQueryRes |] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Run.hs new/persistent-2.9.0/Database/Persist/Sql/Run.hs --- old/persistent-2.8.2/Database/Persist/Sql/Run.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Sql/Run.hs 2018-10-14 08:53:28.000000000 +0200 @@ -6,6 +6,7 @@ import Database.Persist.Class.PersistStore import Database.Persist.Sql.Types +import Database.Persist.Sql.Types.Internal (IsolationLevel) import Database.Persist.Sql.Raw import Data.Pool as P import Control.Monad.Trans.Reader hiding (local) @@ -30,6 +31,14 @@ => ReaderT backend m a -> Pool backend -> m a runSqlPool r pconn = withRunInIO $ \run -> withResource pconn $ run . runSqlConn r +-- | Like 'runSqlPool', but supports specifying an isolation level. +-- +-- @since 2.9.0 +runSqlPoolWithIsolation + :: (MonadUnliftIO m, IsSqlBackend backend) + => ReaderT backend m a -> Pool backend -> IsolationLevel -> m a +runSqlPoolWithIsolation r pconn i = withRunInIO $ \run -> withResource pconn $ run . (\conn -> runSqlConnWithIsolation r conn i) + -- | Like 'withResource', but times out the operation if resource -- allocation does not complete within the given timeout period. -- @@ -56,7 +65,21 @@ runSqlConn r conn = withRunInIO $ \runInIO -> mask $ \restore -> do let conn' = persistBackend conn getter = getStmtConn conn' - restore $ connBegin conn' getter + restore $ connBegin conn' getter Nothing + x <- onException + (restore $ runInIO $ runReaderT r conn) + (restore $ connRollback conn' getter) + restore $ connCommit conn' getter + return x + +-- | Like 'runSqlConn', but supports specifying an isolation level. +-- +-- @since 2.9.0 +runSqlConnWithIsolation :: (MonadUnliftIO m, IsSqlBackend backend) => ReaderT backend m a -> backend -> IsolationLevel -> m a +runSqlConnWithIsolation r conn isolation = withRunInIO $ \runInIO -> mask $ \restore -> do + let conn' = persistBackend conn + getter = getStmtConn conn' + restore $ connBegin conn' getter $ Just isolation x <- onException (restore $ runInIO $ runReaderT r conn) (restore $ connRollback conn' getter) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql/Types/Internal.hs new/persistent-2.9.0/Database/Persist/Sql/Types/Internal.hs --- old/persistent-2.8.2/Database/Persist/Sql/Types/Internal.hs 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/Database/Persist/Sql/Types/Internal.hs 2018-10-14 08:53:45.000000000 +0200 @@ -4,6 +4,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} module Database.Persist.Sql.Types.Internal ( HasPersistBackend (..) @@ -16,6 +17,8 @@ , LogFunc , InsertSqlResult (..) , Statement (..) + , IsolationLevel (..) + , makeIsolationLevelStatement , SqlBackend (..) , SqlBackendCanRead , SqlBackendCanWrite @@ -33,6 +36,8 @@ import Data.Int (Int64) import Data.IORef (IORef) import Data.Map (Map) +import Data.Monoid ((<>)) +import Data.String (IsString) import Data.Text (Text) import Data.Typeable (Typeable) import Database.Persist.Class @@ -62,11 +67,29 @@ -> Acquire (ConduitM () [PersistValue] m ()) } +-- | Please refer to the documentation for the database in question for a full +-- overview of the semantics of the varying isloation levels +data IsolationLevel = ReadUncommitted + | ReadCommitted + | RepeatableRead + | Serializable + deriving (Show, Eq, Enum, Ord, Bounded) + +makeIsolationLevelStatement :: (Monoid s, IsString s) => IsolationLevel -> s +makeIsolationLevelStatement l = "SET TRANSACTION ISOLATION LEVEL " <> case l of + ReadUncommitted -> "READ UNCOMMITTED" + ReadCommitted -> "READ COMMITTED" + RepeatableRead -> "REPEATABLE READ" + Serializable -> "SERIALIZABLE" + data SqlBackend = SqlBackend { connPrepare :: Text -> IO Statement -- | table name, column names, id name, either 1 or 2 statements to run , connInsertSql :: EntityDef -> [PersistValue] -> InsertSqlResult - , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult) -- ^ SQL for inserting many rows and returning their primary keys, for backends that support this functioanlity. If 'Nothing', rows will be inserted one-at-a-time using 'connInsertSql'. + , connInsertManySql :: Maybe (EntityDef -> [[PersistValue]] -> InsertSqlResult) + -- ^ SQL for inserting many rows and returning their primary keys, for + -- backends that support this functioanlity. If 'Nothing', rows will be + -- inserted one-at-a-time using 'connInsertSql'. , connUpsertSql :: Maybe (EntityDef -> Text -> Text) -- ^ Some databases support performing UPSERT _and_ RETURN entity -- in a single call. @@ -100,7 +123,7 @@ -> (Text -> IO Statement) -> EntityDef -> IO (Either [Text] [(Bool, Text)]) - , connBegin :: (Text -> IO Statement) -> IO () + , connBegin :: (Text -> IO Statement) -> Maybe IsolationLevel -> IO () , connCommit :: (Text -> IO Statement) -> IO () , connRollback :: (Text -> IO Statement) -> IO () , connEscapeName :: DBName -> Text @@ -113,6 +136,18 @@ -- many question-mark parameters may be used in a statement -- -- @since 2.6.1 + , connRepsertManySql :: Maybe (EntityDef -> Int -> Text) + -- ^ Some databases support performing bulk an atomic+bulk INSERT where + -- constraint conflicting entities can replace existing entities. + -- + -- This field when set, given + -- * an entity definition + -- * number of records to be inserted + -- should produce a INSERT sql with placeholders for primary+record fields + -- + -- When left as 'Nothing', we default to using 'defaultRepsertMany'. + -- + -- @since 2.9.0 } deriving Typeable instance HasPersistBackend SqlBackend where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/Database/Persist/Sql.hs new/persistent-2.9.0/Database/Persist/Sql.hs --- old/persistent-2.8.2/Database/Persist/Sql.hs 2017-12-24 19:10:34.000000000 +0100 +++ new/persistent-2.9.0/Database/Persist/Sql.hs 2018-10-14 08:53:18.000000000 +0200 @@ -10,12 +10,13 @@ , rawExecute , rawExecuteCount , rawSql - , sqlQQ - , executeQQ , deleteWhereCount , updateWhereCount , transactionSave + , transactionSaveWithIsolation , transactionUndo + , transactionUndoWithIsolation + , IsolationLevel (..) , getStmtConn -- * Internal , module Database.Persist.Sql.Internal @@ -24,10 +25,10 @@ import Database.Persist import Database.Persist.Sql.Types +import Database.Persist.Sql.Types.Internal (IsolationLevel (..)) import Database.Persist.Sql.Class import Database.Persist.Sql.Run hiding (withResourceTimeout) import Database.Persist.Sql.Raw -import Database.Persist.Sql.Raw.QQ import Database.Persist.Sql.Migration import Database.Persist.Sql.Internal @@ -44,7 +45,16 @@ transactionSave = do conn <- ask let getter = getStmtConn conn - liftIO $ connCommit conn getter >> connBegin conn getter + liftIO $ connCommit conn getter >> connBegin conn getter Nothing + +-- | Commit the current transaction and begin a new one with the specified isolation level. +-- +-- @since 2.9.0 +transactionSaveWithIsolation :: MonadIO m => IsolationLevel -> ReaderT SqlBackend m () +transactionSaveWithIsolation isolation = do + conn <- ask + let getter = getStmtConn conn + liftIO $ connCommit conn getter >> connBegin conn getter (Just isolation) -- | Roll back the current transaction and begin a new one. -- @@ -53,4 +63,13 @@ transactionUndo = do conn <- ask let getter = getStmtConn conn - liftIO $ connRollback conn getter >> connBegin conn getter + liftIO $ connRollback conn getter >> connBegin conn getter Nothing + +-- | Roll back the current transaction and begin a new one with the specified isolation level. +-- +-- @since 2.9.0 +transactionUndoWithIsolation :: MonadIO m => IsolationLevel -> ReaderT SqlBackend m () +transactionUndoWithIsolation isolation = do + conn <- ask + let getter = getStmtConn conn + liftIO $ connRollback conn getter >> connBegin conn getter (Just isolation) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.8.2/persistent.cabal new/persistent-2.9.0/persistent.cabal --- old/persistent-2.8.2/persistent.cabal 2018-04-13 09:01:36.000000000 +0200 +++ new/persistent-2.9.0/persistent.cabal 2018-10-14 08:53:03.000000000 +0200 @@ -1,5 +1,5 @@ name: persistent -version: 2.8.2 +version: 2.9.0 license: MIT license-file: LICENSE author: Michael Snoyman <[email protected]> @@ -41,7 +41,6 @@ , vector , attoparsec , template-haskell - , haskell-src-meta , blaze-html >= 0.5 , blaze-markup >= 0.5.1 , silently @@ -74,7 +73,6 @@ Database.Persist.Sql.Internal Database.Persist.Sql.Types Database.Persist.Sql.Raw - Database.Persist.Sql.Raw.QQ Database.Persist.Sql.Run Database.Persist.Sql.Class Database.Persist.Sql.Orphan.PersistQuery
