persistent 2.8.2 → 2.9.0
raw patch · 12 files changed
+830/−237 lines, 12 filesdep −haskell-src-metadep ~http-api-data
Dependencies removed: haskell-src-meta
Dependency ranges changed: http-api-data
Files
- ChangeLog.md +8/−0
- Database/Persist/Class.hs +70/−0
- Database/Persist/Class/PersistStore.hs +412/−3
- Database/Persist/Class/PersistUnique.hs +227/−6
- Database/Persist/Sql.hs +24/−5
- Database/Persist/Sql/Orphan/PersistQuery.hs +2/−3
- Database/Persist/Sql/Orphan/PersistStore.hs +18/−12
- Database/Persist/Sql/Orphan/PersistUnique.hs +7/−6
- Database/Persist/Sql/Raw/QQ.hs +0/−196
- Database/Persist/Sql/Run.hs +24/−1
- Database/Persist/Sql/Types/Internal.hs +37/−2
- persistent.cabal +1/−3
ChangeLog.md view
@@ -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.
Database/Persist/Class.hs view
@@ -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 (..)
Database/Persist/Class/PersistStore.hs view
@@ -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
Database/Persist/Class/PersistUnique.hs view
@@ -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
Database/Persist/Sql.hs view
@@ -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,8 +45,17 @@ 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. -- -- @since 1.2.0@@ -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)
Database/Persist/Sql/Orphan/PersistQuery.hs view
@@ -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
Database/Persist/Sql/Orphan/PersistStore.hs view
@@ -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
Database/Persist/Sql/Orphan/PersistUnique.hs view
@@ -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
− Database/Persist/Sql/Raw/QQ.hs
@@ -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 |]
Database/Persist/Sql/Run.hs view
@@ -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)
Database/Persist/Sql/Types/Internal.hs view
@@ -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
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.8.2+version: 2.9.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -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