{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module PersistUniqueTest 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|
  Fo
      foo Int
      bar Int
      Primary foo
      UniqueBar bar
      deriving Eq Show
|]

cleanDB :: (MonadIO m, PersistQuery backend, PersistEntityBackend Fo ~ backend) => ReaderT backend m ()
cleanDB :: ReaderT backend m ()
cleanDB = do
  [Filter Fo] -> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter Fo])

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
"custom primary key" (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
"getBy" (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 b :: Int
b = Int
5
    Key Fo
k <- Fo -> ReaderT SqlBackend m (Key Fo)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Fo -> ReaderT SqlBackend m (Key Fo))
-> Fo -> ReaderT SqlBackend m (Key Fo)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Fo
Fo Int
3 Int
b
    Just Fo
vk <- Key Fo -> ReaderT SqlBackend m (Maybe Fo)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key Fo
k
    Just Entity Fo
vu <- Unique Fo -> ReaderT SqlBackend m (Maybe (Entity Fo))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy (Int -> Unique Fo
UniqueBar Int
b)
    Entity Fo
vu Entity Fo -> Entity Fo -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key Fo -> Fo -> Entity Fo
forall record. Key record -> record -> Entity record
Entity Key Fo
k Fo
vk
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"insertUniqueEntity" (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 fo :: Fo
fo = Int -> Int -> Fo
Fo Int
3 Int
5
    Just (Entity Key Fo
_ Fo
insertedFoValue) <- Fo -> ReaderT SqlBackend m (Maybe (Entity Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueWrite backend) =>
record -> ReaderT backend m (Maybe (Entity record))
insertUniqueEntity Fo
fo
    Maybe (Entity Fo)
Nothing <- Fo -> ReaderT SqlBackend m (Maybe (Entity Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueWrite backend) =>
record -> ReaderT backend m (Maybe (Entity record))
insertUniqueEntity Fo
fo
    Fo
fo Fo -> Fo -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Fo
insertedFoValue
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"checkUniqueUpdateable" (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 f :: Int
f = Int
3
    let b :: Int
b = Int
5
    let fo :: Fo
fo = Int -> Int -> Fo
Fo Int
f Int
b
    Key Fo
k <- Fo -> ReaderT SqlBackend m (Key Fo)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert Fo
fo
    Just Unique Fo
_ <- Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
checkUnique Fo
fo -- conflicts with itself

    let fo' :: Fo
fo' = Int -> Int -> Fo
Fo (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
b
    Just Unique Fo
_ <- Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
record -> ReaderT backend m (Maybe (Unique record))
checkUnique Fo
fo' -- conflicts with fo
    Maybe (Unique Fo)
Nothing <- Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
Entity record -> ReaderT backend m (Maybe (Unique record))
checkUniqueUpdateable (Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo)))
-> Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall a b. (a -> b) -> a -> b
$ Key Fo -> Fo -> Entity Fo
forall record. Key record -> record -> Entity record
Entity Key Fo
k Fo
fo' -- but fo can be updated to fo'

    let fo'' :: Fo
fo'' = Int -> Int -> Fo
Fo (Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Fo -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m ()
insert_ Fo
fo''
    Just (UniqueBar conflict) <- Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall record backend (m :: * -> *).
(MonadIO m, PersistRecordBackend record backend,
 PersistUniqueRead backend) =>
Entity record -> ReaderT backend m (Maybe (Unique record))
checkUniqueUpdateable (Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo)))
-> Entity Fo -> ReaderT SqlBackend m (Maybe (Unique Fo))
forall a b. (a -> b) -> a -> b
$ Key Fo -> Fo -> Entity Fo
forall record. Key record -> record -> Entity record
Entity Key Fo
k Fo
fo'' -- fo can't be updated to fo''
    Int
conflict Int -> Int -> ReaderT SqlBackend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1