{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module LongIdentifierTest where

import Database.Persist.TH
import Init

-- This test creates very long identifier names. The generated foreign key is over the length limit for Postgres and MySQL
-- persistent-postgresql handles this by truncating foreign key names using the same algorithm that Postgres itself does (see 'refName' in Postgresql.hs)
-- MySQL currently doesn't run this test, and needs truncation logic for it to pass.
share [mkPersist sqlSettings, mkMigrate "migration", mkDeleteCascade sqlSettings] [persistLowerCase|
TableAnExtremelyFantasticallySuperLongNameParent
    field1 Int
TableAnExtremelyFantasticallySuperLongNameChild
    columnAnExtremelyFantasticallySuperLongNameParentId TableAnExtremelyFantasticallySuperLongNameParentId
|]

specsWith :: (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
"Long identifiers" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- See 'refName' in Postgresql.hs for why these tests are necessary.
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"migrating is idempotent" (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
      [Text]
again <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
getMigration Migration
migration
      IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ [Text]
again [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= []
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"migrating really is idempotent" (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
      Migration -> ReaderT SqlBackend m ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migration
      [Text]
again <- Migration -> ReaderT SqlBackend m [Text]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Migration -> ReaderT SqlBackend m [Text]
getMigration Migration
migration
      IO () -> ReaderT SqlBackend m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend m ())
-> IO () -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ [Text]
again [Text] -> [Text] -> IO ()
forall a. (HasCallStack, Eq a, Show a) => a -> a -> IO ()
@?= []