{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
-- This test is based on this issue: https://github.com/yesodweb/persistent/issues/421
-- The primary thing this is testing is the migration, thus the test code itself being mostly negligible.
module CustomPrimaryKeyReferenceTest 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|
  Tweet
    tweetId Int
    statusText Text sqltype=varchar(170)
    Primary tweetId
    UniqueTweetId tweetId
    deriving Show
  TweetUrl
    tweetId TweetId
    tweetUrl Text sqltype=varchar(255)
    finalUrl Text Maybe sqltype=varchar(255)
    UniqueTweetIdTweetUrl tweetId tweetUrl
    deriving Show
|]

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

specsWith :: (MonadFail m, MonadIO 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 reference" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  let tweet :: Tweet
tweet = Tweet :: Int -> Text -> Tweet
Tweet {tweetTweetId :: Int
tweetTweetId = Int
1, tweetStatusText :: Text
tweetStatusText = Text
"Hello!"}

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"can insert a Tweet" (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 Tweet
tweetId <- Tweet -> ReaderT SqlBackend m (Key Tweet)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert Tweet
tweet
    let url :: TweetUrl
url = TweetUrl :: Key Tweet -> Text -> Maybe Text -> TweetUrl
TweetUrl {tweetUrlTweetId :: Key Tweet
tweetUrlTweetId = Key Tweet
tweetId, tweetUrlTweetUrl :: Text
tweetUrlTweetUrl = Text
"http://google.com", tweetUrlFinalUrl :: Maybe Text
tweetUrlFinalUrl = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://example.com"}
    TweetUrl -> ReaderT SqlBackend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m ()
insert_ TweetUrl
url