persistent 2.14.4.5 → 2.14.5.0
raw patch · 7 files changed
+119/−21 lines, 7 files
Files
- ChangeLog.md +10/−2
- Database/Persist/Class/PersistUnique.hs +52/−1
- Database/Persist/Compatible/Types.hs +2/−1
- Database/Persist/Sql/Orphan/PersistQuery.hs +2/−9
- Database/Persist/Sql/Orphan/PersistUnique.hs +36/−6
- Database/Persist/Sql/Util.hs +16/−1
- persistent.cabal +1/−1
ChangeLog.md view
@@ -1,8 +1,16 @@ # Changelog for persistent +## 2.14.5.0++* [#1469](https://github.com/yesodweb/persistent/pull/1469)+ * Change default implementation for `insertUnique_` to not perform+ unecessary queries (mirrors 1449)+* [#1437](https://github.com/yesodweb/persistent/pull/1437)+ * Add `existsBy` to `PersistUniqueRead`+ ## 2.14.4.5 -* [#1460] https://github.com/yesodweb/persistent/pull/1468+* [#1460](https://github.com/yesodweb/persistent/pull/1468) * Remove extraneous `map toPersistValue` call in the `mkInsertValues` function, as it evaluates to `id`. * [#1476](https://github.com/yesodweb/persistent/pull/1476)@@ -10,7 +18,7 @@ ## 2.14.4.4 -* [#1460] https://github.com/yesodweb/persistent/pull/1460+* [#1460](https://github.com/yesodweb/persistent/pull/1460) * Fix a problem where a `Primary` key causes `mkPersist` to generate code that doesn't compile under `NoFieldSelectors`
Database/Persist/Class/PersistUnique.hs view
@@ -33,7 +33,7 @@ import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map-import Data.Maybe (catMaybes)+import Data.Maybe (catMaybes, isJust) import GHC.TypeLits (ErrorMessage(..)) import Database.Persist.Class.PersistEntity@@ -78,6 +78,26 @@ :: forall record m. (MonadIO m, PersistRecordBackend record backend) => Unique record -> ReaderT backend m (Maybe (Entity record)) + -- | Returns True if a record with this unique key exists, otherwise False.+ --+ -- === __Example usage__+ --+ -- With <#schema-persist-unique-1 schema-1> and <#dataset-persist-unique-1 dataset-1>:+ --+ -- > existsBySpjName :: MonadIO m => ReaderT SqlBackend m Bool+ -- > existsBySpjName = existsBy $ UniqueUserName "SPJ"+ --+ -- > spjEntExists <- existsBySpjName+ --+ -- The above query when applied on <#dataset-persist-unique-1 dataset-1>, will return+ -- the value True.+ --+ -- @since 2.14.5+ existsBy+ :: forall record m. (MonadIO m, PersistRecordBackend record backend)+ => Unique record -> ReaderT backend m Bool+ existsBy uniq = isJust <$> getBy uniq+ -- | Some functions in this module ('insertUnique', 'insertBy', and -- 'replaceUnique') first query the unique indexes to check for -- conflicts. You could instead optimistically attempt to perform the@@ -138,6 +158,37 @@ conflict <- checkUnique datum case conflict of Nothing -> Just `liftM` insert datum+ Just _ -> return Nothing++ -- | Same as 'insertUnique' but doesn't return a @Key@.+ --+ -- === __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>.+ --+ -- @since 2.14.5.0+ insertUnique_+ :: forall record m. (MonadIO m, PersistRecordBackend record backend, SafeToInsert record)+ => record -> ReaderT backend m (Maybe ())+ insertUnique_ datum = do+ conflict <- checkUnique datum+ case conflict of+ Nothing -> Just `liftM` insert_ datum Just _ -> return Nothing -- | Update based on a uniqueness constraint or insert:
Database/Persist/Compatible/Types.hs view
@@ -12,10 +12,10 @@ ( Compatible(..) ) where +import Control.Monad.Trans.Reader (withReaderT) import Data.Aeson import Database.Persist.Class import Database.Persist.Sql.Class-import Control.Monad.Trans.Reader (withReaderT) -- | A newtype wrapper for compatible backends, mainly useful for @DerivingVia@.@@ -104,6 +104,7 @@ instance (HasPersistBackend b, BackendCompatible b s, PersistUniqueRead b) => PersistUniqueRead (Compatible b s) where getBy = withReaderT (projectBackend @b @s . unCompatible) . getBy+ existsBy = withReaderT (projectBackend @b @s . unCompatible) . existsBy instance (HasPersistBackend b, BackendCompatible b s, PersistStoreWrite b) => PersistStoreWrite (Compatible b s) where insert = withReaderT (projectBackend @b @s . unCompatible) . insert
Database/Persist/Sql/Orphan/PersistQuery.hs view
@@ -41,6 +41,7 @@ , keyAndEntityColumnNames , mkUpdateText , parseEntityValues+ , parseExistsResult , updatePersistValue ) @@ -82,15 +83,7 @@ ] withRawQuery sql (getFiltsValues conn filts) $ do mm <- CL.head- case mm of- Just [PersistBool b] -> return b -- Postgres- Just [PersistInt64 i] -> return $ i > 0 -- MySQL, SQLite- Just [PersistDouble i] -> return $ (truncate i :: Int64) > 0 -- gb oracle- Just [PersistByteString i] -> case readInteger i of -- gb mssql- Just (ret,"") -> return $ ret > 0- xs -> error $ "invalid number i["++show i++"] xs[" ++ show xs ++ "]"- Just xs -> error $ "PersistQuery.exists: Expected a boolean, int, double, or bytestring; got: " ++ show xs ++ " for query: " ++ show sql- Nothing -> error $ "PersistQuery.exists: Expected a boolean, int, double, or bytestring; got: Nothing for query: " ++ show sql+ return $ parseExistsResult mm sql "PersistQuery.exists" where t = entityDef $ dummyFromFilts filts
Database/Persist/Sql/Orphan/PersistUnique.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE ExplicitForAll #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Database.Persist.Sql.Orphan.PersistUnique ()@@ -8,18 +8,25 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader (ask) import qualified Data.Conduit.List as CL+import Data.Foldable (toList) import Data.Function (on) import Data.List (nubBy) import qualified Data.Text as T-import Data.Foldable (toList) import Database.Persist-import Database.Persist.Class.PersistUnique (defaultUpsertBy, defaultPutMany, persistUniqueKeyValues)+import Database.Persist.Class.PersistUnique+ (defaultPutMany, defaultUpsertBy, persistUniqueKeyValues) -import Database.Persist.Sql.Types.Internal-import Database.Persist.Sql.Raw import Database.Persist.Sql.Orphan.PersistStore (withRawQuery)-import Database.Persist.Sql.Util (dbColumns, parseEntityValues, updatePersistValue, mkUpdateText')+import Database.Persist.Sql.Raw+import Database.Persist.Sql.Types.Internal+import Database.Persist.Sql.Util+ ( dbColumns+ , mkUpdateText'+ , parseEntityValues+ , parseExistsResult+ , updatePersistValue+ ) instance PersistUniqueWrite SqlBackend where upsertBy uniqueKey record updates = do@@ -110,11 +117,34 @@ t = entityDef $ dummyFromUnique uniq toFieldNames' = toList . fmap snd . persistUniqueToFieldNames + existsBy uniq = do+ conn <- ask+ let sql =+ T.concat+ [ "SELECT EXISTS(SELECT 1 FROM "+ , connEscapeTableName conn t+ , " WHERE "+ , sqlClause conn+ , ")"+ ]+ uvals = persistUniqueToValues uniq+ withRawQuery sql uvals $ do+ mm <- CL.head+ return $ parseExistsResult mm sql "PersistUnique.existsBy"+ where+ sqlClause conn =+ T.intercalate " AND " $ map (go conn) $ toFieldNames' uniq+ go conn x = connEscapeFieldName conn x `mappend` "=?"+ t = entityDef $ dummyFromUnique uniq+ toFieldNames' = toList . fmap snd . persistUniqueToFieldNames+ instance PersistUniqueRead SqlReadBackend where getBy uniq = withBaseBackend $ getBy uniq+ existsBy uniq = withBaseBackend $ existsBy uniq instance PersistUniqueRead SqlWriteBackend where getBy uniq = withBaseBackend $ getBy uniq+ existsBy uniq = withBaseBackend $ existsBy uniq dummyFromUnique :: Unique v -> Maybe v dummyFromUnique _ = Nothing
Database/Persist/Sql/Util.hs view
@@ -18,8 +18,11 @@ , parenWrapped , mkInsertValues , mkInsertPlaceholders+ , parseExistsResult ) where +import Data.ByteString.Char8 (readInteger)+import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Maybe as Maybe import Data.Text (Text, pack)@@ -34,7 +37,7 @@ , FieldNameHS(FieldNameHS) , PersistEntity(..) , PersistUpdate(..)- , PersistValue+ , PersistValue(..) , Update(..) , compositeFields , entityPrimary@@ -270,3 +273,15 @@ Just (escape (fieldDB fd), "?") Just _ -> Nothing++parseExistsResult :: Maybe [PersistValue] -> Text -> String -> Bool+parseExistsResult mm sql errloc =+ case mm of+ Just [PersistBool b] -> b -- Postgres+ Just [PersistInt64 i] -> i > 0 -- MySQL, SQLite+ Just [PersistDouble i] -> (truncate i :: Int64) > 0 -- gb oracle+ Just [PersistByteString i] -> case readInteger i of -- gb mssql+ Just (ret,"") -> ret > 0+ xs -> error $ "invalid number i["++show i++"] xs[" ++ show xs ++ "]"+ Just xs -> error $ errloc ++ ": Expected a boolean, int, double, or bytestring; got: " ++ show xs ++ " for query: " ++ show sql+ Nothing -> error $ errloc ++ ": Expected a boolean, int, double, or bytestring; got: Nothing for query: " ++ show sql
persistent.cabal view
@@ -1,5 +1,5 @@ name: persistent-version: 2.14.4.5+version: 2.14.5.0 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>