{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module RenameTest where

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

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 :: forall backend.
(BaseBackend backend ~ backend, PersistQueryWrite backend) =>
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 ()
forall (m :: * -> *) record.
(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 ()
forall (m :: * -> *) record.
(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 ()
forall (m :: * -> *) record.
(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 :: forall backend (m :: * -> *).
(PersistStoreWrite backend, PersistQueryRead backend,
 backend ~ BaseBackend backend, MonadIO m, MonadFail m,
 Eq (BackendKey backend)) =>
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 a b. (a -> b) -> Maybe a -> Maybe b
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
forall (proxy :: * -> *). proxy LowerCaseTable -> EntityDef
entityDef (forall t. Proxy t
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 a. IO a -> ReaderT backend m a
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 ()
forall record (m :: * -> *).
(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)
forall record (m :: * -> *).
(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 [ExtraLine]
getEntityExtra (Maybe LowerCaseTable -> EntityDef
forall record (proxy :: * -> *).
PersistEntity record =>
proxy record -> EntityDef
forall (proxy :: * -> *). proxy LowerCaseTable -> EntityDef
entityDef (Maybe LowerCaseTable
forall a. Maybe a
Nothing :: Maybe LowerCaseTable))
            Map TextId [ExtraLine] -> Map TextId [ExtraLine] -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= [(TextId, [ExtraLine])] -> Map TextId [ExtraLine]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                [ (TextId
"ExtraBlock", (TextId -> ExtraLine) -> ExtraLine -> [ExtraLine]
forall a b. (a -> b) -> [a] -> [b]
map TextId -> ExtraLine
T.words [TextId
"foo bar", TextId
"baz", TextId
"bin"])
                , (TextId
"ExtraBlock2", (TextId -> ExtraLine) -> ExtraLine -> [ExtraLine]
forall a b. (a -> b) -> [a] -> [b]
map TextId -> ExtraLine
T.words [TextId
"something"])
                ]