persistent-typed-db 0.1.0.1 → 0.1.0.2
raw patch · 4 files changed
+53/−47 lines, 4 filesdep ~aesondep ~persistentPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson, persistent
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- persistent-typed-db.cabal +2/−2
- src/Database/Persist/Typed.hs +46/−45
- test/EsqueletoSpec.hs +1/−0
CHANGELOG.md view
@@ -1,5 +1,9 @@ # CHANGELOG +# 0.1.0.2++- Fix test suite to build with `persistent-2.11`+ # 0.1.0.1 - Fix test suite to build for stackage
persistent-typed-db.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: persistent-typed-db-version: 0.1.0.1+version: 0.1.0.2 synopsis: Type safe access to multiple database schemata. description: See README.md for more details, examples, and fun. category: Web@@ -36,7 +36,7 @@ , http-api-data , monad-logger , path-pieces- , persistent >=2.10.0+ , persistent >=2.11.0 && < 2.12 , persistent-template >=2.7.0 , resource-pool , resourcet >=1.2.0
src/Database/Persist/Typed.hs view
@@ -44,29 +44,27 @@ import Data.Coerce (coerce) import Data.Conduit ((.|)) import qualified Data.Conduit.List as CL+import qualified Data.Foldable as Foldable import Data.Int (Int64)-import Data.List (find, inits, transpose)+import Data.List (find, inits, transpose, nubBy)+import qualified Data.List.NonEmpty as NEL import Data.Maybe (isJust) import Data.Monoid (mappend, (<>)) import Data.Pool (Pool) import Data.Text (Text) import qualified Data.Text as Text-import qualified Data.Text as T import Database.Persist.Sql hiding (deleteWhereCount, updateWhereCount)-import qualified Data.Foldable as Foldable import Database.Persist.Sql.Types.Internal (IsPersistBackend (..))-import Database.Persist.Sql.Util (dbColumns, dbIdColumns,- entityColumnNames,- isIdField,- keyAndEntityColumnNames,- parseEntityValues)+import Database.Persist.Sql.Util import Database.Persist.TH (MkPersistSettings, mkPersistSettings) import Language.Haskell.TH (Name, Type (..)) import Web.HttpApiData (FromHttpApiData, ToHttpApiData) import Web.PathPieces (PathPiece)+import Database.Persist.Class+import Data.Function (on) -- | A wrapper around 'SqlBackend' type. To specialize this to a specific -- database, fill in the type parameter.@@ -522,35 +520,27 @@ Left err -> error $ "selectKeysImpl: keyFromValues failed" <> show err instance PersistUniqueWrite (SqlFor db) where- upsert record updates = specializeQuery $ do+ upsertBy uniqueKey record updates = specializeQuery $ do conn <- ask- uniqueKey <- withReaderT SqlFor $ onlyUnique record+ let escape = connEscapeName conn+ let refCol n = Text.concat [escape (entityDB t), ".", n]+ let mkUpdateText = mkUpdateText' escape refCol case connUpsertSql conn of Just upsertSql -> case updates of- [] -> withReaderT SqlFor $ defaultUpsert record updates+ [] -> generalizeQuery $ defaultUpsertBy uniqueKey record updates _:_ -> do- let upds = Text.intercalate "," $ map (go' . go) updates- sql = upsertSql t (pure (onlyOneUniqueDef (Just record))) upds+ let upds = Text.intercalate "," $ map mkUpdateText updates+ sql = upsertSql t (NEL.fromList $ persistUniqueToFieldNames uniqueKey) upds vals = map toPersistValue (toPersistFields record) ++ map updatePersistValue updates ++ unqs uniqueKey - go'' n Assign = n <> "=?"- go'' n Add = Text.concat [n, "=", escape (entityDB t) <> ".", n, "+?"]- go'' n Subtract = Text.concat [n, "=", escape (entityDB t) <> ".", n, "-?"]- go'' n Multiply = Text.concat [n, "=", escape (entityDB t) <> ".", n, "*?"]- go'' n Divide = Text.concat [n, "=", escape (entityDB t) <> ".", n, "/?"]- go'' _ (BackendSpecificUpdate up) = error $ Text.unpack $ "BackendSpecificUpdate" `Data.Monoid.mappend` up `mappend` "not supported"-- go' (x, pu) = go'' (connEscapeName conn x) pu- go x = (fieldDB $ updateFieldDef x, updateUpdate x)- x <- rawSql sql vals return $ head x- Nothing -> withReaderT SqlFor $ defaultUpsert record updates+ Nothing -> generalizeQuery $ defaultUpsertBy uniqueKey record updates where t = entityDef $ Just record- unqs uniqueKey = concatMap persistUniqueToValues [uniqueKey]+ unqs uniqueKey' = concatMap persistUniqueToValues [uniqueKey'] deleteBy uniq = specializeQuery $ do conn <- ask@@ -568,7 +558,6 @@ , " WHERE " , Text.intercalate " AND " $ map (go' conn) $ go uniq] - instance PersistUniqueRead (SqlFor a) where getBy uniq = specializeQuery $ do conn <- ask@@ -691,31 +680,18 @@ rawExecute (sql conn columnNames) vals where entDef = entityDef $ map entityVal es- sql conn columnNames = T.concat+ sql conn columnNames = Text.concat [ command , " INTO " , connEscapeName conn (entityDB entDef) , "("- , T.intercalate "," columnNames+ , Text.intercalate "," columnNames , ") VALUES ("- , T.intercalate "),(" $ replicate (length es) $ T.intercalate "," $ map (const "?") columnNames+ , Text.intercalate "),(" $ replicate (length es) $ Text.intercalate "," $ map (const "?") columnNames , ")" ] vals = Foldable.foldMap entityValues es -updateFieldDef :: PersistEntity v => Update v -> FieldDef-updateFieldDef (Update f _ _) =- persistFieldDef f-updateFieldDef BackendUpdate {} =- error "updateFieldDef did not expect BackendUpdate"---updatePersistValue :: Update v -> PersistValue-updatePersistValue (Update _ v _) =- toPersistValue v-updatePersistValue BackendUpdate {} =- error "updatePersistValue did not expect BackendUpdate"- data OrNull = OrNullYes | OrNullNo filterClause :: (PersistEntity val, PersistEntityBackend val ~ SqlFor a)@@ -846,9 +822,9 @@ filterValueToPersistValues :: forall a. PersistField a => FilterValue a -> [PersistValue] filterValueToPersistValues v = case v of- FilterValue a -> map toPersistValue [a]+ FilterValue a -> map toPersistValue [a] FilterValues as -> map toPersistValue as- UnsafeValue a -> map toPersistValue [a]+ UnsafeValue a -> map toPersistValue [a] orNullSuffix = case orNull of@@ -966,4 +942,29 @@ onlyOneUniqueDef prxy = case entityUniques (entityDef prxy) of [uniq] -> uniq- _ -> error "impossible due to OnlyOneUniqueKey constraint"+ _ -> error "impossible due to OnlyOneUniqueKey constraint"++-- | The slow but generic 'upsertBy' implementation for any 'PersistUniqueRead'.+-- * Lookup corresponding entities (if any) 'getBy'.+-- * If the record exists, update using 'updateGet'.+-- * If it does not exist, insert using 'insertEntity'.+-- @since 2.11+defaultUpsertBy+ :: ( PersistEntityBackend record ~ backend+ , PersistEntity record+ , BaseBackend backend ~ backend+ , BackendCompatible SqlBackend backend+ , MonadIO m+ , PersistStoreWrite backend+ , PersistUniqueRead backend+ )+ => Unique record -- ^ uniqueness constraint to find by+ -> record -- ^ new record to insert+ -> [Update record] -- ^ updates to perform if the record already exists+ -> ReaderT backend m (Entity record) -- ^ the record in the database after the operation+defaultUpsertBy uniqueKey record updates = do+ mrecord <- getBy uniqueKey+ maybe (insertEntity record) (`updateGetEntity` updates) mrecord+ where+ updateGetEntity (Entity k _) upds =+ (Entity k) `fmap` (updateGet k upds)
test/EsqueletoSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyDataDecls #-}