{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module UniqueTest where
import Init
share [mkPersist sqlSettings, mkMigrate "uniqueMigrate"] [persistLowerCase|
TestNonNull
fieldA Int
UniqueTestNonNull fieldA sql=UniqueTestNonNull !force
deriving Eq Show
TestNull
fieldA Int
fieldB Int Maybe
UniqueTestNull fieldA fieldB sql=UniqueTestNonNullSqlName !force
deriving Eq Show
TestCheckmark
name Text
value Text
active Checkmark nullable
UniqueTestCheckmark name active !force
deriving Eq Show
|]
cleanDB :: (MonadIO m, PersistQuery backend, PersistEntityBackend TestNonNull ~ backend) => ReaderT backend m ()
cleanDB = do
deleteWhere ([] :: [Filter TestNonNull])
deleteWhere ([] :: [Filter TestNull])
specsWith :: Runner SqlBackend m => RunDb SqlBackend m -> Spec
specsWith runDb =
describe "uniqueness constraints" $ do
it "are respected for non-nullable Ints" $ do
let ins = insert . TestNonNull
(runDb $ void $ ins 1 >> ins 2)
(runDb $ void $ ins 1 >> ins 2 >> ins 1) `shouldThrow` anyException
(runDb $ void $ ins 1 >>= \k -> ins 2 >> delete k >> ins 1)
it "are respected for nullable Ints" $ do
let ins a b = insert $ TestNull a b
ctx = ins 1 Nothing >> ins 1 Nothing >> ins 1 Nothing >>
ins 1 (Just 3) >> ins 1 (Just 4)
(runDb $ void ctx)
(runDb $ void $ ctx >> ins 1 (Just 3)) `shouldThrow` anyException
(runDb $ void $ ctx >> ins 1 (Just 4)) `shouldThrow` anyException
(runDb $ void $ ctx >>= \k -> delete k >> ins 1 (Just 4))
it "work for Checkmark" $ do
let ins k v a = insert $ TestCheckmark k v a
ctx = ins "name" "John" Inactive
>> ins "name" "Stewart" Inactive
>> ins "name" "Doroty" Active
>> ins "color" "blue" Inactive
(runDb $ void ctx)
(runDb $ void $ ctx >> ins "name" "Melissa" Active) `shouldThrow` anyException
(runDb $ void $ ctx >> ins "name" "Melissa" Inactive)
(runDb $ void $ ctx >>= flip update [TestCheckmarkActive =. Active])
(runDb $ void $ do
void ctx
updateWhere [TestCheckmarkName ==. "name"]
[TestCheckmarkActive =. Inactive]
ins "name" "Melissa" Active)