{-# LANGUAGE EmptyDataDecls             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE DataKinds, FlexibleInstances           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE StandaloneDeriving         #-}

module CustomConstraintTest where

import MyInit
import qualified Data.Text as T

share [mkPersist sqlSettings, mkMigrate "customConstraintMigrate"] [persistLowerCase|
CustomConstraint1
    some_field Text
    deriving Show

CustomConstraint2
    cc_id CustomConstraint1Id constraint=custom_constraint
    deriving Show

CustomConstraint3
    -- | This will lead to a constraint with the name custom_constraint3_cc_id1_fkey
    cc_id1 CustomConstraint1Id
    cc_id2 CustomConstraint1Id
    deriving Show
|]

clean :: MonadUnliftIO m => SqlPersistT m ()
clean = do
    rawExecute "drop table custom_constraint3" []
    rawExecute "drop table custom_constraint2" []
    rawExecute "drop table custom_constraint1" []

specs :: (MonadUnliftIO m, MonadFail m) => RunDb SqlBackend m -> Spec
specs runDb = do
  describe "custom constraint used in migration" $ before_ (runDb $ void $ runMigrationSilent customConstraintMigrate) $ after_ (runDb clean) $ do

    it "custom constraint is actually created" $ runDb $ do
      void $ runMigrationSilent customConstraintMigrate -- run a second time to ensure the constraint isn't dropped
      let query = T.concat ["SELECT COUNT(*) "
                           ,"FROM information_schema.key_column_usage "
                           ,"WHERE ordinal_position=1 "
                           ,"AND referenced_table_name=? "
                           ,"AND referenced_column_name=? "
                           ,"AND table_name=? "
                           ,"AND column_name=? "
                           ,"AND constraint_name=?"]
      [Single exists_] <- rawSql query
          [ PersistText "custom_constraint1"
          , PersistText "id"
          , PersistText "custom_constraint2"
          , PersistText "cc_id"
          , PersistText "custom_constraint"
          ]
      liftIO $ 1 @?= (exists_ :: Int)

    it "allows multiple constraints on a single column" $ runDb $ do
      -- Here we add another foreign key on the same column where the
      -- default one already exists. In practice, this could be
      -- a compound key with another field.
      rawExecute "ALTER TABLE custom_constraint3 ADD CONSTRAINT extra_constraint FOREIGN KEY(cc_id1) REFERENCES custom_constraint1(id)" []
      -- This is where the error is thrown in `getColumn`
      _ <- getMigration customConstraintMigrate
      pure ()
