Implement config for customising the FK name

persistent/ChangeLog.md

@@ -2,6 +2,8 @@
 
 ## 2.13.0.0 (unreleased)
 
+* [#1244](https://github.com/yesodweb/persistent/pull/1244)
+    * Implement config for customising the FK name
 * [#1252](https://github.com/yesodweb/persistent/pull/1252)
     * `mkMigrate` now defers to `mkEntityDefList` and `migrateModels` instead of
       fixing the foreign key references itself.

persistent/Database/Persist/Quasi.hs

@@ -423,6 +423,7 @@ module Database.Persist.Quasi
     ) where
 
 import Data.Text (Text)
+import Database.Persist.Names
 import Database.Persist.Quasi.Internal
 
 -- | Retrieve the function in the 'PersistSettings' that modifies the names into
@@ -439,6 +440,21 @@ getPsToDBName = psToDBName
 setPsToDBName :: (Text -> Text) -> PersistSettings -> PersistSettings
 setPsToDBName f ps = ps { psToDBName = f }
 
+-- | Set a custom function used to create the constraint name
+-- for a foreign key.
+--
+-- @since 2.13.0.0
+setPsToFKName :: (EntityNameHS -> ConstraintNameHS -> Text) -> PersistSettings -> PersistSettings
+setPsToFKName setter ps = ps { psToFKName = setter }
+
+-- | A preset configuration function that puts an underscore
+-- between the entity name and the constraint name when
+-- creating a foreign key constraint name
+--
+-- @since 2.13.0.0
+setPsUseSnakeCaseForiegnKeys :: PersistSettings -> PersistSettings
+setPsUseSnakeCaseForiegnKeys = setPsToFKName (toFKNameInfixed "_")
+
 -- | Retrieve whether or not the 'PersistSettings' will generate code with
 -- strict fields.
 --