{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-} -- FIXME
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module CompositeTest where

import qualified Data.Map as Map
import Data.Maybe (isJust)

import Database.Persist.TH (mkDeleteCascade)
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", mkDeleteCascade persistSettings { mpsGeneric = False }] [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 :: ReaderT backend m ()
cleanDB = do
  [Filter TestChild] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter TestChild])
  [Filter TestParent] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter TestParent])
  [Filter CitizenAddress] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter CitizenAddress])
  [Filter Citizen] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Citizen])
  [Filter Address] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Address])

specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
specsWith :: RunDb SqlBackend m -> Spec
specsWith RunDb SqlBackend m
runDb = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"composite" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"primary keys" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do

    let p1 :: TestParent
p1 = String -> String -> Int -> String -> TestParent
TestParent String
"a1" String
"b1" Int
11 String
"p1"
    let p2 :: TestParent
p2 = String -> String -> Int -> String -> TestParent
TestParent String
"a2" String
"b2" Int
22 String
"p2"
    let p3 :: TestParent
p3 = String -> String -> Int -> String -> TestParent
TestParent String
"a3" String
"b3" Int
33 String
"p3"
    let p1' :: TestParent
p1' = String -> String -> Int -> String -> TestParent
TestParent String
"a1" String
"b1" Int
11 String
"p1'"
    let c1 :: TestChild
c1 = String -> String -> Int -> String -> TestChild
TestChild String
"a1" String
"b1" Int
11 String
"c1"
    let c1' :: TestChild
c1' = String -> String -> Int -> String -> TestChild
TestChild String
"a1" String
"b1" Int
11 String
"c1'"

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"insertWithKey" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key TestParent
kp1
      Key TestParent -> TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key TestParent
kp1 TestParent
p2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"repsert" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent -> TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
repsert Key TestParent
kp1 TestParent
p2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Insert" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp1 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== (String, String, Int64) -> Either Text (String, String, Int64)
forall a b. b -> Either a b
Right (String
"a1",String
"b1",Int64
11)
      Maybe TestParent
mp <- Key TestParent -> ReaderT SqlBackend m (Maybe TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestParent
kp1
      Maybe TestParent -> Bool
forall a. Maybe a -> Bool
isJust Maybe TestParent
mp Bool -> Bool -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Bool
True
      let Just TestParent
p11 = Maybe TestParent
mp
      TestParent
p1 TestParent -> TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent
p11
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> Key TestParent -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key TestParent
kp1] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
1
      let [Entity Key TestParent
newkp1 TestParent
newp1] = [Entity TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp1 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp1
      TestParent
p1 TestParent -> TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent
newp1

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Id field" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> [Key TestParent] -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
<-. [Key TestParent
kp1,Key TestParent
kp2]] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
2
      [(Entity Key TestParent
newkp1 TestParent
newp1),(Entity Key TestParent
newkp2 TestParent
newp2)] <- [Entity TestParent] -> ReaderT SqlBackend m [Entity TestParent]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Entity TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp1 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp1
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp2 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp2
      TestParent
p1 TestParent -> TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent
newp1
      TestParent
p2 TestParent -> TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent
newp2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Filter by Id with 'not equal'" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> Key TestParent -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
!=. Key TestParent
kp1] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
1
      let [Entity Key TestParent
newkp2 TestParent
_newp2] = [Entity TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp2 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Filter by Id with 'in'" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> [Key TestParent] -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
<-. [Key TestParent
kp1,Key TestParent
kp2]] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
2
      let [Entity Key TestParent
newkp1 TestParent
_newp1,Entity Key TestParent
newkp2 TestParent
_newp2] = [Entity TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp1 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp1
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp2 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Filter by Id with 'not in'" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> [Key TestParent] -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
/<-. [Key TestParent
kp1]] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
1
      let [Entity Key TestParent
newkp2 TestParent
_newp2] = [Entity TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kp2 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
newkp2

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Filter by Id with 'not in' with no data" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2
      [Entity TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent]
-> ReaderT SqlBackend m [Entity TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField TestParent (Key TestParent)
forall typ. (typ ~ Key TestParent) => EntityField TestParent typ
TestParentId EntityField TestParent (Key TestParent)
-> [Key TestParent] -> Filter TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> [typ] -> Filter v
/<-. [Key TestParent
kp1,Key TestParent
kp2]] []
      [Entity TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
0

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Extract Parent Foreign Key from Child value" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ TestParent
p2
      Key TestChild
kc1 <- TestChild -> ReaderT SqlBackend m (Key TestChild)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestChild
c1
      Maybe TestChild
mc <- Key TestChild -> ReaderT SqlBackend m (Maybe TestChild)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestChild
kc1
      Maybe TestChild -> Bool
forall a. Maybe a -> Bool
isJust Maybe TestChild
mc Bool -> Bool -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Bool
True
      let Just TestChild
c11 = Maybe TestChild
mc
      TestChild
c1 TestChild -> TestChild -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestChild
c11
      TestChild -> Key TestParent
testChildFkparent TestChild
c11 Key TestParent -> Key TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key TestParent
kp1

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Validate Key contents" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ TestParent
p1
      TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ TestParent
p2
      TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ TestParent
p3
      [Key TestParent]
xs <- [Filter TestParent]
-> [SelectOpt TestParent] -> ReaderT SqlBackend m [Key TestParent]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Key record]
selectKeysList [] [EntityField TestParent String -> SelectOpt TestParent
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField TestParent String
forall typ. (typ ~ String) => EntityField TestParent typ
TestParentName]
      [Key TestParent] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Key TestParent]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
3
      let [Key TestParent
kps1,Key TestParent
kps2,Key TestParent
kps3] = [Key TestParent]
xs
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kps1 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== (String, String, Int64) -> Either Text (String, String, Int64)
forall a b. b -> Either a b
Right (String
"a1",String
"b1",Int64
11)
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kps2 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== (String, String, Int64) -> Either Text (String, String, Int64)
forall a b. b -> Either a b
Right (String
"a2",String
"b2",Int64
22)
      Key TestParent -> Either Text (String, String, Int64)
matchParentK Key TestParent
kps3 Either Text (String, String, Int64)
-> Either Text (String, String, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== (String, String, Int64) -> Either Text (String, String, Int64)
forall a b. b -> Either a b
Right (String
"a3",String
"b3",Int64
33)

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Delete" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      Key TestParent
kp2 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p2

      ()
_ <- Key TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key TestParent
kp1
      Maybe TestParent
r <- Key TestParent -> ReaderT SqlBackend m (Maybe TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestParent
kp1
      Maybe TestParent
r Maybe TestParent -> Maybe TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Maybe TestParent
forall a. Maybe a
Nothing
      Maybe TestParent
r1 <- Key TestParent -> ReaderT SqlBackend m (Maybe TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestParent
kp2
      Maybe TestParent -> Bool
forall a. Maybe a -> Bool
isJust Maybe TestParent
r1 Bool -> Bool -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Bool
True

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Update" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      ()
_ <- Key TestParent -> [Update TestParent] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key TestParent
kp1 [EntityField TestParent String
forall typ. (typ ~ String) => EntityField TestParent typ
TestParentExtra44 EntityField TestParent String -> String -> Update TestParent
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. String
"q1"]
      Maybe TestParent
newkps1 <- Key TestParent -> ReaderT SqlBackend m (Maybe TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestParent
kp1
      Maybe TestParent
newkps1 Maybe TestParent -> Maybe TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent -> Maybe TestParent
forall a. a -> Maybe a
Just (String -> String -> Int -> String -> TestParent
TestParent String
"a1" String
"b1" Int
11 String
"q1")

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Replace Parent" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
kp1 <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      ()
_ <- Key TestParent -> TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key TestParent
kp1 TestParent
p1'
      Maybe TestParent
newp1 <- Key TestParent -> ReaderT SqlBackend m (Maybe TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestParent
kp1
      Maybe TestParent
newp1 Maybe TestParent -> Maybe TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestParent -> Maybe TestParent
forall a. a -> Maybe a
Just TestParent
p1'

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Replace Child" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      -- c1 FKs p1
      TestParent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ TestParent
p1
      Key TestChild
kc1 <- TestChild -> ReaderT SqlBackend m (Key TestChild)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestChild
c1
      ()
_ <- Key TestChild -> TestChild -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
replace Key TestChild
kc1 TestChild
c1'
      Maybe TestChild
newc1 <- Key TestChild -> ReaderT SqlBackend m (Maybe TestChild)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key TestChild
kc1
      Maybe TestChild
newc1 Maybe TestChild -> Maybe TestChild -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== TestChild -> Maybe TestChild
forall a. a -> Maybe a
Just TestChild
c1'

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Insert Many to Many" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      let z1 :: Citizen
z1 = String -> Maybe Int -> Citizen
Citizen String
"mk" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
11)
      let a1 :: Address
a1 = String -> String -> Address
Address String
"abc" String
"usa"
      let z2 :: Citizen
z2 = String -> Maybe Int -> Citizen
Citizen String
"gb" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
22)
      let a2 :: Address
a2 = String -> String -> Address
Address String
"def" String
"den"

      Key Citizen
kc1 <- Citizen -> ReaderT SqlBackend m (Key Citizen)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Citizen
z1
      Key Address
ka1 <- Address -> ReaderT SqlBackend m (Key Address)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Address
a1
      let ca1 :: CitizenAddress
ca1 = Key Citizen -> Key Address -> CitizenAddress
CitizenAddress Key Citizen
kc1 Key Address
ka1
      Key CitizenAddress
kca1 <- CitizenAddress -> ReaderT SqlBackend m (Key CitizenAddress)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert CitizenAddress
ca1
      Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK Key CitizenAddress
kca1 Either Text (Int64, Int64)
-> Either Text (Int64, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key Citizen -> Key Address -> Either Text (Int64, Int64)
forall a1 a record record2.
(PersistField a1, PersistField a, PersistEntity record,
 PersistEntity record2) =>
Key record -> Key record2 -> Either Text (a1, a)
matchK2 Key Citizen
kc1 Key Address
ka1

      Maybe CitizenAddress
mca <- Key CitizenAddress -> ReaderT SqlBackend m (Maybe CitizenAddress)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key CitizenAddress
kca1
      Maybe CitizenAddress -> Bool
forall a. Maybe a -> Bool
isJust Maybe CitizenAddress
mca Bool -> Bool -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Bool
True
      let Just CitizenAddress
newca1 = Maybe CitizenAddress
mca
      CitizenAddress
ca1 CitizenAddress -> CitizenAddress -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== CitizenAddress
newca1

      Key Citizen
kc2 <- Citizen -> ReaderT SqlBackend m (Key Citizen)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Citizen
z2
      Key Address
ka2 <- Address -> ReaderT SqlBackend m (Key Address)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Address
a2
      let ca2 :: CitizenAddress
ca2 = Key Citizen -> Key Address -> CitizenAddress
CitizenAddress Key Citizen
kc2 Key Address
ka2
      Key CitizenAddress
kca2 <- CitizenAddress -> ReaderT SqlBackend m (Key CitizenAddress)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert CitizenAddress
ca2
      Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK Key CitizenAddress
kca2 Either Text (Int64, Int64)
-> Either Text (Int64, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key Citizen -> Key Address -> Either Text (Int64, Int64)
forall a1 a record record2.
(PersistField a1, PersistField a, PersistEntity record,
 PersistEntity record2) =>
Key record -> Key record2 -> Either Text (a1, a)
matchK2 Key Citizen
kc2 Key Address
ka2

      [Entity CitizenAddress]
xs <- [Filter CitizenAddress]
-> [SelectOpt CitizenAddress]
-> ReaderT SqlBackend m [Entity CitizenAddress]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField CitizenAddress (Key CitizenAddress)
forall typ.
(typ ~ Key CitizenAddress) =>
EntityField CitizenAddress typ
CitizenAddressId EntityField CitizenAddress (Key CitizenAddress)
-> Key CitizenAddress -> Filter CitizenAddress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key CitizenAddress
kca1] []
      [Entity CitizenAddress] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Entity CitizenAddress]
xs Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
1
      let [Entity Key CitizenAddress
newkca1 CitizenAddress
newca2] = [Entity CitizenAddress]
xs
      Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK Key CitizenAddress
kca1 Either Text (Int64, Int64)
-> Either Text (Int64, Int64) -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK Key CitizenAddress
newkca1
      CitizenAddress
ca1 CitizenAddress -> CitizenAddress -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== CitizenAddress
newca2
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"insertMany" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      [Key TestParent
kp1, Key TestParent
kp2] <- [TestParent] -> ReaderT SqlBackend m [Key TestParent]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany [TestParent
p1, TestParent
p2]
      Map (Key TestParent) TestParent
rs <- [Key TestParent]
-> ReaderT SqlBackend m (Map (Key TestParent) TestParent)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Key record] -> ReaderT backend m (Map (Key record) record)
getMany [Key TestParent
kp1, Key TestParent
kp2]
      Map (Key TestParent) TestParent
rs Map (Key TestParent) TestParent
-> Map (Key TestParent) TestParent -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [(Key TestParent, TestParent)] -> Map (Key TestParent) TestParent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Key TestParent
kp1, TestParent
p1), (Key TestParent
kp2, TestParent
p2)]
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"RawSql Key instance" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
key <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      [Key TestParent]
keyFromRaw <- Text -> [PersistValue] -> ReaderT SqlBackend m [Key TestParent]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT name, name2, age FROM test_parent LIMIT 1" []
      [Key TestParent
key] [Key TestParent] -> [Key TestParent] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Key TestParent]
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'

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"RawSql Entity instance" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
      Key TestParent
key <- TestParent -> ReaderT SqlBackend m (Key TestParent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TestParent
p1
      [Entity TestParent]
newp1 <- Text -> [PersistValue] -> ReaderT SqlBackend m [Entity TestParent]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT ?? FROM test_parent LIMIT 1" []
      [Key TestParent -> TestParent -> Entity TestParent
forall record. Key record -> record -> Entity record
Entity Key TestParent
key TestParent
p1] [Entity TestParent]
-> [Entity TestParent] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity TestParent]
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 :: Key record -> Either Text a
matchK = (\(PersistValue
pv:[]) -> PersistValue -> Either Text a
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
pv) ([PersistValue] -> Either Text a)
-> (Key record -> [PersistValue]) -> Key record -> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key record -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues

matchK2 :: (PersistField a1, PersistField a, PersistEntity record, PersistEntity record2)
        => Key record -> Key record2
        -> Either Text (a1, a)
matchK2 :: Key record -> Key record2 -> Either Text (a1, a)
matchK2 Key record
k1 Key record2
k2 = (,) (a1 -> a -> (a1, a))
-> Either Text a1 -> Either Text (a -> (a1, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key record -> Either Text a1
forall a record.
(PersistField a, PersistEntity record) =>
Key record -> Either Text a
matchK Key record
k1 Either Text (a -> (a1, a)) -> Either Text a -> Either Text (a1, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key record2 -> Either Text a
forall a record.
(PersistField a, PersistEntity record) =>
Key record -> Either Text a
matchK Key record2
k2

matchParentK :: Key TestParent -> Either Text (String, String, Int64)
matchParentK :: Key TestParent -> Either Text (String, String, Int64)
matchParentK = (\(PersistValue
a:PersistValue
b:PersistValue
c:[]) -> (,,) (String -> String -> Int64 -> (String, String, Int64))
-> Either Text String
-> Either Text (String -> Int64 -> (String, String, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
a Either Text (String -> Int64 -> (String, String, Int64))
-> Either Text String
-> Either Text (Int64 -> (String, String, Int64))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PersistValue -> Either Text String
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
b Either Text (Int64 -> (String, String, Int64))
-> Either Text Int64 -> Either Text (String, String, Int64)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PersistValue -> Either Text Int64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
c)
             ([PersistValue] -> Either Text (String, String, Int64))
-> (Key TestParent -> [PersistValue])
-> Key TestParent
-> Either Text (String, String, Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key TestParent -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues

matchCitizenAddressK :: Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK :: Key CitizenAddress -> Either Text (Int64, Int64)
matchCitizenAddressK = (\(PersistValue
a:PersistValue
b:[]) -> (,) (Int64 -> Int64 -> (Int64, Int64))
-> Either Text Int64 -> Either Text (Int64 -> (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PersistValue -> Either Text Int64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
a Either Text (Int64 -> (Int64, Int64))
-> Either Text Int64 -> Either Text (Int64, Int64)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PersistValue -> Either Text Int64
forall a. PersistField a => PersistValue -> Either Text a
fromPersistValue PersistValue
b)
                     ([PersistValue] -> Either Text (Int64, Int64))
-> (Key CitizenAddress -> [PersistValue])
-> Key CitizenAddress
-> Either Text (Int64, Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key CitizenAddress -> [PersistValue]
forall record. PersistEntity record => Key record -> [PersistValue]
keyToValues