{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE AllowAmbiguousTypes, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables, TypeApplications, UndecidableInstances #-}

module ForeignKey where

import Data.Proxy
import qualified Data.List as List
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|
SimpleCascadeChild
    ref SimpleCascadeId OnDeleteCascade
    deriving Show Eq

SimpleCascade
    name Int
    deriving Show Eq

Parent
    name Int
    Primary name

Child
    pname Int
    Foreign Parent OnDeleteCascade OnUpdateCascade fkparent pname
    deriving Show Eq

ParentImplicit
    name Int

ChildImplicit
    pname Int
    parentId ParentImplicitId noreference
    Foreign ParentImplicit OnDeleteCascade OnUpdateCascade fkparent parentId
    deriving Show Eq

ParentComposite
    name Int
    lastName Int
    Primary name lastName

ChildComposite
    pname Int
    plastName Int
    Foreign ParentComposite OnDeleteCascade fkparent pname plastName
    deriving Show Eq

SelfReferenced
    name Int
    pname Int
    Primary name
    Foreign SelfReferenced OnDeleteCascade fkparent pname
    deriving Show Eq

A
    aa Int
    ab Int
    U1 aa

B
    ba Int
    bb Int
    Foreign A OnDeleteCascade fkA ba References aa
    deriving Show Eq

AComposite
    aa Int
    ab Int
    U2 aa ab

BComposite
    ba Int
    bb Int
    Foreign AComposite OnDeleteCascade fkAComposite ba bb References aa ab
    deriving Show Eq

BExplicit
    ba AId noreference
    Foreign A OnDeleteCascade fkAI ba References Id
    deriving Show Eq

Chain
    name Int
    previous ChainId Maybe noreference
    Foreign Chain OnDeleteSetNull fkChain previous References Id
    deriving Show Eq Ord

Chain2
    name Int
    previous Chain2Id Maybe noreference
    Foreign Chain2 OnDeleteCascade fkChain previous References Id
    deriving Show Eq
|]

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
"foreign keys options" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascades" (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 Parent
kf <- Parent -> ReaderT SqlBackend m (Key Parent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Parent -> ReaderT SqlBackend m (Key Parent))
-> Parent -> ReaderT SqlBackend m (Key Parent)
forall a b. (a -> b) -> a -> b
$ Int -> Parent
Parent Int
1
        Child -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (Child -> ReaderT SqlBackend m ())
-> Child -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Child
Child Int
1
        Key Parent -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key Parent
kf
        [Entity Child]
cs <- [Filter Child]
-> [SelectOpt Child] -> ReaderT SqlBackend m [Entity Child]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity Child]
expected = [] :: [Entity Child]
        [Entity Child]
cs [Entity Child] -> [Entity Child] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity Child]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"update cascades" (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 Parent
kf <- Parent -> ReaderT SqlBackend m (Key Parent)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Parent -> ReaderT SqlBackend m (Key Parent))
-> Parent -> ReaderT SqlBackend m (Key Parent)
forall a b. (a -> b) -> a -> b
$ Int -> Parent
Parent Int
1
        Child -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (Child -> ReaderT SqlBackend m ())
-> Child -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Child
Child Int
1
        Key Parent -> [Update Parent] -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key Parent
kf [EntityField Parent Int
forall typ. (typ ~ Int) => EntityField Parent typ
ParentName EntityField Parent Int -> Int -> Update Parent
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Int
2]
        [Entity Child]
cs <- [Filter Child]
-> [SelectOpt Child] -> ReaderT SqlBackend m [Entity Child]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        (Entity Child -> Int) -> [Entity Child] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Child -> Int
childPname (Child -> Int) -> (Entity Child -> Child) -> Entity Child -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity Child -> Child
forall record. Entity record -> record
entityVal) [Entity Child]
cs [Int] -> [Int] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Int
2]
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete Composite cascades" (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 ParentComposite
kf <- ParentComposite -> ReaderT SqlBackend m (Key ParentComposite)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (ParentComposite -> ReaderT SqlBackend m (Key ParentComposite))
-> ParentComposite -> ReaderT SqlBackend m (Key ParentComposite)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ParentComposite
ParentComposite Int
1 Int
2
        ChildComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (ChildComposite -> ReaderT SqlBackend m ())
-> ChildComposite -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ChildComposite
ChildComposite Int
1 Int
2
        Key ParentComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ParentComposite
kf
        [Entity ChildComposite]
cs <- [Filter ChildComposite]
-> [SelectOpt ChildComposite]
-> ReaderT SqlBackend m [Entity ChildComposite]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity ChildComposite]
expected = [] :: [Entity ChildComposite]
        [Entity ChildComposite]
cs [Entity ChildComposite]
-> [Entity ChildComposite] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity ChildComposite]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete self referenced cascades" (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 SelfReferenced
kf <- SelfReferenced -> ReaderT SqlBackend m (Key SelfReferenced)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (SelfReferenced -> ReaderT SqlBackend m (Key SelfReferenced))
-> SelfReferenced -> ReaderT SqlBackend m (Key SelfReferenced)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SelfReferenced
SelfReferenced Int
1 Int
1
        SelfReferenced -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (SelfReferenced -> ReaderT SqlBackend m ())
-> SelfReferenced -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SelfReferenced
SelfReferenced Int
2 Int
1
        Key SelfReferenced -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key SelfReferenced
kf
        [Entity SelfReferenced]
srs <- [Filter SelfReferenced]
-> [SelectOpt SelfReferenced]
-> ReaderT SqlBackend m [Entity SelfReferenced]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity SelfReferenced]
expected = [] :: [Entity SelfReferenced]
        [Entity SelfReferenced]
srs [Entity SelfReferenced]
-> [Entity SelfReferenced] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity SelfReferenced]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascade works on simple references" (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 SimpleCascade
scId <- SimpleCascade -> ReaderT SqlBackend m (Key SimpleCascade)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (SimpleCascade -> ReaderT SqlBackend m (Key SimpleCascade))
-> SimpleCascade -> ReaderT SqlBackend m (Key SimpleCascade)
forall a b. (a -> b) -> a -> b
$ Int -> SimpleCascade
SimpleCascade Int
1
        Key SimpleCascadeChild
sccId <- SimpleCascadeChild -> ReaderT SqlBackend m (Key SimpleCascadeChild)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (SimpleCascadeChild
 -> ReaderT SqlBackend m (Key SimpleCascadeChild))
-> SimpleCascadeChild
-> ReaderT SqlBackend m (Key SimpleCascadeChild)
forall a b. (a -> b) -> a -> b
$ Key SimpleCascade -> SimpleCascadeChild
SimpleCascadeChild Key SimpleCascade
scId
        Just SimpleCascadeChild
_ <- Key SimpleCascadeChild
-> ReaderT SqlBackend m (Maybe SimpleCascadeChild)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key SimpleCascadeChild
sccId
        Key SimpleCascade -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key SimpleCascade
scId
        Maybe SimpleCascadeChild
mres <- Key SimpleCascadeChild
-> ReaderT SqlBackend m (Maybe SimpleCascadeChild)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key SimpleCascadeChild
sccId
        [Entity SimpleCascadeChild]
mxs <- [Filter SimpleCascadeChild]
-> [SelectOpt SimpleCascadeChild]
-> ReaderT SqlBackend m [Entity SimpleCascadeChild]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList @SimpleCascadeChild [] []
        IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ do
            Maybe SimpleCascadeChild
mres Maybe SimpleCascadeChild -> Maybe SimpleCascadeChild -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Maybe SimpleCascadeChild
forall a. Maybe a
Nothing
            [Entity SimpleCascadeChild]
mxs [Entity SimpleCascadeChild] -> [Entity SimpleCascadeChild] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` []
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascades with explicit Reference" (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 A
kf <- A -> ReaderT SqlBackend m (Key A)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (A -> ReaderT SqlBackend m (Key A))
-> A -> ReaderT SqlBackend m (Key A)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> A
A Int
1 Int
40
        B -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (B -> ReaderT SqlBackend m ()) -> B -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> B
B Int
1 Int
15
        Key A -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key A
kf
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [Entity B]
cs <- [Filter B] -> [SelectOpt B] -> ReaderT SqlBackend m [Entity B]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity B]
expected = [] :: [Entity B]
        [Entity B]
cs [Entity B] -> [Entity B] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity B]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascades with explicit Composite Reference" (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 AComposite
kf <- AComposite -> ReaderT SqlBackend m (Key AComposite)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (AComposite -> ReaderT SqlBackend m (Key AComposite))
-> AComposite -> ReaderT SqlBackend m (Key AComposite)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AComposite
AComposite Int
1 Int
20
        BComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (BComposite -> ReaderT SqlBackend m ())
-> BComposite -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BComposite
BComposite Int
1 Int
20
        Key AComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key AComposite
kf
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [Entity B]
cs <- [Filter B] -> [SelectOpt B] -> ReaderT SqlBackend m [Entity B]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity B]
expected = [] :: [Entity B]
        [Entity B]
cs [Entity B] -> [Entity B] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity B]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascades with explicit Composite Reference" (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 AComposite
kf <- AComposite -> ReaderT SqlBackend m (Key AComposite)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (AComposite -> ReaderT SqlBackend m (Key AComposite))
-> AComposite -> ReaderT SqlBackend m (Key AComposite)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AComposite
AComposite Int
1 Int
20
        BComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (BComposite -> ReaderT SqlBackend m ())
-> BComposite -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BComposite
BComposite Int
1 Int
20
        Key AComposite -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key AComposite
kf
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [Entity B]
cs <- [Filter B] -> [SelectOpt B] -> ReaderT SqlBackend m [Entity B]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity B]
expected = [] :: [Entity B]
        [Entity B]
cs [Entity B] -> [Entity B] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity B]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"delete cascades with explicit 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 A
kf <- A -> ReaderT SqlBackend m (Key A)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (A -> ReaderT SqlBackend m (Key A))
-> A -> ReaderT SqlBackend m (Key A)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> A
A Int
1 Int
20
        BExplicit -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (BExplicit -> ReaderT SqlBackend m ())
-> BExplicit -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Key A -> BExplicit
BExplicit Key A
kf
        Key A -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key A
kf
        () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        [Entity B]
cs <- [Filter B] -> [SelectOpt B] -> ReaderT SqlBackend m [Entity B]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity B]
expected = [] :: [Entity B]
        [Entity B]
cs [Entity B] -> [Entity B] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity B]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deletes sets null with self reference" (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 Chain
kf <- Chain -> ReaderT SqlBackend m (Key Chain)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Chain -> ReaderT SqlBackend m (Key Chain))
-> Chain -> ReaderT SqlBackend m (Key Chain)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Key Chain) -> Chain
Chain Int
1 Maybe (Key Chain)
forall a. Maybe a
Nothing
        Key Chain
kf' <- Chain -> ReaderT SqlBackend m (Key Chain)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Chain -> ReaderT SqlBackend m (Key Chain))
-> Chain -> ReaderT SqlBackend m (Key Chain)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Key Chain) -> Chain
Chain Int
2 (Key Chain -> Maybe (Key Chain)
forall a. a -> Maybe a
Just Key Chain
kf)
        Key Chain -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key Chain
kf
        [Entity Chain]
cs <- [Filter Chain]
-> [SelectOpt Chain] -> ReaderT SqlBackend m [Entity Chain]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity Chain]
expected = [Entity :: forall record. Key record -> record -> Entity record
Entity {entityKey :: Key Chain
entityKey = Key Chain
kf', entityVal :: Chain
entityVal = Int -> Maybe (Key Chain) -> Chain
Chain Int
2 Maybe (Key Chain)
forall a. Maybe a
Nothing}]
        [Entity Chain] -> [Entity Chain]
forall a. Ord a => [a] -> [a]
List.sort [Entity Chain]
cs [Entity Chain] -> [Entity Chain] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity Chain] -> [Entity Chain]
forall a. Ord a => [a] -> [a]
List.sort [Entity Chain]
expected
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"deletes cascades with self reference to the whole chain" (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 Chain2
k1 <- Chain2 -> ReaderT SqlBackend m (Key Chain2)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Chain2 -> ReaderT SqlBackend m (Key Chain2))
-> Chain2 -> ReaderT SqlBackend m (Key Chain2)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Key Chain2) -> Chain2
Chain2 Int
1 Maybe (Key Chain2)
forall a. Maybe a
Nothing
        Key Chain2
k2 <- Chain2 -> ReaderT SqlBackend m (Key Chain2)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Chain2 -> ReaderT SqlBackend m (Key Chain2))
-> Chain2 -> ReaderT SqlBackend m (Key Chain2)
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Key Chain2) -> Chain2
Chain2 Int
2 (Key Chain2 -> Maybe (Key Chain2)
forall a. a -> Maybe a
Just Key Chain2
k1)
        Chain2 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ (Chain2 -> ReaderT SqlBackend m ())
-> Chain2 -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Int -> Maybe (Key Chain2) -> Chain2
Chain2 Int
3 (Key Chain2 -> Maybe (Key Chain2)
forall a. a -> Maybe a
Just Key Chain2
k2)
        Key Chain2 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key Chain2
k1
        [Entity Chain2]
cs <- [Filter Chain2]
-> [SelectOpt Chain2] -> ReaderT SqlBackend m [Entity Chain2]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [] []
        let expected :: [Entity Chain2]
expected = [] :: [Entity Chain2]
        [Entity Chain2]
cs [Entity Chain2] -> [Entity Chain2] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Entity Chain2]
expected

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"EntityDef" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let ed :: EntityDef
ed =
                Proxy SimpleCascadeChild -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy SimpleCascadeChild
forall k (t :: k). Proxy t
Proxy @SimpleCascadeChild)
            isRefCol :: FieldDef -> Bool
isRefCol =
                (Text -> HaskellName
HaskellName Text
"ref" HaskellName -> HaskellName -> Bool
forall a. Eq a => a -> a -> Bool
==) (HaskellName -> Bool)
-> (FieldDef -> HaskellName) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> HaskellName
fieldHaskell
            expected :: FieldCascade
expected = FieldCascade :: Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
FieldCascade
                { fcOnUpdate :: Maybe CascadeAction
fcOnUpdate = Maybe CascadeAction
forall a. Maybe a
Nothing
                , fcOnDelete :: Maybe CascadeAction
fcOnDelete = CascadeAction -> Maybe CascadeAction
forall a. a -> Maybe a
Just CascadeAction
Cascade
                }
            Just FieldDef
refField =
                (FieldDef -> Bool) -> [FieldDef] -> Maybe FieldDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find FieldDef -> Bool
isRefCol (EntityDef -> [FieldDef]
entityFields EntityDef
ed)

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses into fieldCascade"  (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
            FieldDef -> FieldCascade
fieldCascade FieldDef
refField FieldCascade -> FieldCascade -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` FieldCascade
expected

        String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"shouldn't have cascade in extras" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
            EntityDef -> Map Text [ExtraLine]
entityExtra EntityDef
ed
                Map Text [ExtraLine] -> Map Text [ExtraLine] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe`
                    Map Text [ExtraLine]
forall a. Monoid a => a
mempty

cleanDB :: (MonadIO m) => SqlPersistT m ()
cleanDB :: SqlPersistT m ()
cleanDB = do
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity SimpleCascadeChild,
 PersistEntityBackend SimpleCascadeChild ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @SimpleCascadeChild
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity SimpleCascade,
 PersistEntityBackend SimpleCascade ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @SimpleCascade
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity Parent, PersistEntityBackend Parent ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @Parent
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity ParentComposite,
 PersistEntityBackend ParentComposite ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @ParentComposite
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity ParentImplicit,
 PersistEntityBackend ParentImplicit ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @ParentImplicit
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity Child, PersistEntityBackend Child ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @Child
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity ChildComposite,
 PersistEntityBackend ChildComposite ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @ChildComposite
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity ChildImplicit,
 PersistEntityBackend ChildImplicit ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @ChildImplicit
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity SelfReferenced,
 PersistEntityBackend SelfReferenced ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @SelfReferenced
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity A, PersistEntityBackend A ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @A
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity AComposite,
 PersistEntityBackend AComposite ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @AComposite
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity B, PersistEntityBackend B ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @B
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity BExplicit,
 PersistEntityBackend BExplicit ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @BExplicit
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity BComposite,
 PersistEntityBackend BComposite ~ SqlBackend, MonadIO m) =>
SqlPersistT m ()
del @BComposite
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity Chain, PersistEntityBackend Chain ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @Chain
    forall a (m :: * -> *).
(PersistEntity a, PersistEntityBackend a ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
forall (m :: * -> *).
(PersistEntity Chain2, PersistEntityBackend Chain2 ~ SqlBackend,
 MonadIO m) =>
SqlPersistT m ()
del @Chain2

del
    :: forall a m.
    ( PersistEntity a
    , PersistEntityBackend a ~ SqlBackend
    , MonadIO m
    )
    => SqlPersistT m ()
del :: SqlPersistT m ()
del = [Filter a] -> SqlPersistT m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere @_ @_ @a []