{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module PrimaryTest where
import Init
share [mkPersist persistSettings { mpsGeneric = False }, mkMigrate "migration"] [persistLowerCase|
Foo
name String
Primary name
Bar
quux FooId
Trees sql=trees
name String
parent String Maybe
Primary name
Foreign Trees fkparent parent
CompositePrimary
name String
age Int
Primary name age
|]
cleanDB :: (MonadIO m, PersistQuery backend, PersistEntityBackend Foo ~ backend) => ReaderT backend m ()
cleanDB :: ReaderT backend m ()
cleanDB = do
[Filter Foo] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Foo])
[Filter Bar] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Bar])
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
"primary key reference" (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
"insert a primary 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 Foo
kf <- Foo -> ReaderT SqlBackend m (Key Foo)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Foo -> ReaderT SqlBackend m (Key Foo))
-> Foo -> ReaderT SqlBackend m (Key Foo)
forall a b. (a -> b) -> a -> b
$ String -> Foo
Foo String
"name"
Key Bar
_kb <- Bar -> ReaderT SqlBackend m (Key Bar)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Bar -> ReaderT SqlBackend m (Key Bar))
-> Bar -> ReaderT SqlBackend m (Key Bar)
forall a b. (a -> b) -> a -> b
$ Key Foo -> Bar
Bar Key Foo
kf
() -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"uses RawSql for a Primary key" (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 Foo
key <- Foo -> ReaderT SqlBackend m (Key Foo)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Foo -> ReaderT SqlBackend m (Key Foo))
-> Foo -> ReaderT SqlBackend m (Key Foo)
forall a b. (a -> b) -> a -> b
$ String -> Foo
Foo String
"name"
[Key Foo]
keyFromRaw <- Text -> [PersistValue] -> ReaderT SqlBackend m [Key Foo]
forall a (m :: * -> *) backend.
(RawSql a, MonadIO m, BackendCompatible SqlBackend backend) =>
Text -> [PersistValue] -> ReaderT backend m [a]
rawSql Text
"SELECT name FROM foo LIMIT 1" []
[Key Foo
key] [Key Foo] -> [Key Foo] -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== [Key Foo]
keyFromRaw
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"keyFromRecordM" (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
"works on singleton case" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
let
foo :: Foo
foo = String -> Foo
Foo String
"hello"
fooKey :: Maybe (Key Foo)
fooKey = ((Foo -> Key Foo) -> Key Foo)
-> Maybe (Foo -> Key Foo) -> Maybe (Key Foo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Foo -> Key Foo) -> Foo -> Key Foo
forall a b. (a -> b) -> a -> b
$ Foo
foo) Maybe (Foo -> Key Foo)
forall record. PersistEntity record => Maybe (record -> Key record)
keyFromRecordM
Maybe (Key Foo)
fooKey Maybe (Key Foo) -> Maybe (Key Foo) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Key Foo -> Maybe (Key Foo)
forall a. a -> Maybe a
Just (String -> Key Foo
FooKey String
"hello")
String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"works on multiple fields" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
let
name :: String
name = String
"hello"
age :: Int
age = Int
31
rec :: CompositePrimary
rec = String -> Int -> CompositePrimary
CompositePrimary String
name Int
age
((CompositePrimary -> Key CompositePrimary)
-> Key CompositePrimary)
-> Maybe (CompositePrimary -> Key CompositePrimary)
-> Maybe (Key CompositePrimary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((CompositePrimary -> Key CompositePrimary)
-> CompositePrimary -> Key CompositePrimary
forall a b. (a -> b) -> a -> b
$ CompositePrimary
rec) Maybe (CompositePrimary -> Key CompositePrimary)
forall record. PersistEntity record => Maybe (record -> Key record)
keyFromRecordM
Maybe (Key CompositePrimary)
-> Maybe (Key CompositePrimary) -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe`
Key CompositePrimary -> Maybe (Key CompositePrimary)
forall a. a -> Maybe a
Just (String -> Int -> Key CompositePrimary
CompositePrimaryKey String
name Int
age)