persistent 2.9.0 → 2.9.1
raw patch · 5 files changed
+99/−31 lines, 5 filesdep ~http-api-data
Dependency ranges changed: http-api-data
Files
- ChangeLog.md +4/−0
- Database/Persist/Class/PersistUnique.hs +26/−20
- Database/Persist/Sql/Orphan/PersistUnique.hs +14/−8
- Database/Persist/Sql/Run.hs +52/−0
- persistent.cabal +3/−3
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for persistent +## 2.9.1++* Fix [#847](https://github.com/yesodweb/persistent/issues/847): SQL error with `putMany` on Sqlite when Entity has no unique index.+ ## 2.9.0 * Added support for SQL isolation levels to via SqlBackend. [#812]
Database/Persist/Class/PersistUnique.hs view
@@ -502,31 +502,37 @@ -> ReaderT backend m () defaultPutMany [] = return () defaultPutMany rsD = do- let rs = nubBy ((==) `on` persistUniqueKeyValues) (reverse rsD)+ let uKeys = persistUniqueKeys . head $ rsD+ case uKeys of+ [] -> insertMany_ rsD+ _ -> go+ where+ go = do+ let rs = nubBy ((==) `on` persistUniqueKeyValues) (reverse rsD) - -- lookup record(s) by their unique key- mEsOld <- mapM getByValue rs+ -- lookup record(s) by their unique key+ mEsOld <- mapM getByValue rs - -- find pre-existing entities and corresponding (incoming) records- let merge (Just x) y = Just (x, y)- merge _ _ = Nothing- let mEsOldAndRs = zipWith merge mEsOld rs- let esOldAndRs = catMaybes mEsOldAndRs+ -- find pre-existing entities and corresponding (incoming) records+ let merge (Just x) y = Just (x, y)+ merge _ _ = Nothing+ let mEsOldAndRs = zipWith merge mEsOld rs+ let esOldAndRs = catMaybes mEsOldAndRs - -- determine records to insert- let esOld = fmap fst esOldAndRs- let rsOld = fmap entityVal esOld- let rsNew = deleteFirstsBy ((==) `on` persistUniqueKeyValues) rs rsOld+ -- determine records to insert+ let esOld = fmap fst esOldAndRs+ let rsOld = fmap entityVal esOld+ let rsNew = deleteFirstsBy ((==) `on` persistUniqueKeyValues) rs rsOld - -- determine records to update- let rsUpd = fmap snd esOldAndRs- let ksOld = fmap entityKey esOld- let krs = zip ksOld rsUpd+ -- determine records to update+ let rsUpd = fmap snd esOldAndRs+ let ksOld = fmap entityKey esOld+ let krs = zip ksOld rsUpd - -- insert `new` records- insertMany_ rsNew- -- replace existing records- mapM_ (uncurry replace) krs+ -- insert `new` records+ insertMany_ rsNew+ -- replace existing records+ mapM_ (uncurry replace) krs -- | The _essence_ of a unique record. -- useful for comaparing records in haskell land for uniqueness equality.
Database/Persist/Sql/Orphan/PersistUnique.hs view
@@ -75,14 +75,20 @@ putMany [] = return () putMany rsD = do- conn <- ask- let rs = nubBy ((==) `on` persistUniqueKeyValues) (reverse rsD)- let ent = entityDef rs- let nr = length rs- let toVals r = map toPersistValue $ toPersistFields r- case connPutManySql conn of- (Just mkSql) -> rawExecute (mkSql ent nr) (concatMap toVals rs)- Nothing -> defaultPutMany rs+ let uKeys = persistUniqueKeys . head $ rsD+ case uKeys of+ [] -> insertMany_ rsD+ _ -> go+ where+ go = do+ let rs = nubBy ((==) `on` persistUniqueKeyValues) (reverse rsD)+ let ent = entityDef rs+ let nr = length rs+ let toVals r = map toPersistValue $ toPersistFields r+ conn <- ask+ case connPutManySql conn of+ (Just mkSql) -> rawExecute (mkSql ent nr) (concatMap toVals rs)+ Nothing -> defaultPutMany rs instance PersistUniqueWrite SqlWriteBackend where deleteBy uniq = withReaderT persistBackend $ deleteBy uniq
Database/Persist/Sql/Run.hs view
@@ -131,6 +131,58 @@ askLogFunc = withRunInIO $ \run -> return $ \a b c d -> run (monadLoggerLog a b c d) +-- | Create a connection and run sql queries within it. This function+-- automatically closes the connection on it's completion.+--+-- === __Example usage__+--+-- > {-# LANGUAGE GADTs #-}+-- > {-# LANGUAGE ScopedTypeVariables #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE MultiParamTypeClasses #-}+-- > {-# LANGUAGE TypeFamilies#-}+-- > {-# LANGUAGE TemplateHaskell#-}+-- > {-# LANGUAGE QuasiQuotes#-}+-- > {-# LANGUAGE GeneralizedNewtypeDeriving #-}+-- > +-- > import Control.Monad.IO.Class (liftIO)+-- > import Control.Monad.Logger+-- > import Conduit+-- > import Database.Persist+-- > import Database.Sqlite+-- > import Database.Persist.Sqlite+-- > import Database.Persist.TH+-- > +-- > share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+-- > Person+-- > name String+-- > age Int Maybe+-- > deriving Show+-- > |]+-- > +-- > openConnection :: LogFunc -> IO SqlBackend+-- > openConnection logfn = do+-- > conn <- open "/home/sibi/test.db"+-- > wrapConnection conn logfn+-- >+-- > main :: IO ()+-- > main = do+-- > runNoLoggingT $ runResourceT $ withSqlConn openConnection (\backend ->+-- > flip runSqlConn backend $ do+-- > runMigration migrateAll+-- > insert_ $ Person "John doe" $ Just 35+-- > insert_ $ Person "Divya" $ Just 36+-- > (pers :: [Entity Person]) <- selectList [] []+-- > liftIO $ print pers+-- > return ()+-- > )+--+-- On executing it, you get this output:+--+-- > Migrating: CREATE TABLE "person"("id" INTEGER PRIMARY KEY,"name" VARCHAR NOT NULL,"age" INTEGER NULL)+-- > [Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = Person {personName = "John doe", personAge = Just 35}},Entity {entityKey = PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = Person {personName = "Hema", personAge = Just 36}}]+-- + withSqlConn :: (MonadUnliftIO m, MonadLogger m, IsSqlBackend backend) => (LogFunc -> IO backend) -> (backend -> m a) -> m a
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.9.0+version: 2.9.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -33,7 +33,7 @@ , resourcet >= 1.1.10 , resource-pool >= 0.2.2.0 , path-pieces >= 0.1- , http-api-data >= 0.2 && < 0.4+ , http-api-data >= 0.2 , aeson >= 0.5 , monad-logger >= 0.3.28 , base64-bytestring@@ -98,7 +98,7 @@ , attoparsec , transformers , path-pieces- , http-api-data >= 0.2 && < 0.4+ , http-api-data , aeson , resourcet , monad-logger