{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module PrimaryTest where

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 "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 :: forall (m :: * -> *) backend.
(MonadIO m, PersistQuery backend,
 PersistEntityBackend Foo ~ backend) =>
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 ()
forall (m :: * -> *) record.
(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 ()
forall (m :: * -> *) record.
(MonadIO m, PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Bar])

specsWith :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec
specsWith :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
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, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend 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, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend 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 a. a -> ReaderT SqlBackend m a
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, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
forall record (m :: * -> *).
(MonadIO m, PersistRecordBackend record SqlBackend,
 SafeToInsert record) =>
record -> ReaderT SqlBackend 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 a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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)