{-# LANGUAGE TypeApplications, UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module MigrationOnlyTest (specsWith, migrateAll1, migrateAll2) where

import qualified Data.Text as T

import Database.Persist.TH
import Init
import Database.Persist.EntityDef

share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll1"] [persistLowerCase|
TwoField1 sql=two_field
    field1 Int
    field2 T.Text
    field3 Bool Maybe
    deriving Eq Show
|]

share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll2"] [persistLowerCase|
TwoField
    field1 Int
    field2 T.Text
    field3 Bool Maybe MigrationOnly
    deriving Eq Show

Referencing
    field1 Int
    field2 TwoFieldId MigrationOnly
|]

specsWith
    :: (MonadIO m, PersistQueryWrite backend, PersistStoreWrite backend, PersistQueryWrite (BaseBackend backend))
    => RunDb backend m
    -> Maybe (ReaderT backend m a)
    -> Spec
specsWith :: RunDb backend m -> Maybe (ReaderT backend m a) -> Spec
specsWith RunDb backend m
runDb Maybe (ReaderT backend m a)
mmigrate = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"MigrationOnly field" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let
        edef :: EntityDef
edef =
            Proxy TwoField -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy TwoField -> EntityDef) -> Proxy TwoField -> EntityDef
forall a b. (a -> b) -> a -> b
$ Proxy TwoField
forall k (t :: k). Proxy t
Proxy @TwoField
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"getEntityFields" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let
            fields :: [FieldDef]
fields =
                EntityDef -> [FieldDef]
getEntityFields EntityDef
edef
        String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should have two fields" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
            [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDef]
fields Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
2
        String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should not have any migration only fields" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
            [FieldDef]
fields [FieldDef] -> ([FieldDef] -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (FieldDef -> Bool) -> [FieldDef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FieldDef -> Bool
isHaskellField

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"getEntityFieldsDatabase" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        let
            fields :: [FieldDef]
fields =
                EntityDef -> [FieldDef]
getEntityFieldsDatabase EntityDef
edef
        String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should have three fields" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
            [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FieldDef]
fields Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
3
        String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should have at one migration only field" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
            [FieldDef] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ((FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FieldDef -> Bool) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Bool
isHaskellField) [FieldDef]
fields) Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
1

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"doesn't have the field in the Haskell entity" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ Expectation -> Expectation
forall a. IO a -> IO a
asIO (Expectation -> Expectation) -> Expectation -> Expectation
forall a b. (a -> b) -> a -> b
$ RunDb backend m
runDb RunDb backend m -> RunDb backend m
forall a b. (a -> b) -> a -> b
$ do
        Maybe (ReaderT backend m a) -> ReaderT backend m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Maybe (ReaderT backend m a)
mmigrate
        Maybe (ReaderT backend m a) -> ReaderT backend m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ Maybe (ReaderT backend m a)
mmigrate
        let tf :: TwoFieldGeneric backend
tf = Int -> Text -> TwoFieldGeneric backend
forall backend. Int -> Text -> TwoFieldGeneric backend
TwoField Int
5 Text
"hello"
        Key (TwoFieldGeneric (BaseBackend backend))
tid <- TwoFieldGeneric (BaseBackend backend)
-> ReaderT backend m (Key (TwoFieldGeneric (BaseBackend backend)))
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert TwoFieldGeneric (BaseBackend backend)
forall backend. TwoFieldGeneric backend
tf
        Maybe (TwoFieldGeneric (BaseBackend backend))
mtf <- Key (TwoFieldGeneric (BaseBackend backend))
-> ReaderT
     backend m (Maybe (TwoFieldGeneric (BaseBackend backend)))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (TwoFieldGeneric (BaseBackend backend))
tid
        Expectation -> ReaderT backend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Expectation -> ReaderT backend m ())
-> Expectation -> ReaderT backend m ()
forall a b. (a -> b) -> a -> b
$ Maybe (TwoFieldGeneric (BaseBackend backend))
mtf Maybe (TwoFieldGeneric (BaseBackend backend))
-> Maybe (TwoFieldGeneric (BaseBackend backend)) -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= TwoFieldGeneric (BaseBackend backend)
-> Maybe (TwoFieldGeneric (BaseBackend backend))
forall a. a -> Maybe a
Just TwoFieldGeneric (BaseBackend backend)
forall backend. TwoFieldGeneric backend
tf
        [Filter (TwoFieldGeneric (BaseBackend backend))]
-> ReaderT backend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (TwoFieldGeneric backend)])