{-# 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)])