{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module PersistentTest
( module PersistentTest
, cleanDB
, testMigrate
, noPrefixMigrate
) where
import Control.Monad.Fail
import Control.Monad.IO.Class
import Data.Aeson
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Functor.Constant
import Data.Functor.Identity
import qualified Data.HashMap.Lazy as M
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Test.Hspec.QuickCheck(prop)
import Test.HUnit hiding (Test)
import UnliftIO (MonadUnliftIO, catch)
import Web.PathPieces (PathPiece (..))
import Database.Persist
import Init
import PersistentTestModels
import PersistTestPetType
import PersistTestPetCollarType
catchPersistException :: (MonadUnliftIO m, MonadFail m) => m a -> b -> m b
catchPersistException action errValue = do
Left res <-
(Right `fmap` action) `catch`
(\(_::PersistException) -> return $ Left errValue)
return res
filterOrSpecs
:: forall m backend. Runner backend m
=> RunDb backend m
-> Spec
filterOrSpecs runDb = describe "FilterOr" $ do
it "FilterOr []" $ runDb $ do
let p = Person "z" 1 Nothing
_ <- insert p
ps <- selectList [FilterOr []] [Desc PersonAge]
assertEmpty ps
it "||. []" $ runDb $ do
let p = Person "z" 1 Nothing
_ <- insert p
c <- count $ [PersonName ==. "a"] ||. []
c @== (1::Int)
_polymorphic :: (MonadFail m, MonadIO m, PersistQuery backend, BaseBackend backend ~ PersistEntityBackend Pet) => ReaderT backend m ()
_polymorphic = do
((Entity id' _):_) <- selectList [] [LimitTo 1]
_ <- selectList [PetOwnerId ==. id'] []
_ <- insert $ Pet id' "foo" Cat
return ()
type ASetter s t a b = (a -> Identity b) -> s -> Identity t
set :: ASetter s t a b -> b -> s -> t
set l b = runIdentity . (l (\_ -> Identity b))
type Getting r s t a b = (a -> Constant r b) -> s -> Constant r t
view :: s -> Getting a s t a b -> a
view s l = getConstant (l Constant s)
specsWith :: forall backend m. Runner backend m => RunDb backend m -> Spec
specsWith runDb = describe "persistent" $ do
it "fieldLens" $ do
let michael = Entity undefined $ Person "Michael" 28 Nothing :: Entity Person
michaelP1 = Person "Michael" 29 Nothing :: Person
view michael (fieldLens PersonAge) @?= 28
entityVal (set (fieldLens PersonAge) 29 michael) @?= michaelP1
it "FilterAnd []" $ runDb $ do
let p = Person "z" 1 Nothing
_ <- insert p
ps <- selectList [FilterAnd []] [Desc PersonAge]
assertNotEmpty ps
it "order of opts is irrelevant" $ runDb $ do
let eq (a, b, _) (c, d) = (a, b) @== (c, d)
limitOffsetOrder' :: [SelectOpt Person] -> (Int, Int, [SelectOpt Person])
limitOffsetOrder' = limitOffsetOrder
limitOffsetOrder' [Desc PersonAge] `eq` (0, 0)
limitOffsetOrder' [LimitTo 2, Desc PersonAge] `eq` (2, 0)
limitOffsetOrder' [Desc PersonAge, LimitTo 2] `eq` (2, 0)
limitOffsetOrder' [LimitTo 2, Desc PersonAge, OffsetBy 3] `eq` (2, 3)
insertMany_ [ Person "z" 1 Nothing
, Person "y" 2 Nothing
, Person "x" 1 Nothing
, Person "w" 2 Nothing
, Person "v" 1 Nothing
, Person "u" 2 Nothing
]
a <- map (personName . entityVal) <$> selectList [] [Desc PersonAge, Asc PersonName, OffsetBy 2, LimitTo 3]
a @== ["y", "v", "x"]
b <- map (personName . entityVal) <$> selectList [] [OffsetBy 2, Desc PersonAge, LimitTo 3, Asc PersonName]
b @== a
c <- map (personName . entityVal) <$> selectList [] [OffsetBy 2, Desc PersonAge, LimitTo 3, Asc PersonName, LimitTo 1, OffsetBy 1]
c @== a
it "passes the general tests" $ runDb $ do
let mic26 = Person "Michael" 26 Nothing
micK <- insert mic26
results <- selectList [PersonName ==. "Michael"] []
results @== [Entity micK mic26]
results' <- selectList [PersonAge <. 28] []
results' @== [Entity micK mic26]
p28 <- updateGet micK [PersonAge =. 28]
personAge p28 @== 28
updateWhere [PersonName ==. "Michael"] [PersonAge =. 29]
uc <- count [PersonName ==. "Michael"]
uc @== 1
Just mic29 <- get micK
personAge mic29 @== 29
let eli = Person "Eliezer" 2 $ Just "blue"
_ <- insert eli
pasc <- selectList [] [Asc PersonAge]
map entityVal pasc @== [eli, mic29]
let abe30 = Person "Abe" 30 $ Just "black"
_ <- insert abe30
map entityVal pasc @== [eli, mic29]
abes <- selectList [PersonName ==. "Abe"] []
map entityVal abes @== [abe30]
Just (Entity _ p3) <- getBy $ PersonNameKey "Michael"
p3 @== mic29
ps <- selectList [PersonColor ==. Just "blue"] []
map entityVal ps @== [eli]
ps2 <- selectList [PersonColor ==. Nothing] []
map entityVal ps2 @== [mic29]
delete micK
Nothing <- get micK
return ()
it "persistIdField" $ runDb $ do
let p = Person "foo" 100 (Just "blue")
q = Person "bar" 101 Nothing
pk <- insert p
qk <- insert q
mp <- selectFirst [persistIdField ==. pk] []
fmap entityVal mp @== Just p
mq <- selectFirst [persistIdField ==. qk] []
fmap entityVal mq @== Just q
it "!=." $ runDb $ do
deleteWhere ([] :: [Filter (PersonGeneric backend)])
let mic = Person "Michael" 25 Nothing
_ <- insert mic
let eli = Person "Eliezer" 25 (Just "Red")
_ <- insert eli
pne <- selectList [PersonName !=. "Michael"] []
map entityVal pne @== [eli]
ps <- selectList [PersonColor !=. Nothing] []
map entityVal ps @== [eli]
pnm <- selectList [PersonName !=. "Eliezer"] []
map entityVal pnm @== [mic]
it "Double Maybe" $ runDb $ do
deleteWhere ([] :: [Filter (PersonMayGeneric backend)])
let mic = PersonMay (Just "Michael") Nothing
_ <- insert mic
let eli = PersonMay (Just "Eliezer") (Just "Red")
_ <- insert eli
pe <- selectList [PersonMayName ==. Nothing, PersonMayColor ==. Nothing] []
map entityVal pe @== []
pne <- selectList [PersonMayName !=. Nothing, PersonMayColor !=. Nothing] []
map entityVal pne @== [eli]
it "and/or" $ runDb $ do
deleteWhere ([] :: [Filter (Person1Generic backend)])
insertMany_ [ Person1 "Michael" 25
, Person1 "Miriam" 25
, Person1 "Michael" 30
, Person1 "Michael" 35
]
c10 <- count $ [Person1Name ==. "Michael"] ||. [Person1Name ==. "Miriam", Person1Age ==. 25]
c10 @== 4
c12 <- count [FilterOr [FilterAnd [Person1Name ==. "Michael"], FilterAnd [Person1Name ==. "Miriam"]]]
c12 @== 4
c14 <- count [FilterOr [FilterAnd [Person1Name ==. "Michael"], FilterAnd [Person1Name ==. "Miriam"],
FilterAnd [Person1Age >. 29, Person1Age <=. 30]]]
c14 @== 4
c20 <- count $ [Person1Name ==. "Miriam"] ||. [Person1Age >. 29, Person1Age <=. 30]
c20 @== 2
c22 <- count $ [Person1Age <=. 30] ++ [Person1Age >. 29]
c22 @== 1
c24 <- count $ [FilterAnd [Person1Age <=. 30, Person1Age >. 29]]
c24 @== 1
c26 <- count $ [Person1Age <=. 30] ++ [Person1Age >. 29]
c26 @== 1
c34 <- count $ [Person1Name ==. "Michael"] ||. [Person1Name ==. "Mirieam"] ++ [Person1Age <.35]
c34 @== 3
c30 <- count $ ([Person1Name ==. "Michael"] ||. [Person1Name ==. "Miriam"]) ++ [Person1Age <.35]
c30 @== 3
c36 <- count $ [Person1Name ==. "Michael"] ||. ([Person1Name ==. "Miriam"] ++ [Person1Age <.35])
c36 @== 4
c40 <- count $ ([Person1Name ==. "Michael"] ||. [Person1Name ==. "Miriam"] ||. [Person1Age <.35])
c40 @== 4
it "deleteWhere" $ runDb $ do
key2 <- insert $ Person "Michael2" 90 Nothing
_ <- insert $ Person "Michael3" 90 Nothing
let p91 = Person "Michael4" 91 Nothing
key91 <- insert p91
ps90 <- selectList [PersonAge ==. 90] []
assertNotEmpty ps90
deleteWhere [PersonAge ==. 90]
ps90' <- selectList [PersonAge ==. 90] []
assertEmpty ps90'
Nothing <- get key2
Just p2_91 <- get key91
p91 @== p2_91
it "deleteBy" $ runDb $ do
_ <- insert $ Person "Michael2" 27 Nothing
let p3 = Person "Michael3" 27 Nothing
key3 <- insert p3
ps2 <- selectList [PersonName ==. "Michael2"] []
assertNotEmpty ps2
deleteBy $ PersonNameKey "Michael2"
ps2' <- selectList [PersonName ==. "Michael2"] []
assertEmpty ps2'
Just p32 <- get key3
p3 @== p32
it "delete" $ runDb $ do
key2 <- insert $ Person "Michael2" 27 Nothing
let p3 = Person "Michael3" 27 Nothing
key3 <- insert p3
pm2 <- selectList [PersonName ==. "Michael2"] []
assertNotEmpty pm2
delete key2
pm2' <- selectList [PersonName ==. "Michael2"] []
assertEmpty pm2'
Just p <- get key3
p3 @== p
prop "toPathPiece . fromPathPiece" $ \piece ->
let key1 = piece :: (BackendKey SqlBackend)
key2 = fromJust $ fromPathPiece $ toPathPiece key1 :: (BackendKey SqlBackend)
in toPathPiece key1 == toPathPiece key2
it "replace" $ runDb $ do
key2 <- insert $ Person "Michael2" 27 Nothing
let p3 = Person "Michael3" 27 Nothing
replace key2 p3
Just p <- get key2
p @== p3
delete key2
Nothing <- get key2
_ <- replace key2 p3
Nothing <- get key2
return ()
let mic = Person "Michael" 25 Nothing
micK <- insert mic
Just p1 <- get micK
p1 @== mic
replace micK $ Person "Michael" 25 Nothing
Just p2 <- get micK
p2 @== mic
replace micK $ Person "Michael" 26 Nothing
Just mic26 <- get micK
mic26 @/= mic
personAge mic26 @== personAge mic + 1
it "getBy" $ runDb $ do
let p2 = Person "Michael2" 27 Nothing
key2 <- insert p2
Just (Entity k p) <- getBy $ PersonNameKey "Michael2"
p @== p2
k @== key2
Nothing <- getBy $ PersonNameKey "Michael9"
Just (Entity k' p') <- getByValue p2
k' @== k
p' @== p
return ()
it "updateGet" $ runDb $ do
let p25 = Person "Michael" 25 Nothing
key25 <- insert p25
pBlue28 <- updateGet key25 [PersonAge =. 28, PersonName =. "Updated"]
pBlue28 @== Person "Updated" 28 Nothing
pBlue30 <- updateGet key25 [PersonAge +=. 2]
pBlue30 @== Person "Updated" 30 Nothing
describe "repsertMany" $ do
it "adds new rows when no conflicts" $ runDb $ do
ids@[johnId, janeId, aliceId, eveId] <- replicateM 4 $ liftIO (Person1Key `fmap` generateKey)
let john = Person1 "john" 20
let jane = Person1 "jane" 18
let alice = Person1 "alice" 18
let eve = Person1 "eve" 19
insertKey johnId john
insertKey janeId jane
_ <- repsertMany [ (aliceId, alice), (eveId, eve) ]
es <- getMany ids
let rs = [john, jane, alice, eve]
es @== Map.fromList (zip ids rs)
mapM_ delete ids
it "handles conflicts by replacing old keys with new records" $ runDb $ do
let john = Person1 "john" 20
let jane = Person1 "jane" 18
let alice = Person1 "alice" 18
let eve = Person1 "eve" 19
johnId <- insert john
janeId <- insert jane
_ <- repsertMany [ (johnId, alice), (janeId, eve) ]
(Just alice') <- get johnId
(Just eve') <- get janeId
[alice',eve'] @== [alice,eve]
mapM_ delete [johnId, janeId]
it "updateWhere" $ runDb $ do
let p1 = Person "Michael" 25 Nothing
let p2 = Person "Michael2" 25 Nothing
key1 <- insert p1
key2 <- insert p2
updateWhere [PersonName ==. "Michael2"]
[PersonAge +=. 3, PersonName =. "Updated"]
Just pBlue28 <- get key2
pBlue28 @== Person "Updated" 28 Nothing
Just p <- get key1
p @== p1
it "selectList" $ runDb $ do
let p25 = Person "Michael" 25 Nothing
let p26 = Person "Michael2" 26 Nothing
[key25, key26] <- insertMany [p25, p26]
ps1 <- selectList [] [Asc PersonAge]
ps1 @== [(Entity key25 p25), (Entity key26 p26)]
ps2 <- selectList [] [Asc PersonAge, LimitTo 1]
ps2 @== [(Entity key25 p25)]
ps3 <- selectList [] [Asc PersonAge, OffsetBy 1]
ps3 @== [(Entity key26 p26)]
ps4 <- selectList [] [Asc PersonAge, LimitTo 1, OffsetBy 1]
ps4 @== [(Entity key26 p26)]
ps5 <- selectList [] [Desc PersonAge]
ps5 @== [(Entity key26 p26), (Entity key25 p25)]
ps6 <- selectList [PersonAge ==. 26] []
ps6 @== [(Entity key26 p26)]
it "selectSource" $ runDb $ do
let p1 = Person "selectSource1" 1 Nothing
p2 = Person "selectSource2" 2 Nothing
p3 = Person "selectSource3" 3 Nothing
[k1,k2,k3] <- insertMany [p1, p2, p3]
ps1 <- runConduitRes $ selectSource [] [Desc PersonAge] .| await
ps1 @== Just (Entity k3 p3)
ps2 <- runConduitRes $ selectSource [PersonAge <. 3] [Asc PersonAge] .| CL.consume
ps2 @== [Entity k1 p1, Entity k2 p2]
runConduitRes $ selectSource [] [Desc PersonAge] .| do
e1 <- await
e1 @== Just (Entity k3 p3)
e2 <- await
e2 @== Just (Entity k2 p2)
e3 <- await
e3 @== Just (Entity k1 p1)
e4 <- await
e4 @== Nothing
it "selectFirst" $ runDb $ do
_ <- insert $ Person "Michael" 26 Nothing
let pOld = Person "Oldie" 75 Nothing
kOld <- insert pOld
x <- selectFirst [] [Desc PersonAge]
x @== Just (Entity kOld pOld)
it "selectKeys" $ runDb $ do
let p1 = Person "selectKeys1" 1 Nothing
p2 = Person "selectKeys2" 2 Nothing
p3 = Person "selectKeys3" 3 Nothing
[k1,k2,k3] <- insertMany [p1, p2, p3]
ps1 <- runConduitRes $ selectKeys [] [Desc PersonAge] .| await
ps1 @== Just k3
ps2 <- runConduitRes $ selectKeys [PersonAge <. 3] [Asc PersonAge] .| CL.consume
ps2 @== [k1, k2]
runConduitRes $ selectKeys [] [Desc PersonAge] .| do
e1 <- await
e1 @== Just k3
e2 <- await
e2 @== Just k2
e3 <- await
e3 @== Just k1
e4 <- await
e4 @== Nothing
it "insertMany_ with no arguments" $ runDb $ do
_ <- insertMany_ ([] :: [PersonGeneric backend])
rows <- (count ([] :: [Filter (PersonGeneric backend)]) :: ReaderT backend m Int)
rows @== 0
_ <- insertMany ([] :: [PersonGeneric backend])
rows2 <- count ([] :: [Filter (PersonGeneric backend)])
rows2 @== 0
_ <- insertEntityMany ([] :: [Entity (PersonGeneric backend)])
rows3 <- count ([] :: [Filter (PersonGeneric backend)])
rows3 @== 0
it "insertEntityMany" $ runDb $ do
id1:id2:id3:id4:id5:[] <- liftIO $ replicateM 5 (PersonKey `fmap` generateKey)
let p1 = Entity id1 $ Person "insertEntityMany1" 1 Nothing
p2 = Entity id2 $ Person "insertEntityMany2" 2 Nothing
p3 = Entity id3 $ Person "insertEntityMany3" 3 Nothing
p4 = Entity id4 $ Person "insertEntityMany4" 3 Nothing
p5 = Entity id5 $ Person "insertEntityMany5" 3 Nothing
insertEntityMany [p1,p2,p3,p4,p5]
rows <- count ([] :: [Filter (PersonGeneric backend)])
rows @== 5
it "insertBy" $ runDb $ do
Right _ <- insertBy $ Person "name" 1 Nothing
Left _ <- insertBy $ Person "name" 1 Nothing
Right _ <- insertBy $ Person "name2" 1 Nothing
return ()
it "insertKey" $ runDb $ do
k <- liftIO (PersonKey `fmap` generateKey)
insertKey k $ Person "Key" 26 Nothing
Just (Entity k2 _) <- selectFirst [PersonName ==. "Key"] []
k2 @== k
it "insertEntity" $ runDb $ do
Entity k p <- insertEntity $ Person "name" 1 Nothing
Just p2 <- get k
p2 @== p
it "insertRecord" $ runDb $ do
let record = Person "name" 1 Nothing
record' <- insertRecord record
record' @== record
it "getEntity" $ runDb $ do
Entity k p <- insertEntity $ Person "name" 1 Nothing
Just (Entity k2 p2) <- getEntity k
p @== p2
k @== k2
it "getJustEntity" $ runDb $ do
let p1 = Person "name" 1 Nothing
k1 <- insert p1
Entity k2 p2 <- getJustEntity k1
p1 @== p2
k1 @== k2
it "repsert" $ runDb $ do
k <- liftIO (PersonKey `fmap` generateKey)
Nothing <- selectFirst [PersonName ==. "Repsert"] []
repsert k $ Person "Repsert" 26 Nothing
Just (Entity k2 _) <- selectFirst [PersonName ==. "Repsert"] []
k2 @== k
repsert k $ Person "Repsert" 27 Nothing
Just (Entity k3 p) <- selectFirst [PersonName ==. "Repsert"] []
k3 @== k
27 @== personAge p
it "retrieves a belongsToJust association" $ runDb $ do
let p = Person "pet owner" 30 Nothing
person <- insert p
let cat = Pet person "Mittens" Cat
p2 <- getJust $ petOwnerId cat
p @== p2
p3 <- belongsToJust petOwnerId cat
p @== p3
it "retrieves a belongsTo association" $ runDb $ do
let p = Person "pet owner" 30 Nothing
person <- insert p
let cat = MaybeOwnedPet (Just person) "Mittens" Cat
p2 <- getJust $ fromJust $ maybeOwnedPetOwnerId cat
p @== p2
Just p4 <- belongsTo maybeOwnedPetOwnerId cat
p @== p4
it "derivePersistField" $ runDb $ do
person <- insert $ Person "pet owner" 30 Nothing
catKey <- insert $ Pet person "Mittens" Cat
Just cat' <- get catKey
liftIO $ petType cat' @?= Cat
dog <- insert $ Pet person "Spike" Dog
Just dog' <- get dog
liftIO $ petType dog' @?= Dog
it "derivePersistFieldJSON" $ runDb $ do
let mittensCollar = PetCollar "Mittens\n1-714-668-9672" True
pkey <- insert $ Person "pet owner" 30 Nothing
catKey <- insert $ OutdoorPet pkey mittensCollar Cat
Just (OutdoorPet _ collar' _) <- get catKey
liftIO $ collar' @?= mittensCollar
it "idIn" $ runDb $ do
let p1 = Person "D" 0 Nothing
p2 = Person "E" 1 Nothing
p3 = Person "F" 2 Nothing
pid1 <- insert p1
_ <- insert p2
pid3 <- insert p3
x <- selectList [PersonId <-. [pid1, pid3]] []
liftIO $ x @?= [Entity pid1 p1, Entity pid3 p3]
it "In" $ runDb $ do
let p1 = Person "D" 0 Nothing
p2 = Person "E" 1 Nothing
p3 = Person "F" 2 (Just "blue")
insert_ p1
insert_ p2
insert_ p3
x1 <- fmap entityVal `fmap` selectList [PersonName <-. ["D"]] []
liftIO $ x1 @?= [p1]
x2 <- fmap entityVal `fmap` selectList [PersonName /<-. ["D"]] []
liftIO $ x2 @?= [p2, p3]
x3 <- fmap entityVal `fmap` selectList [PersonColor <-. [Just "blue"]] []
liftIO $ x3 @?= [p3]
x4 <- fmap entityVal `fmap` selectList [PersonColor /<-. [Just "blue"]] []
liftIO $ x4 @?= [p1, p2]
x5 <- fmap entityVal `fmap` selectList [PersonColor <-. [Nothing, Just "blue"]] []
liftIO $ x5 @?= [p1, p2, p3]
x6 <- fmap entityVal `fmap` selectList [PersonColor /<-. [Nothing]] []
liftIO $ x6 @?= [p3]
describe "toJSON" $ do
it "serializes" $ runDb $ do
let p = Person "D" 0 Nothing
k <- insert p
liftIO $ toJSON (Entity k p) @?=
Object (M.fromList [("id", toJSON k), ("color",Null),("name",String "D"),("age",Number 0)])
describe "strictness" $ do
it "bang" $ (return $! Strict (error "foo") 5 5) `shouldThrow` anyErrorCall
it "tilde" $ void (return $! Strict 5 (error "foo") 5 :: IO Strict)
it "blank" $ (return $! Strict 5 5 (error "foo")) `shouldThrow` anyErrorCall