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

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 :: 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)