persistent-test-2.13.2.1: src/CompositeTest.hs
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
-- FIXME
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module CompositeTest where
import qualified Data.Map as Map
import Data.Maybe (isJust)
import Init
-- mpsGeneric = False is due to a bug or at least lack of a feature in mkKeyTypeDec TH.hs
share
[mkPersist persistSettings{mpsGeneric = False}, mkMigrate "compositeMigrate"]
[persistLowerCase|
TestParent
name String maxlen=20
name2 String maxlen=20
age Int
extra44 String
Primary name name2 age
deriving Show Eq
TestChild
name String maxlen=20
name2 String maxlen=20
age Int
extra4 String
Foreign TestParent fkparent name name2 age
deriving Show Eq
Citizen
name String
age Int Maybe
deriving Eq Show
Address
address String
country String
deriving Eq Show
CitizenAddress
citizen CitizenId
address AddressId
Primary citizen address
deriving Eq Show
PrimaryCompositeWithOtherNullableFields
foo String maxlen=20
bar String maxlen=20
baz String Maybe
Primary foo bar
deriving Eq Show
|]
cleanDB
:: (PersistQuery backend, PersistEntityBackend TestChild ~ backend, MonadIO m)
=> ReaderT backend m ()
cleanDB = do
deleteWhere ([] :: [Filter TestChild])
deleteWhere ([] :: [Filter TestParent])
deleteWhere ([] :: [Filter CitizenAddress])
deleteWhere ([] :: [Filter Citizen])
deleteWhere ([] :: [Filter Address])
specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
specsWith runDb = describe "composite" $
describe "primary keys" $ do
let
p1 = TestParent "a1" "b1" 11 "p1"
let
p2 = TestParent "a2" "b2" 22 "p2"
let
p3 = TestParent "a3" "b3" 33 "p3"
let
p1' = TestParent "a1" "b1" 11 "p1'"
let
c1 = TestChild "a1" "b1" 11 "c1"
let
c1' = TestChild "a1" "b1" 11 "c1'"
it "insertWithKey" $ runDb $ do
kp1 <- insert p1
delete kp1
insertKey kp1 p2
it "repsert" $ runDb $ do
kp1 <- insert p1
repsert kp1 p2
it "Insert" $ runDb $ do
kp1 <- insert p1
matchParentK kp1 @== Right ("a1", "b1", 11)
mp <- get kp1
isJust mp @== True
let
Just p11 = mp
p1 @== p11
xs <- selectList [TestParentId ==. kp1] []
length xs @== 1
let
[Entity newkp1 newp1] = xs
matchParentK kp1 @== matchParentK newkp1
p1 @== newp1
it "Id field" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
xs <- selectList [TestParentId <-. [kp1, kp2]] []
length xs @== 2
[(Entity newkp1 newp1), (Entity newkp2 newp2)] <- pure xs
matchParentK kp1 @== matchParentK newkp1
matchParentK kp2 @== matchParentK newkp2
p1 @== newp1
p2 @== newp2
it "Filter by Id with 'not equal'" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
xs <- selectList [TestParentId !=. kp1] []
length xs @== 1
let
[Entity newkp2 _newp2] = xs
matchParentK kp2 @== matchParentK newkp2
it "Filter by Id with 'in'" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
xs <- selectList [TestParentId <-. [kp1, kp2]] []
length xs @== 2
let
[Entity newkp1 _newp1, Entity newkp2 _newp2] = xs
matchParentK kp1 @== matchParentK newkp1
matchParentK kp2 @== matchParentK newkp2
it "Filter by Id with 'not in'" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
xs <- selectList [TestParentId /<-. [kp1]] []
length xs @== 1
let
[Entity newkp2 _newp2] = xs
matchParentK kp2 @== matchParentK newkp2
it "Filter by Id with 'not in' with no data" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
xs <- selectList [TestParentId /<-. [kp1, kp2]] []
length xs @== 0
it "Extract Parent Foreign Key from Child value" $ runDb $ do
kp1 <- insert p1
insert_ p2
kc1 <- insert c1
mc <- get kc1
isJust mc @== True
let
Just c11 = mc
c1 @== c11
testChildFkparent c11 @== kp1
it "Validate Key contents" $ runDb $ do
insert_ p1
insert_ p2
insert_ p3
xs <- selectKeysList [] [Asc TestParentName]
length xs @== 3
let
[kps1, kps2, kps3] = xs
matchParentK kps1 @== Right ("a1", "b1", 11)
matchParentK kps2 @== Right ("a2", "b2", 22)
matchParentK kps3 @== Right ("a3", "b3", 33)
it "Delete" $ runDb $ do
kp1 <- insert p1
kp2 <- insert p2
_ <- delete kp1
r <- get kp1
r @== Nothing
r1 <- get kp2
isJust r1 @== True
it "Update" $ runDb $ do
kp1 <- insert p1
_ <- update kp1 [TestParentExtra44 =. "q1"]
newkps1 <- get kp1
newkps1 @== Just (TestParent "a1" "b1" 11 "q1")
it "Replace Parent" $ runDb $ do
kp1 <- insert p1
_ <- replace kp1 p1'
newp1 <- get kp1
newp1 @== Just p1'
it "Replace Child" $ runDb $ do
-- c1 FKs p1
insert_ p1
kc1 <- insert c1
_ <- replace kc1 c1'
newc1 <- get kc1
newc1 @== Just c1'
it "Insert Many to Many" $ runDb $ do
let
z1 = Citizen "mk" (Just 11)
let
a1 = Address "abc" "usa"
let
z2 = Citizen "gb" (Just 22)
let
a2 = Address "def" "den"
kc1 <- insert z1
ka1 <- insert a1
let
ca1 = CitizenAddress kc1 ka1
kca1 <- insert ca1
matchCitizenAddressK kca1 @== matchK2 kc1 ka1
mca <- get kca1
isJust mca @== True
let
Just newca1 = mca
ca1 @== newca1
kc2 <- insert z2
ka2 <- insert a2
let
ca2 = CitizenAddress kc2 ka2
kca2 <- insert ca2
matchCitizenAddressK kca2 @== matchK2 kc2 ka2
xs <- selectList [CitizenAddressId ==. kca1] []
length xs @== 1
let
[Entity newkca1 newca2] = xs
matchCitizenAddressK kca1 @== matchCitizenAddressK newkca1
ca1 @== newca2
it "insertMany" $ runDb $ do
[kp1, kp2] <- insertMany [p1, p2]
rs <- getMany [kp1, kp2]
rs @== Map.fromList [(kp1, p1), (kp2, p2)]
it "RawSql Key instance" $ runDb $ do
key <- insert p1
keyFromRaw <- rawSql "SELECT name, name2, age FROM test_parent LIMIT 1" []
[key] @== keyFromRaw
-- TODO: push into persistent-qq test suite
-- it "RawSql Key instance with sqlQQ" $ runDb $ do
-- key <- insert p1
-- keyFromRaw' <- [sqlQQ|
-- SELECT @{TestParentName}, @{TestParentName2}, @{TestParentAge}
-- FROM ^{TestParent}
-- LIMIT 1
-- |]
-- [key] @== keyFromRaw'
it "RawSql Entity instance" $ runDb $ do
key <- insert p1
Just x <- get key
x @== p1
newp1 <- rawSql "SELECT ?? FROM test_parent LIMIT 1" []
[Entity key p1] @== newp1
-- TODO: put into persistent-qq test suite
-- it "RawSql Entity instance with sqlQQ" $ runDb $ do
-- key <- insert p1
-- newp1' <- [sqlQQ| SELECT ?? FROM ^{TestParent} |]
-- [Entity key p1] @== newp1'
matchK :: (PersistField a, PersistEntity record) => Key record -> Either Text a
matchK = (\(pv : []) -> fromPersistValue pv) . keyToValues
matchK2
:: (PersistField a1, PersistField a, PersistEntity record, PersistEntity record2)
=> Key record
-> Key record2
-> Either Text (a1, a)
matchK2 k1 k2 = (,) <$> matchK k1 <*> matchK k2
matchParentK :: Key TestParent -> Either Text (String, String, Int64)
matchParentK =
( \(a : b : c : []) -> (,,) <$> fromPersistValue a <*> fromPersistValue b <*> fromPersistValue c
)
. keyToValues
matchCitizenAddressK :: Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK =
(\(a : b : []) -> (,) <$> fromPersistValue a <*> fromPersistValue b)
. keyToValues