{-# LANGUAGE TypeApplications, UndecidableInstances #-}

module RenameTest where

import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Time (getCurrentTime, Day, UTCTime(..))

import Init

-- persistent used to not allow types with an "Id" suffix
-- this verifies that the issue is fixed
type TextId = Text

-- Test lower case names
share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migration"] [persistLowerCase|
-- This just tests that a field can be named "key"
KeyTable
    key Text
    deriving Eq Show

IdTable
    -- this used to have a default=CURRENT_DATE, but the test that uses it
    -- specifies that there is no default on this column. the default is
    -- failing MySQL and sqlite tests since they don't have shared overlap on
    -- an appropriate default for a date.
    Id   Day
    name Text
    -- This was added to test the ability to break a cycle
    -- getting rid of the Maybe should be a compilation failure
    keyTableEmbed IdTable Maybe
    deriving Eq Show

LowerCaseTable
    Id            sql=my_id
    fullName Text
    ExtraBlock
        foo bar
        baz
        bin
    ExtraBlock2
        something

RefTable
    someVal Int sql=something_else
    lct LowerCaseTableId
    text TextId
    UniqueRefTable someVal

-- Test a reference to a non-int Id
ForeignIdTable
    idId IdTableId
|]

cleanDB
    :: forall backend.
    ( BaseBackend backend ~ backend
    , PersistQueryWrite backend
    )
    => ReaderT backend IO ()
cleanDB :: ReaderT backend IO ()
cleanDB = do
  [Filter (IdTableGeneric backend)] -> ReaderT backend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (IdTableGeneric backend)])
  [Filter (LowerCaseTableGeneric backend)] -> ReaderT backend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (LowerCaseTableGeneric backend)])
  [Filter (RefTableGeneric backend)] -> ReaderT backend IO ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere ([] :: [Filter (RefTableGeneric backend)])

specsWith
    ::
    ( PersistStoreWrite backend, PersistQueryRead backend
    , backend ~ BaseBackend backend
    , MonadIO m, MonadFail m
    , Eq (BackendKey backend)
    )
    => 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
"rename specs" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"LowerCaseTable" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"LowerCaseTable has the right sql name" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
            (FieldDef -> FieldNameDB) -> Maybe FieldDef -> Maybe FieldNameDB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDef -> FieldNameDB
fieldDB (EntityDef -> Maybe FieldDef
getEntityIdField (Proxy LowerCaseTable -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Proxy LowerCaseTable
forall k (t :: k). Proxy t
Proxy @LowerCaseTable)))
                Maybe FieldNameDB -> Maybe FieldNameDB -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe`
                    FieldNameDB -> Maybe FieldNameDB
forall a. a -> Maybe a
Just (TextId -> FieldNameDB
FieldNameDB TextId
"my_id")

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"user specified id, insertKey, no default=" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg 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
        let rec2 :: IdTableGeneric backend
rec2 = TextId -> Maybe IdTable -> IdTableGeneric backend
forall backend. TextId -> Maybe IdTable -> IdTableGeneric backend
IdTable TextId
"Foo2" Maybe IdTable
forall a. Maybe a
Nothing
        let rec1 :: IdTableGeneric backend
rec1 = TextId -> Maybe IdTable -> IdTableGeneric backend
forall backend. TextId -> Maybe IdTable -> IdTableGeneric backend
IdTable TextId
"Foo1" (Maybe IdTable -> IdTableGeneric backend)
-> Maybe IdTable -> IdTableGeneric backend
forall a b. (a -> b) -> a -> b
$ IdTable -> Maybe IdTable
forall a. a -> Maybe a
Just IdTable
forall backend. IdTableGeneric backend
rec2
        let rec :: IdTableGeneric backend
rec  = TextId -> Maybe IdTable -> IdTableGeneric backend
forall backend. TextId -> Maybe IdTable -> IdTableGeneric backend
IdTable TextId
"Foo" (Maybe IdTable -> IdTableGeneric backend)
-> Maybe IdTable -> IdTableGeneric backend
forall a b. (a -> b) -> a -> b
$ IdTable -> Maybe IdTable
forall a. a -> Maybe a
Just IdTable
forall backend. IdTableGeneric backend
rec1
        UTCTime
now <- IO UTCTime -> ReaderT backend m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
        let key :: Key (IdTableGeneric backend)
key = Day -> Key (IdTableGeneric backend)
forall backend. Day -> Key (IdTableGeneric backend)
IdTableKey (Day -> Key (IdTableGeneric backend))
-> Day -> Key (IdTableGeneric backend)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
now
        Key (IdTableGeneric backend)
-> IdTableGeneric backend -> ReaderT backend m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> record -> ReaderT backend m ()
insertKey Key (IdTableGeneric backend)
key IdTableGeneric backend
forall backend. IdTableGeneric backend
rec
        Just IdTableGeneric backend
rec' <- Key (IdTableGeneric backend)
-> ReaderT backend m (Maybe (IdTableGeneric backend))
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key (IdTableGeneric backend)
key
        IdTableGeneric backend
rec' IdTableGeneric backend
-> IdTableGeneric backend -> ReaderT backend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== IdTableGeneric backend
forall backend. IdTableGeneric backend
rec
        (Entity Key (IdTableGeneric backend)
key' IdTableGeneric backend
_):[Entity (IdTableGeneric backend)]
_ <- [Filter (IdTableGeneric backend)]
-> [SelectOpt (IdTableGeneric backend)]
-> ReaderT backend m [Entity (IdTableGeneric backend)]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList ([] :: [Filter (IdTableGeneric backend)]) []
        Key (IdTableGeneric backend)
key' Key (IdTableGeneric backend)
-> Key (IdTableGeneric backend) -> ReaderT backend m ()
forall a (m :: * -> *).
(HasCallStack, Eq a, Show a, MonadIO m) =>
a -> a -> m ()
@== Key (IdTableGeneric backend)
key

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"extra blocks" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        EntityDef -> Map TextId [[TextId]]
getEntityExtra (Maybe LowerCaseTable -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
entityDef (Maybe LowerCaseTable
forall a. Maybe a
Nothing :: Maybe LowerCaseTable)) Map TextId [[TextId]] -> Map TextId [[TextId]] -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?=
            [(TextId, [[TextId]])] -> Map TextId [[TextId]]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (TextId
"ExtraBlock", (TextId -> [TextId]) -> [TextId] -> [[TextId]]
forall a b. (a -> b) -> [a] -> [b]
map TextId -> [TextId]
T.words [TextId
"foo bar", TextId
"baz", TextId
"bin"])
                , (TextId
"ExtraBlock2", (TextId -> [TextId]) -> [TextId] -> [[TextId]]
forall a b. (a -> b) -> [a] -> [b]
map TextId -> [TextId]
T.words [TextId
"something"])
                ]