{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module CustomPersistFieldTest (specsWith, customFieldMigrate) where import CustomPersistField import Init share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "customFieldMigrate"] [persistLowerCase| BlogPost article Markdown deriving Show Eq |] specsWith :: Runner backend m => RunDb backend m -> Spec specsWith :: RunDb backend m -> Spec specsWith RunDb backend m runDB = String -> Spec -> Spec forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Custom persist field" (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 "should read what it wrote" (IO () -> SpecWith (Arg (IO ()))) -> IO () -> SpecWith (Arg (IO ())) 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 let originalBlogPost :: BlogPostGeneric backend originalBlogPost = Markdown -> BlogPostGeneric backend forall backend. Markdown -> BlogPostGeneric backend BlogPost Markdown "article" Key (BlogPostGeneric backend) blogPostId <- BlogPostGeneric backend -> ReaderT backend m (Key (BlogPostGeneric backend)) forall backend record (m :: * -> *). (PersistStoreWrite backend, MonadIO m, PersistRecordBackend record backend, SafeToInsert record) => record -> ReaderT backend m (Key record) insert BlogPostGeneric backend forall backend. BlogPostGeneric backend originalBlogPost Just BlogPostGeneric backend newBlogPost <- Key (BlogPostGeneric backend) -> ReaderT backend m (Maybe (BlogPostGeneric backend)) forall backend record (m :: * -> *). (PersistStoreRead backend, MonadIO m, PersistRecordBackend record backend) => Key record -> ReaderT backend m (Maybe record) get Key (BlogPostGeneric backend) blogPostId IO () -> ReaderT backend m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> ReaderT backend m ()) -> IO () -> ReaderT backend m () forall a b. (a -> b) -> a -> b $ BlogPostGeneric backend forall backend. BlogPostGeneric backend originalBlogPost BlogPostGeneric backend -> BlogPostGeneric backend -> IO () forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO () @?= BlogPostGeneric backend newBlogPost