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