{-# language ScopedTypeVariables, DataKinds #-}

module RawSqlTest where

import Data.Coerce
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.Text as T

import Init
import Database.Persist.SqlBackend
import PersistTestPetType
import PersistentTestModels

specsWith :: Runner SqlBackend 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
"rawSql" (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
"2+2" (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
        [Single Int]
ret <- Text -> [PersistValue] -> ReaderT SqlBackend m [Single Int]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT 2+2" []
        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
$ [Single Int]
ret [Single Int] -> [Single Int] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [Int -> Single Int
forall a. a -> Single a
Single (Int
4::Int)]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"?-?" (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
        [Single Int]
ret <- Text -> [PersistValue] -> ReaderT SqlBackend m [Single Int]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT ?-?" [Int64 -> PersistValue
PersistInt64 Int64
5, Int64 -> PersistValue
PersistInt64 Int64
3]
        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
$ [Single Int]
ret [Single Int] -> [Single Int] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [Int -> Single Int
forall a. a -> Single a
Single (Int
2::Int)]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"NULL" (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
        [Maybe (Single Int)]
ret <- Text -> [PersistValue] -> ReaderT SqlBackend m [Maybe (Single Int)]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT NULL" []
        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
$ [Maybe (Single Int)]
ret [Maybe (Single Int)] -> [Maybe (Single Int)] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [Maybe (Single Int)
forall a. Maybe a
Nothing :: Maybe (Single Int)]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"entity" (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
        Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1 <- PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PersonGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend)))
-> PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Mathias"   Int
23 Maybe Text
forall a. Maybe a
Nothing
        Entity Key (PersonGeneric SqlBackend)
p2k PersonGeneric SqlBackend
p2 <- PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PersonGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend)))
-> PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Norbert"   Int
44 Maybe Text
forall a. Maybe a
Nothing
        Entity Key (PersonGeneric SqlBackend)
p3k PersonGeneric SqlBackend
_  <- PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PersonGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend)))
-> PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Cassandra" Int
19 Maybe Text
forall a. Maybe a
Nothing
        Entity Key (PersonGeneric SqlBackend)
_   PersonGeneric SqlBackend
_  <- PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PersonGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend)))
-> PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PersonGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Thiago"    Int
19 Maybe Text
forall a. Maybe a
Nothing
        Entity Key (PetGeneric SqlBackend)
a1k PetGeneric SqlBackend
a1 <- PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PetGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend)))
-> PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p1k Text
"Rodolfo" PetType
Cat
        Entity Key (PetGeneric SqlBackend)
a2k PetGeneric SqlBackend
a2 <- PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PetGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend)))
-> PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p1k Text
"Zeno"    PetType
Cat
        Entity Key (PetGeneric SqlBackend)
a3k PetGeneric SqlBackend
a3 <- PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PetGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend)))
-> PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p2k Text
"Lhama"   PetType
Dog
        Entity Key (PetGeneric SqlBackend)
_   PetGeneric SqlBackend
_  <- PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (PetGeneric SqlBackend
 -> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend)))
-> PetGeneric SqlBackend
-> ReaderT SqlBackend m (Entity (PetGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p3k Text
"Abacate" PetType
Cat
        Text -> Text
escape <- ReaderT SqlBackend m (Text -> Text)
forall (m :: * -> *). MonadReader SqlBackend m => m (Text -> Text)
getEscape
        Text
person <- PersonGeneric SqlBackend -> ReaderT SqlBackend m Text
forall record (m :: * -> *) backend.
(PersistEntity record, BackendCompatible SqlBackend backend,
 Monad m) =>
record -> ReaderT backend m Text
getTableName (String -> PersonGeneric SqlBackend
forall a. HasCallStack => String -> a
error String
"rawSql Person" :: Person)
        Text
name_   <- EntityField (PersonGeneric SqlBackend) Text
-> ReaderT SqlBackend m Text
forall record typ (m :: * -> *) backend.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 BackendCompatible SqlBackend backend, Monad m) =>
EntityField record typ -> ReaderT backend m Text
getFieldName EntityField (PersonGeneric SqlBackend) Text
forall backend typ.
(typ ~ Text) =>
EntityField (PersonGeneric backend) typ
PersonName
        Text
pet <- PetGeneric SqlBackend -> ReaderT SqlBackend m Text
forall record (m :: * -> *) backend.
(PersistEntity record, BackendCompatible SqlBackend backend,
 Monad m) =>
record -> ReaderT backend m Text
getTableName (String -> PetGeneric SqlBackend
forall a. HasCallStack => String -> a
error String
"rawSql Pet" :: Pet)
        Text
petName_   <- EntityField (PetGeneric SqlBackend) Text
-> ReaderT SqlBackend m Text
forall record typ (m :: * -> *) backend.
(PersistEntity record, PersistEntityBackend record ~ SqlBackend,
 BackendCompatible SqlBackend backend, Monad m) =>
EntityField record typ -> ReaderT backend m Text
getFieldName EntityField (PetGeneric SqlBackend) Text
forall backend typ.
(typ ~ Text) =>
EntityField (PetGeneric backend) typ
PetName
        let query :: Text
query = [Text] -> Text
T.concat [ Text
"SELECT ??, ?? "
                             , Text
"FROM ", Text
person
                             , Text
", ", Text -> Text
escape Text
"Pet"
                             , Text
" WHERE ", Text
person, Text
".", Text -> Text
escape Text
"age", Text
" >= ? "
                             , Text
"AND ", Text -> Text
escape Text
"Pet", Text
".", Text -> Text
escape Text
"ownerId", Text
" = "
                                     , Text
person, Text
".", Text -> Text
escape Text
"id"
                             , Text
" ORDER BY ", Text
person, Text
".", Text
name_, Text
", ", Text
pet, Text
".", Text
petName_
                             ]
        [(Entity (PersonGeneric SqlBackend),
  Entity (PetGeneric SqlBackend))]
ret <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(Entity (PersonGeneric SqlBackend),
       Entity (PetGeneric SqlBackend))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query [Int64 -> PersistValue
PersistInt64 Int64
20]
        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
$ [(Entity (PersonGeneric SqlBackend),
  Entity (PetGeneric SqlBackend))]
ret [(Entity (PersonGeneric SqlBackend),
  Entity (PetGeneric SqlBackend))]
-> [(Entity (PersonGeneric SqlBackend),
     Entity (PetGeneric SqlBackend))]
-> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [ (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a1k PetGeneric SqlBackend
a1)
                         , (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a2k PetGeneric SqlBackend
a2)
                         , (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p2k PersonGeneric SqlBackend
p2, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a3k PetGeneric SqlBackend
a3) ]
        [(Maybe (Entity (PersonGeneric SqlBackend)),
  Maybe (Entity (PetGeneric SqlBackend)))]
ret2 <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(Maybe (Entity (PersonGeneric SqlBackend)),
       Maybe (Entity (PetGeneric SqlBackend)))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query [Int64 -> PersistValue
PersistInt64 Int64
20]
        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
$ [(Maybe (Entity (PersonGeneric SqlBackend)),
  Maybe (Entity (PetGeneric SqlBackend)))]
ret2 [(Maybe (Entity (PersonGeneric SqlBackend)),
  Maybe (Entity (PetGeneric SqlBackend)))]
-> [(Maybe (Entity (PersonGeneric SqlBackend)),
     Maybe (Entity (PetGeneric SqlBackend)))]
-> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [ (Entity (PersonGeneric SqlBackend)
-> Maybe (Entity (PersonGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1), Entity (PetGeneric SqlBackend)
-> Maybe (Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a1k PetGeneric SqlBackend
a1))
                          , (Entity (PersonGeneric SqlBackend)
-> Maybe (Entity (PersonGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1), Entity (PetGeneric SqlBackend)
-> Maybe (Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a2k PetGeneric SqlBackend
a2))
                          , (Entity (PersonGeneric SqlBackend)
-> Maybe (Entity (PersonGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p2k PersonGeneric SqlBackend
p2), Entity (PetGeneric SqlBackend)
-> Maybe (Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a3k PetGeneric SqlBackend
a3)) ]
        [Maybe
   (Entity (PersonGeneric SqlBackend),
    Entity (PetGeneric SqlBackend))]
ret3 <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [Maybe
        (Entity (PersonGeneric SqlBackend),
         Entity (PetGeneric SqlBackend))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query [Int64 -> PersistValue
PersistInt64 Int64
20]
        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
$ [Maybe
   (Entity (PersonGeneric SqlBackend),
    Entity (PetGeneric SqlBackend))]
ret3 [Maybe
   (Entity (PersonGeneric SqlBackend),
    Entity (PetGeneric SqlBackend))]
-> [Maybe
      (Entity (PersonGeneric SqlBackend),
       Entity (PetGeneric SqlBackend))]
-> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [ (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
-> Maybe
     (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a1k PetGeneric SqlBackend
a1)
                          , (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
-> Maybe
     (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a2k PetGeneric SqlBackend
a2)
                          , (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
-> Maybe
     (Entity (PersonGeneric SqlBackend), Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p2k PersonGeneric SqlBackend
p2, Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a3k PetGeneric SqlBackend
a3) ]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"order-proof" (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 p1 :: PersonGeneric backend
p1 = Text -> Int -> Maybe Text -> PersonGeneric backend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Zacarias" Int
93 Maybe Text
forall a. Maybe a
Nothing
        Key (PersonGeneric SqlBackend)
p1k <- PersonGeneric SqlBackend
-> ReaderT SqlBackend m (Key (PersonGeneric SqlBackend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert PersonGeneric SqlBackend
forall backend. PersonGeneric backend
p1
        Text -> Text
escape <- ReaderT SqlBackend m (Text -> Text)
forall (m :: * -> *). MonadReader SqlBackend m => m (Text -> Text)
getEscape
        let query :: Text
query = [Text] -> Text
T.concat [ Text
"SELECT ?? "
                             , Text
"FROM ", Text -> Text
escape Text
"Person"
                             ]
        [Entity (PersonGeneric SqlBackend)]
ret1 <- Text
-> [PersistValue]
-> ReaderT SqlBackend m [Entity (PersonGeneric SqlBackend)]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query []
        [Entity (ReverseFieldOrder (PersonGeneric SqlBackend))]
ret2 <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [Entity (ReverseFieldOrder (PersonGeneric SqlBackend))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query [] :: MonadIO m => SqlPersistT m [Entity (ReverseFieldOrder Person)]
        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
$ [Entity (PersonGeneric SqlBackend)]
ret1 [Entity (PersonGeneric SqlBackend)]
-> [Entity (PersonGeneric SqlBackend)] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
forall backend. PersonGeneric backend
p1]
        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
$ [Entity (ReverseFieldOrder (PersonGeneric SqlBackend))]
ret2 [Entity (ReverseFieldOrder (PersonGeneric SqlBackend))]
-> [Entity (ReverseFieldOrder (PersonGeneric SqlBackend))] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [Key (ReverseFieldOrder (PersonGeneric SqlBackend))
-> ReverseFieldOrder (PersonGeneric SqlBackend)
-> Entity (ReverseFieldOrder (PersonGeneric SqlBackend))
forall record. Key record -> record -> Entity record
Entity (BackendKey SqlBackend
-> Key (ReverseFieldOrder (PersonGeneric SqlBackend))
forall a. BackendKey SqlBackend -> Key (ReverseFieldOrder a)
RFOKey (BackendKey SqlBackend
 -> Key (ReverseFieldOrder (PersonGeneric SqlBackend)))
-> BackendKey SqlBackend
-> Key (ReverseFieldOrder (PersonGeneric SqlBackend))
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend) -> BackendKey SqlBackend
forall backend. Key (PersonGeneric backend) -> BackendKey backend
unPersonKey Key (PersonGeneric SqlBackend)
p1k) (PersonGeneric SqlBackend
-> ReverseFieldOrder (PersonGeneric SqlBackend)
forall a. a -> ReverseFieldOrder a
RFO PersonGeneric SqlBackend
forall backend. PersonGeneric backend
p1)]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"permits prefixes" (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 r1 :: RelationshipGeneric backend
r1 = String
-> Maybe (Key (RelationshipGeneric backend))
-> RelationshipGeneric backend
forall backend.
String
-> Maybe (Key (RelationshipGeneric backend))
-> RelationshipGeneric backend
Relationship String
"Foo" Maybe (Key (RelationshipGeneric backend))
forall a. Maybe a
Nothing
        Key (RelationshipGeneric SqlBackend)
r1k <- RelationshipGeneric SqlBackend
-> ReaderT SqlBackend m (Key (RelationshipGeneric SqlBackend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert RelationshipGeneric SqlBackend
forall backend. RelationshipGeneric backend
r1
        let r2 :: RelationshipGeneric SqlBackend
r2 = String
-> Maybe (Key (RelationshipGeneric SqlBackend))
-> RelationshipGeneric SqlBackend
forall backend.
String
-> Maybe (Key (RelationshipGeneric backend))
-> RelationshipGeneric backend
Relationship String
"Bar" (Key (RelationshipGeneric SqlBackend)
-> Maybe (Key (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just Key (RelationshipGeneric SqlBackend)
r1k)
        Key (RelationshipGeneric SqlBackend)
r2k <- RelationshipGeneric SqlBackend
-> ReaderT SqlBackend m (Key (RelationshipGeneric SqlBackend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert RelationshipGeneric SqlBackend
r2
        let r3 :: RelationshipGeneric SqlBackend
r3 = String
-> Maybe (Key (RelationshipGeneric SqlBackend))
-> RelationshipGeneric SqlBackend
forall backend.
String
-> Maybe (Key (RelationshipGeneric backend))
-> RelationshipGeneric backend
Relationship String
"Lmao" (Key (RelationshipGeneric SqlBackend)
-> Maybe (Key (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just Key (RelationshipGeneric SqlBackend)
r1k)
        Key (RelationshipGeneric SqlBackend)
r3k <- RelationshipGeneric SqlBackend
-> ReaderT SqlBackend m (Key (RelationshipGeneric SqlBackend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert RelationshipGeneric SqlBackend
r3
        let r4 :: RelationshipGeneric SqlBackend
r4 = String
-> Maybe (Key (RelationshipGeneric SqlBackend))
-> RelationshipGeneric SqlBackend
forall backend.
String
-> Maybe (Key (RelationshipGeneric backend))
-> RelationshipGeneric backend
Relationship String
"Boring" (Key (RelationshipGeneric SqlBackend)
-> Maybe (Key (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just Key (RelationshipGeneric SqlBackend)
r2k)
        Key (RelationshipGeneric SqlBackend)
r4k <- RelationshipGeneric SqlBackend
-> ReaderT SqlBackend m (Key (RelationshipGeneric SqlBackend))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert RelationshipGeneric SqlBackend
r4
        Text -> Text
escape <- ReaderT SqlBackend m (Text -> Text)
forall (m :: * -> *). MonadReader SqlBackend m => m (Text -> Text)
getEscape
        let query :: Text
query = [Text] -> Text
T.concat
                [ Text
"SELECT ??, ?? "
                , Text
"FROM ", Text -> Text
escape Text
"Relationship", Text
" AS parent "
                , Text
"LEFT OUTER JOIN ", Text -> Text
escape Text
"Relationship", Text
" AS child "
                , Text
"ON parent.id = child.parent"
                ]

        [(EntityWithPrefix "parent" (RelationshipGeneric SqlBackend),
  Maybe (EntityWithPrefix "child" (RelationshipGeneric SqlBackend)))]
result :: [(EntityWithPrefix "parent" Relationship, Maybe (EntityWithPrefix "child" Relationship))] <-
            Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(EntityWithPrefix "parent" (RelationshipGeneric SqlBackend),
       Maybe (EntityWithPrefix "child" (RelationshipGeneric SqlBackend)))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query []

        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
$
            [(EntityWithPrefix "parent" (RelationshipGeneric SqlBackend),
  Maybe (EntityWithPrefix "child" (RelationshipGeneric SqlBackend)))]
-> [(Entity (RelationshipGeneric SqlBackend),
     Maybe (Entity (RelationshipGeneric SqlBackend)))]
coerce [(EntityWithPrefix "parent" (RelationshipGeneric SqlBackend),
  Maybe (EntityWithPrefix "child" (RelationshipGeneric SqlBackend)))]
result [(Entity (RelationshipGeneric SqlBackend),
  Maybe (Entity (RelationshipGeneric SqlBackend)))]
-> [(Entity (RelationshipGeneric SqlBackend),
     Maybe (Entity (RelationshipGeneric SqlBackend)))]
-> IO ()
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
`shouldMatchList`
                [ (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r1k RelationshipGeneric SqlBackend
forall backend. RelationshipGeneric backend
r1, Entity (RelationshipGeneric SqlBackend)
-> Maybe (Entity (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r2k RelationshipGeneric SqlBackend
r2))
                , (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r1k RelationshipGeneric SqlBackend
forall backend. RelationshipGeneric backend
r1, Entity (RelationshipGeneric SqlBackend)
-> Maybe (Entity (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r3k RelationshipGeneric SqlBackend
r3))
                , (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r2k RelationshipGeneric SqlBackend
r2, Entity (RelationshipGeneric SqlBackend)
-> Maybe (Entity (RelationshipGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r4k RelationshipGeneric SqlBackend
r4))
                , (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r3k RelationshipGeneric SqlBackend
r3, Maybe (Entity (RelationshipGeneric SqlBackend))
forall a. Maybe a
Nothing)
                , (Key (RelationshipGeneric SqlBackend)
-> RelationshipGeneric SqlBackend
-> Entity (RelationshipGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (RelationshipGeneric SqlBackend)
r4k RelationshipGeneric SqlBackend
r4, Maybe (Entity (RelationshipGeneric SqlBackend))
forall a. Maybe a
Nothing)
                ]


    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"OUTER JOIN" (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 insert' :: (PersistStore backend, PersistEntity val, PersistEntityBackend val ~ BaseBackend backend, MonadIO m)
                    => val -> ReaderT backend m (Key val, val)
            insert' :: val -> ReaderT backend m (Key val, val)
insert' val
v = val -> ReaderT backend m (Key val)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert val
v ReaderT backend m (Key val)
-> (Key val -> ReaderT backend m (Key val, val))
-> ReaderT backend m (Key val, val)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Key val
k -> (Key val, val) -> ReaderT backend m (Key val, val)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key val
k, val
v)
        (Key (PersonGeneric SqlBackend)
p1k, PersonGeneric SqlBackend
p1) <- PersonGeneric SqlBackend
-> ReaderT
     SqlBackend
     m
     (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend)
forall backend val (m :: * -> *).
(PersistStore backend, PersistEntity val,
 PersistEntityBackend val ~ BaseBackend backend, MonadIO m) =>
val -> ReaderT backend m (Key val, val)
insert' (PersonGeneric SqlBackend
 -> ReaderT
      SqlBackend
      m
      (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend))
-> PersonGeneric SqlBackend
-> ReaderT
     SqlBackend
     m
     (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Mathias"   Int
23 Maybe Text
forall a. Maybe a
Nothing
        (Key (PersonGeneric SqlBackend)
p2k, PersonGeneric SqlBackend
p2) <- PersonGeneric SqlBackend
-> ReaderT
     SqlBackend
     m
     (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend)
forall backend val (m :: * -> *).
(PersistStore backend, PersistEntity val,
 PersistEntityBackend val ~ BaseBackend backend, MonadIO m) =>
val -> ReaderT backend m (Key val, val)
insert' (PersonGeneric SqlBackend
 -> ReaderT
      SqlBackend
      m
      (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend))
-> PersonGeneric SqlBackend
-> ReaderT
     SqlBackend
     m
     (Key (PersonGeneric SqlBackend), PersonGeneric SqlBackend)
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Maybe Text -> PersonGeneric SqlBackend
forall backend. Text -> Int -> Maybe Text -> PersonGeneric backend
Person Text
"Norbert"   Int
44 Maybe Text
forall a. Maybe a
Nothing
        (Key (PetGeneric SqlBackend)
a1k, PetGeneric SqlBackend
a1) <- PetGeneric SqlBackend
-> ReaderT
     SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend)
forall backend val (m :: * -> *).
(PersistStore backend, PersistEntity val,
 PersistEntityBackend val ~ BaseBackend backend, MonadIO m) =>
val -> ReaderT backend m (Key val, val)
insert' (PetGeneric SqlBackend
 -> ReaderT
      SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend))
-> PetGeneric SqlBackend
-> ReaderT
     SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend)
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p1k Text
"Rodolfo" PetType
Cat
        (Key (PetGeneric SqlBackend)
a2k, PetGeneric SqlBackend
a2) <- PetGeneric SqlBackend
-> ReaderT
     SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend)
forall backend val (m :: * -> *).
(PersistStore backend, PersistEntity val,
 PersistEntityBackend val ~ BaseBackend backend, MonadIO m) =>
val -> ReaderT backend m (Key val, val)
insert' (PetGeneric SqlBackend
 -> ReaderT
      SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend))
-> PetGeneric SqlBackend
-> ReaderT
     SqlBackend m (Key (PetGeneric SqlBackend), PetGeneric SqlBackend)
forall a b. (a -> b) -> a -> b
$ Key (PersonGeneric SqlBackend)
-> Text -> PetType -> PetGeneric SqlBackend
forall backend.
Key (PersonGeneric backend)
-> Text -> PetType -> PetGeneric backend
Pet Key (PersonGeneric SqlBackend)
p1k Text
"Zeno"    PetType
Cat
        Text -> Text
escape <- ReaderT SqlBackend m (Text -> Text)
forall (m :: * -> *). MonadReader SqlBackend m => m (Text -> Text)
getEscape
        let query :: Text
query = [Text] -> Text
T.concat [ Text
"SELECT ??, ?? "
                             , Text
"FROM ", Text
person
                             , Text
"LEFT OUTER JOIN ", Text
pet
                             , Text
" ON ", Text
person, Text
".", Text -> Text
escape Text
"id"
                             , Text
" = ", Text
pet, Text
".", Text -> Text
escape Text
"ownerId"
                             , Text
" ORDER BY ", Text
person, Text
".", Text -> Text
escape Text
"name"
                             , Text
", ", Text
pet, Text
".", Text -> Text
escape Text
"id" ]
            person :: Text
person = Text -> Text
escape Text
"Person"
            pet :: Text
pet    = Text -> Text
escape Text
"Pet"
        [(Entity (PersonGeneric SqlBackend),
  Maybe (Entity (PetGeneric SqlBackend)))]
ret <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(Entity (PersonGeneric SqlBackend),
       Maybe (Entity (PetGeneric SqlBackend)))]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
query []
        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
$ [(Entity (PersonGeneric SqlBackend),
  Maybe (Entity (PetGeneric SqlBackend)))]
ret [(Entity (PersonGeneric SqlBackend),
  Maybe (Entity (PetGeneric SqlBackend)))]
-> [(Entity (PersonGeneric SqlBackend),
     Maybe (Entity (PetGeneric SqlBackend)))]
-> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [ (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Entity (PetGeneric SqlBackend)
-> Maybe (Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a1k PetGeneric SqlBackend
a1))
                         , (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p1k PersonGeneric SqlBackend
p1, Entity (PetGeneric SqlBackend)
-> Maybe (Entity (PetGeneric SqlBackend))
forall a. a -> Maybe a
Just (Key (PetGeneric SqlBackend)
-> PetGeneric SqlBackend -> Entity (PetGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PetGeneric SqlBackend)
a2k PetGeneric SqlBackend
a2))
                         , (Key (PersonGeneric SqlBackend)
-> PersonGeneric SqlBackend -> Entity (PersonGeneric SqlBackend)
forall record. Key record -> record -> Entity record
Entity Key (PersonGeneric SqlBackend)
p2k PersonGeneric SqlBackend
p2, Maybe (Entity (PetGeneric SqlBackend))
forall a. Maybe a
Nothing) ]

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"handles lower casing" (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
            ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
-> ReaderT SqlBackend m ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes (ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
 -> ReaderT SqlBackend m ())
-> ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Text
-> [PersistValue]
-> ConduitM () [PersistValue] (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) env.
(MonadResource m, MonadReader env m,
 BackendCompatible SqlBackend env) =>
Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
"SELECT full_name from lower_case_table WHERE my_id=5" [] ConduitM () [PersistValue] (ResourceT (ReaderT SqlBackend m)) ()
-> ConduitM
     [PersistValue] Void (ResourceT (ReaderT SqlBackend m)) ()
-> ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM [PersistValue] Void (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull
            ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
-> ReaderT SqlBackend m ()
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes (ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
 -> ReaderT SqlBackend m ())
-> ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
-> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Text
-> [PersistValue]
-> ConduitM () [PersistValue] (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) env.
(MonadResource m, MonadReader env m,
 BackendCompatible SqlBackend env) =>
Text -> [PersistValue] -> ConduitM () [PersistValue] m ()
rawQuery Text
"SELECT something_else from ref_table WHERE id=4" [] ConduitM () [PersistValue] (ResourceT (ReaderT SqlBackend m)) ()
-> ConduitM
     [PersistValue] Void (ResourceT (ReaderT SqlBackend m)) ()
-> ConduitT () Void (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ConduitM [PersistValue] Void (ResourceT (ReaderT SqlBackend m)) ()
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"commit/rollback" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
        RunDb SqlBackend m -> IO ()
forall (m :: * -> *).
Runner SqlBackend m =>
RunDb SqlBackend m -> IO ()
caseCommitRollback RunDb SqlBackend m
runDb
        RunDb SqlBackend m
runDb ReaderT SqlBackend m ()
forall (m :: * -> *) backend.
(MonadIO m, PersistQuery backend,
 PersistStoreWrite (BaseBackend backend)) =>
ReaderT backend m ()
cleanDB

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"queries with large number of results" (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
        -- max size of a GHC tuple is 62, but Eq instances currently only exist up to 15-tuples
        -- See https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3369
        [(Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int)]
ret <- Text
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(Single Int, Single Int, Single Int, Single Int, Single Int,
       Single Int, Single Int, Single Int, Single Int, Single Int,
       Single Int, Single Int, Single Int, Single Int, Single Int)]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT ?,?,?,?,?,?,?,?,?,?,?,?,?,?,?" ([PersistValue]
 -> ReaderT
      SqlBackend
      m
      [(Single Int, Single Int, Single Int, Single Int, Single Int,
        Single Int, Single Int, Single Int, Single Int, Single Int,
        Single Int, Single Int, Single Int, Single Int, Single Int)])
-> [PersistValue]
-> ReaderT
     SqlBackend
     m
     [(Single Int, Single Int, Single Int, Single Int, Single Int,
       Single Int, Single Int, Single Int, Single Int, Single Int,
       Single Int, Single Int, Single Int, Single Int, Single Int)]
forall a b. (a -> b) -> a -> b
$ (Int64 -> PersistValue) -> [Int64] -> [PersistValue]
forall a b. (a -> b) -> [a] -> [b]
map Int64 -> PersistValue
PersistInt64 [Int64
1..Int64
15]
        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
$ [(Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int)]
ret [(Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int,
  Single Int, Single Int, Single Int, Single Int, Single Int)]
-> [(Single Int, Single Int, Single Int, Single Int, Single Int,
     Single Int, Single Int, Single Int, Single Int, Single Int,
     Single Int, Single Int, Single Int, Single Int, Single Int)]
-> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= [(Int -> Single Int
forall a. a -> Single a
Single (Int
1::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
2::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
3::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
4::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
5::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
6::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
7::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
8::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
9::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
10::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
11::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
12::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
13::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
14::Int), Int -> Single Int
forall a. a -> Single a
Single (Int
15::Int))]

getEscape :: MonadReader SqlBackend m => m (Text -> Text)
getEscape :: m (Text -> Text)
getEscape = m (Text -> Text)
forall backend (m :: * -> *).
(BackendCompatible SqlBackend backend, MonadReader backend m) =>
m (Text -> Text)
getEscapeRawNameFunction

caseCommitRollback :: Runner SqlBackend m => RunDb SqlBackend m -> Assertion
caseCommitRollback :: RunDb SqlBackend m -> IO ()
caseCommitRollback RunDb SqlBackend m
runDb = RunDb SqlBackend m
runDb RunDb SqlBackend m -> RunDb SqlBackend m
forall a b. (a -> b) -> a -> b
$ do
    let filt :: [Filter Person1]
        filt :: [Filter Person1]
filt = []

    let p :: Person1Generic backend
p = Text -> Int -> Person1Generic backend
forall backend. Text -> Int -> Person1Generic backend
Person1 Text
"foo" Int
0

    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p

    Int
c1 <- [Filter Person1] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter Person1]
filt
    Int
c1 Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
3

    ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
    Int
c2 <- [Filter Person1] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter Person1]
filt
    Int
c2 Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
3

    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionUndo
    Int
c3 <- [Filter Person1] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter Person1]
filt
    Int
c3 Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
3

    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    Person1 -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Person1
forall backend. Person1Generic backend
p
    ReaderT SqlBackend m ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionUndo
    Int
c4 <- [Filter Person1] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [Filter Person1]
filt
    Int
c4 Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
4