module UpsertTest where
import Data.Function (on)
import Init
import PersistentTestModels
-- | MongoDB assumes that a @NULL@ value in the database is some "empty"
-- value. So a query that does @+ 2@ to a @NULL@ value results in @2@. SQL
-- databases instead "annihilate" with null, so @NULL + 2 = NULL@.
data BackendNullUpdateBehavior
= AssumeNullIsZero
| Don'tUpdateNull
-- | @UPSERT@ on SQL databses does an "update-or-insert," which preserves
-- all prior values, including keys. MongoDB does not preserve the
-- identifier, so the entity key changes on an upsert.
data BackendUpsertKeyBehavior
= UpsertGenerateNewKey
| UpsertPreserveOldKey
specsWith
:: forall backend m
. (Runner backend m)
=> RunDb backend m
-> BackendNullUpdateBehavior
-> BackendUpsertKeyBehavior
-> Spec
specsWith runDb handleNull handleKey = describe "UpsertTests" $ do
let
ifKeyIsPreserved expectation =
case handleKey of
UpsertGenerateNewKey -> pure ()
UpsertPreserveOldKey -> expectation
describe "upsert" $ do
it "adds a new row with no updates" $ runDb $ do
Entity _ u <- upsert (Upsert "a" "new" "" 2) [UpsertAttr =. "update"]
c <- count ([] :: [Filter (UpsertGeneric backend)])
c @== 1
upsertAttr u @== "new"
it "keeps the existing row" $ runDb $ do
Entity k0 initial <- insertEntity (Upsert "a" "initial" "" 1)
Entity k1 update' <- upsert (Upsert "a" "update" "" 2) []
update' @== initial
ifKeyIsPreserved $ k0 @== k1
it "updates an existing row - assignment" $ runDb $ do
-- #ifdef WITH_MONGODB
-- initial <- insertEntity (Upsert "cow" "initial" "extra" 1)
-- update' <-
-- upsert (Upsert "cow" "wow" "such unused" 2) [UpsertAttr =. "update"]
-- ((==@) `on` entityKey) initial update'
-- upsertAttr (entityVal update') @== "update"
-- upsertExtra (entityVal update') @== "extra"
-- #else
initial <- insertEntity (Upsert "a" "initial" "extra" 1)
update' <-
upsert (Upsert "a" "wow" "such unused" 2) [UpsertAttr =. "update"]
ifKeyIsPreserved $ ((==@) `on` entityKey) initial update'
upsertAttr (entityVal update') @== "update"
upsertExtra (entityVal update') @== "extra"
-- #endif
it "updates existing row - addition " $ runDb $ do
-- #ifdef WITH_MONGODB
-- initial <- insertEntity (Upsert "a1" "initial" "extra" 2)
-- update' <-
-- upsert (Upsert "a1" "wow" "such unused" 2) [UpsertAge +=. 3]
-- ((==@) `on` entityKey) initial update'
-- upsertAge (entityVal update') @== 5
-- upsertExtra (entityVal update') @== "extra"
-- #else
initial <- insertEntity (Upsert "a" "initial" "extra" 2)
update' <-
upsert (Upsert "a" "wow" "such unused" 2) [UpsertAge +=. 3]
ifKeyIsPreserved $ ((==@) `on` entityKey) initial update'
upsertAge (entityVal update') @== 5
upsertExtra (entityVal update') @== "extra"
-- #endif
describe "upsertBy" $ do
let
uniqueEmail = UniqueUpsertBy "a"
_uniqueCity = UniqueUpsertByCity "Boston"
it "adds a new row with no updates" $ runDb $ do
Entity _ u <-
upsertBy
uniqueEmail
(UpsertBy "a" "Boston" "new")
[UpsertByAttr =. "update"]
c <- count ([] :: [Filter (UpsertByGeneric backend)])
c @== 1
upsertByAttr u @== "new"
it "keeps the existing row" $ runDb $ do
Entity k0 initial <- insertEntity (UpsertBy "a" "Boston" "initial")
Entity k1 update' <- upsertBy uniqueEmail (UpsertBy "a" "Boston" "update") []
update' @== initial
ifKeyIsPreserved $ k0 @== k1
it "updates an existing row" $ runDb $ do
-- #ifdef WITH_MONGODB
-- initial <- insertEntity (UpsertBy "ko" "Kumbakonam" "initial")
-- update' <-
-- upsertBy
-- (UniqueUpsertBy "ko")
-- (UpsertBy "ko" "Bangalore" "such unused")
-- [UpsertByAttr =. "update"]
-- ((==@) `on` entityKey) initial update'
-- upsertByAttr (entityVal update') @== "update"
-- upsertByCity (entityVal update') @== "Kumbakonam"
-- #else
initial <- insertEntity (UpsertBy "a" "Boston" "initial")
update' <-
upsertBy
uniqueEmail
(UpsertBy "a" "wow" "such unused")
[UpsertByAttr =. "update"]
ifKeyIsPreserved $ ((==@) `on` entityKey) initial update'
upsertByAttr (entityVal update') @== "update"
upsertByCity (entityVal update') @== "Boston"
-- #endif
it "updates by the appropriate constraint" $ runDb $ do
initBoston <- insertEntity (UpsertBy "bos" "Boston" "bos init")
initKrum <- insertEntity (UpsertBy "krum" "Krum" "krum init")
updBoston <-
upsertBy
(UniqueUpsertBy "bos")
(UpsertBy "bos" "Krum" "unused")
[UpsertByAttr =. "bos update"]
updKrum <-
upsertBy
(UniqueUpsertByCity "Krum")
(UpsertBy "bos" "Krum" "unused")
[UpsertByAttr =. "krum update"]
ifKeyIsPreserved $ ((==@) `on` entityKey) initBoston updBoston
ifKeyIsPreserved $ ((==@) `on` entityKey) initKrum updKrum
entityVal updBoston @== UpsertBy "bos" "Boston" "bos update"
entityVal updKrum @== UpsertBy "krum" "Krum" "krum update"
it "maybe update" $ runDb $ do
let
noAge = PersonMaybeAge "Michael" Nothing
keyNoAge <- insert noAge
noAge2 <- updateGet keyNoAge [PersonMaybeAgeAge +=. Just 2]
-- the correct answer depends on the backend. MongoDB assumes
-- a 'Nothing' value is 0, and does @0 + 2@ for @Just 2@. In a SQL
-- database, @NULL@ annihilates, so @NULL + 2 = NULL@.
personMaybeAgeAge noAge2 @== case handleNull of
AssumeNullIsZero ->
Just 2
Don'tUpdateNull ->
Nothing
describe "putMany" $ do
it "adds new rows when entity has no unique constraints" $ runDb $ do
let
mkPerson name_ = Person1 name_ 25
let
names = ["putMany bob", "putMany bob", "putMany smith"]
let
records = map mkPerson names
_ <- putMany records
entitiesDb <- selectList [Person1Name <-. names] []
let
recordsDb = fmap entityVal entitiesDb
recordsDb @== records
deleteWhere [Person1Name <-. names]
it "adds new rows when no conflicts" $ runDb $ do
let
mkUpsert e = Upsert e "new" "" 1
let
keys = ["putMany1", "putMany2", "putMany3"]
let
vals = map mkUpsert keys
_ <- putMany vals
Just (Entity _ v1) <- getBy $ UniqueUpsert "putMany1"
Just (Entity _ v2) <- getBy $ UniqueUpsert "putMany2"
Just (Entity _ v3) <- getBy $ UniqueUpsert "putMany3"
[v1, v2, v3] @== vals
deleteBy $ UniqueUpsert "putMany1"
deleteBy $ UniqueUpsert "putMany2"
deleteBy $ UniqueUpsert "putMany3"
it "handles conflicts by replacing old keys with new records" $ runDb $ do
let
mkUpsert1 e = Upsert e "new" "" 1
let
mkUpsert2 e = Upsert e "new" "" 2
let
vals = map mkUpsert2 ["putMany4", "putMany5", "putMany6", "putMany7"]
Entity k1 _ <- insertEntity $ mkUpsert1 "putMany4"
Entity k2 _ <- insertEntity $ mkUpsert1 "putMany5"
_ <- putMany $ mkUpsert1 "putMany4" : vals
Just e1 <- getBy $ UniqueUpsert "putMany4"
Just e2 <- getBy $ UniqueUpsert "putMany5"
Just e3@(Entity k3 _) <- getBy $ UniqueUpsert "putMany6"
Just e4@(Entity k4 _) <- getBy $ UniqueUpsert "putMany7"
[e1, e2, e3, e4]
@== [ Entity k1 (mkUpsert2 "putMany4")
, Entity k2 (mkUpsert2 "putMany5")
, Entity k3 (mkUpsert2 "putMany6")
, Entity k4 (mkUpsert2 "putMany7")
]
deleteBy $ UniqueUpsert "putMany4"
deleteBy $ UniqueUpsert "putMany5"
deleteBy $ UniqueUpsert "putMany6"
deleteBy $ UniqueUpsert "putMany7"