diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs
index 34229e070..8b27b1cf5 100644
--- a/persistent-mysql/Database/Persist/MySQL.hs
+++ b/persistent-mysql/Database/Persist/MySQL.hs
@@ -500,7 +500,7 @@ findTypeOfColumn allDefs name col =
         ((,) col)
         $ do
             entDef   <- find ((== name) . getEntityDBName) allDefs
-            fieldDef <- find ((== col)  . fieldDB) (getEntityFields entDef)
+            fieldDef <- find ((== col)  . fieldDB) (getEntityFieldsDatabase entDef)
             return (fieldType fieldDef)
 
 -- | Find out the maxlen of a column (default to 200)
@@ -509,7 +509,7 @@ findMaxLenOfColumn allDefs name col =
    maybe (col, 200)
          ((,) col) $ do
            entDef     <- find ((== name) . getEntityDBName) allDefs
-           fieldDef   <- find ((== col) . fieldDB) (getEntityFields entDef)
+           fieldDef   <- find ((== col) . fieldDB) (getEntityFieldsDatabase entDef)
            findMaxLenOfField fieldDef
 
 -- | Find out the maxlen of a field
@@ -1484,7 +1484,7 @@ mkBulkInsertQuery records fieldValues updates =
     firstField = case entityFieldNames of
         [] -> error "The entity you're trying to insert does not have any fields."
         (field:_) -> field
-    entityFieldNames = map fieldDbToText (getEntityFields entityDef')
+    entityFieldNames = map fieldDbToText (getEntityFieldsDatabase entityDef')
     tableName = T.pack . escapeE . getEntityDBName $ entityDef'
     copyUnlessValues = map snd fieldsToMaybeCopy
     recordValues = concatMap (map toPersistValue . toPersistFields) records
@@ -1521,7 +1521,7 @@ mkBulkInsertQuery records fieldValues updates =
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' fields ent n
   where
-    fields = getEntityFields ent
+    fields = getEntityFieldsDatabase ent
 
 repsertManySql :: EntityDef -> Int -> Text
 repsertManySql ent n = putManySql' fields ent n
diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs
index 26ab9dc66..a0551dafb 100644
--- a/persistent-mysql/test/main.hs
+++ b/persistent-mysql/test/main.hs
@@ -1,24 +1,28 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE DataKinds, FlexibleInstances #-}
-{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
 
 import MyInit
 
-import Data.Time (Day, UTCTime (..), TimeOfDay, timeToTimeOfDay, timeOfDayToTime)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
+import qualified Data.ByteString as BS
 import Data.Fixed
-import Test.QuickCheck
-import qualified Data.Text as T
 import Data.IntMap (IntMap)
-import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import Data.Time (Day, TimeOfDay, UTCTime(..), timeOfDayToTime, timeToTimeOfDay)
+import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
+import Database.Persist.Sql
+import Test.QuickCheck
 
 import qualified CompositeTest
 import qualified CustomPersistFieldTest
@@ -35,26 +39,26 @@ import qualified MaxLenTest
 import qualified MigrationColumnLengthTest
 import qualified MigrationIdempotencyTest
 import qualified MigrationOnlyTest
-import qualified MpsNoPrefixTest
 import qualified MpsCustomPrefixTest
-import qualified PersistentTest
+import qualified MpsNoPrefixTest
 import qualified PersistUniqueTest
+import qualified PersistentTest
 -- FIXME: Not used... should it be?
 -- import qualified PrimaryTest
 import qualified RawSqlTest
 import qualified ReadWriteTest
 import qualified Recursive
 -- TODO: can't use this as MySQL can't do DEFAULT CURRENT_DATE
+import qualified CustomConstraintTest
+import qualified ForeignKey
+import qualified GeneratedColumnTestSQL
+import qualified ImplicitUuidSpec
+import qualified LongIdentifierTest
 import qualified RenameTest
 import qualified SumTypeTest
 import qualified TransactionLevelTest
 import qualified UniqueTest
 import qualified UpsertTest
-import qualified CustomConstraintTest
-import qualified LongIdentifierTest
-import qualified GeneratedColumnTestSQL
-import qualified ForeignKey
-import qualified ImplicitUuidSpec
 
 type Tuple a b = (a, b)
 
@@ -171,9 +175,11 @@ main = do
         Recursive.specsWith db
         SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
         MigrationOnlyTest.specsWith db
-            (Just
-                $ runMigrationSilent MigrationOnlyTest.migrateAll1
-                >> runMigrationSilent MigrationOnlyTest.migrateAll2
+            (Just $ do
+                void $ rawExecute "DROP TABLE IF EXISTS referencing;" []
+                void $ rawExecute "DROP TABLE IF EXISTS two_field;" []
+                void $ runMigrationSilent MigrationOnlyTest.migrateAll1
+                void $ runMigrationSilent MigrationOnlyTest.migrateAll2
             )
         PersistentTest.specsWith db
         PersistentTest.filterOrSpecs db
diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs
index e783a1234..6e980ad8f 100644
--- a/persistent-postgresql/Database/Persist/Postgresql.hs
+++ b/persistent-postgresql/Database/Persist/Postgresql.hs
@@ -398,7 +398,7 @@ insertSql' ent vals =
     sql = T.concat
         [ "INSERT INTO "
         , escapeE $ getEntityDBName ent
-        , if null (getEntityFields ent)
+        , if null (getEntityFieldsDatabase ent)
             then " DEFAULT VALUES"
             else T.concat
                 [ "("
@@ -1738,7 +1738,7 @@ mockMigration mig = do
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns fields ent n
   where
-    fields = getEntityFields ent
+    fields = getEntityFieldsDatabase ent
     conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (getEntityUniques ent)
 
 repsertManySql :: EntityDef -> Int -> Text
@@ -1928,7 +1928,7 @@ mkBulkUpsertQuery records conn fieldValues updates filters uniqDef =
     firstField = case entityFieldNames of
         [] -> error "The entity you're trying to insert does not have any fields."
         (field:_) -> field
-    entityFieldNames = map fieldDbToText (getEntityFields entityDef')
+    entityFieldNames = map fieldDbToText (getEntityFieldsDatabase entityDef')
     nameOfTable = escapeE . getEntityDBName $ entityDef'
     copyUnlessValues = map snd fieldsToMaybeCopy
     recordValues = concatMap (map toPersistValue . toPersistFields) records
diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs
index 0faf89ac0..dec295ad7 100644
--- a/persistent-postgresql/test/PgInit.hs
+++ b/persistent-postgresql/test/PgInit.hs
@@ -107,8 +107,6 @@ import qualified Data.Text.Encoding as TE
 import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=))
 import Test.QuickCheck
 
-import Web.PathPieces
-import Web.Internal.HttpApiData
 import Control.Monad (unless, (>=>))
 import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger
diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs
index 0e4d58867..65743cf03 100644
--- a/persistent-sqlite/Database/Persist/Sqlite.hs
+++ b/persistent-sqlite/Database/Persist/Sqlite.hs
@@ -375,7 +375,7 @@ insertSql' ent vals =
     notGenerated =
         isNothing . fieldGenerated
     cols =
-        filter notGenerated $ getEntityFields ent
+        filter notGenerated $ getEntityFieldsDatabase ent
 
 execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64
 execute' conn stmt vals = flip finally (liftIO $ Sqlite.reset conn stmt) $ do
@@ -497,7 +497,7 @@ safeToRemove :: EntityDef -> FieldNameDB -> Bool
 safeToRemove def (FieldNameDB colName)
     = any (elem FieldAttrSafeToRemove . fieldAttrs)
     $ filter ((== FieldNameDB colName) . fieldDB)
-    $ getEntityFields def
+    $ getEntityFieldsDatabase def
 
 getCopyTable :: [EntityDef]
              -> (Text -> IO Statement)
@@ -674,7 +674,7 @@ escape s =
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns fields ent n
   where
-    fields = getEntityFields ent
+    fields = getEntityFieldsDatabase ent
     conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (getEntityUniques ent)
 
 repsertManySql :: EntityDef -> Int -> Text
diff --git a/persistent-test/src/MigrationOnlyTest.hs b/persistent-test/src/MigrationOnlyTest.hs
index 2240b9045..e40dd9899 100644
--- a/persistent-test/src/MigrationOnlyTest.hs
+++ b/persistent-test/src/MigrationOnlyTest.hs
@@ -1,11 +1,14 @@
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeApplications, UndecidableInstances #-}
+
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
 module MigrationOnlyTest (specsWith, migrateAll1, migrateAll2) where
 
 import qualified Data.Text as T
 
 import Database.Persist.TH
 import Init
+import Database.Persist.EntityDef
 
 share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "migrateAll1"] [persistLowerCase|
 TwoField1 sql=two_field
@@ -33,6 +36,26 @@ specsWith
     -> Maybe (ReaderT backend m a)
     -> Spec
 specsWith runDb mmigrate = describe "MigrationOnly field" $ do
+    let
+        edef =
+            entityDef $ Proxy @TwoField
+    describe "getEntityFields" $ do
+        let
+            fields =
+                getEntityFields edef
+        it "should have two fields" $ do
+            length fields `shouldBe` 2
+        it "should not have any migration only fields" $ do
+            fields `shouldSatisfy` all isHaskellField
+
+    describe "getEntityFieldsDatabase" $ do
+        let
+            fields =
+                getEntityFieldsDatabase edef
+        it "should have three fields" $ do
+            length fields `shouldBe` 3
+        it "should have at one migration only field" $ do
+            length (filter (not . isHaskellField) fields) `shouldBe` 1
     it "doesn't have the field in the Haskell entity" $ asIO $ runDb $ do
         sequence_ mmigrate
         sequence_ mmigrate
diff --git a/persistent-test/src/PersistentTestModels.hs b/persistent-test/src/PersistentTestModels.hs
index 80d698f3a..5378e2fbc 100644
--- a/persistent-test/src/PersistentTestModels.hs
+++ b/persistent-test/src/PersistentTestModels.hs
@@ -18,7 +18,7 @@ import Data.Text (append)
 -- just need to ensure this compiles
 import PersistentTestModelsImports()
 
-share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate", mkDeleteCascade persistSettings, mkSave "_ignoredSave"] [persistUpperCase|
+share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate", mkDeleteCascade persistSettings] [persistUpperCase|
 
 -- Dedented comment
   -- Header-level comment
diff --git a/persistent-test/src/Recursive.hs b/persistent-test/src/Recursive.hs
index 3173b4c37..1991692b4 100644
--- a/persistent-test/src/Recursive.hs
+++ b/persistent-test/src/Recursive.hs
@@ -1,16 +1,21 @@
 {-# LANGUAGE UndecidableInstances #-}
+
 {-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
 module Recursive (specsWith, recursiveMigrate, cleanup) where
 
 import Init
 
 share [mkPersist sqlSettings { mpsGeneric = True }, mkMigrate "recursiveMigrate"] [persistLowerCase|
+
 SubType
   object [MenuObject]
   deriving Show Eq
+
 MenuObject
   sub SubType Maybe
   deriving Show Eq
+
 |]
 
 cleanup
diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md
index 520bcdec7..d9fe2e4fd 100644
--- a/persistent/ChangeLog.md
+++ b/persistent/ChangeLog.md
@@ -2,6 +2,15 @@
 
 ## 2.13.0.0 (unreleased)
 
+* [#1252](https://github.com/yesodweb/persistent/pull/1252)
+    * `mkMigrate` now defers to `mkEntityDefList` and `migrateModels` instead of
+      fixing the foreign key references itself.
+    * `mkSave` was deprecated - the function did not fix foreign key references.
+      Please use `mkEntityDefList` instead.
+    * `EntityDef` will now include fields marked `MigrationOnly` and
+      `SafeToRemove`. Beforehand, those were filtered out, and `mkMigrate`
+      applied. The function `getEntityFields` wll only return fields defined on
+      the Haskell type - for all columns, see `getEntityFieldsDatabase`.
 * [#1225](https://github.com/yesodweb/persistent/pull/1225)
     * The fields and constructor for `SqlBackend` are no longer exported by
       default. They are available from an internal module,
diff --git a/persistent/Database/Persist/EntityDef.hs b/persistent/Database/Persist/EntityDef.hs
index 1d80d9592..68b5c72eb 100644
--- a/persistent/Database/Persist/EntityDef.hs
+++ b/persistent/Database/Persist/EntityDef.hs
@@ -10,6 +10,7 @@ module Database.Persist.EntityDef
     , getEntityHaskellName
     , getEntityDBName
     , getEntityFields
+    , getEntityFieldsDatabase
     , getEntityForeignDefs
     , getEntityUniques
     , getEntityId
@@ -30,6 +31,7 @@ import Data.Text (Text)
 import Data.Map (Map)
 
 import Database.Persist.EntityDef.Internal
+import Database.Persist.FieldDef (isHaskellField)
 
 import Database.Persist.Types.Base
     ( UniqueDef
@@ -92,11 +94,29 @@ getEntityForeignDefs = entityForeigns
 -- will return the key columns if you used the @Primary@ syntax for defining the
 -- primary key.
 --
+-- This does not return fields that are marked 'SafeToRemove' or 'MigrationOnly'
+-- - so it only returns fields that are represented in the Haskell type. If you
+-- need those fields, use 'getEntityFieldsDatabase'.
+--
 -- @since 2.13.0.0
 getEntityFields
     :: EntityDef
     -> [FieldDef]
-getEntityFields = entityFields
+getEntityFields = filter isHaskellField . entityFields
+
+-- | This returns all of the 'FieldDef' defined for the 'EntityDef', including
+-- those fields that are marked as 'MigrationOnly' (and therefore only present
+-- in the database) or 'SafeToRemove' (and a migration will drop the column if
+-- it exists in the database).
+--
+-- For all the fields that are present on the Haskell-type, see
+-- 'getEntityFields'.
+--
+-- @since 2.13.0.0
+getEntityFieldsDatabase
+    :: EntityDef
+    -> [FieldDef]
+getEntityFieldsDatabase = entityFields
 
 -- |
 --
@@ -125,12 +145,19 @@ getEntityKeyFields
     -> [FieldDef]
 getEntityKeyFields = entityKeyFields
 
+-- | TODO
+--
+-- @since 2.13.0.0
 setEntityFields :: [FieldDef] -> EntityDef -> EntityDef
 setEntityFields fd ed = ed { entityFields = fd }
 
+-- | Perform a mapping function over all of the entity fields, as determined by
+-- 'getEntityFieldsDatabase'.
+--
+-- @since 2.13.0.0
 overEntityFields
     :: ([FieldDef] -> [FieldDef])
     -> EntityDef
     -> EntityDef
 overEntityFields f ed =
-    setEntityFields (f (getEntityFields ed)) ed
+    setEntityFields (f (getEntityFieldsDatabase ed)) ed
diff --git a/persistent/Database/Persist/FieldDef.hs b/persistent/Database/Persist/FieldDef.hs
index d06d4ef0d..183883900 100644
--- a/persistent/Database/Persist/FieldDef.hs
+++ b/persistent/Database/Persist/FieldDef.hs
@@ -6,6 +6,7 @@ module Database.Persist.FieldDef
       FieldDef
       -- ** Helpers
     , isFieldNotGenerated
+    , isHaskellField
       -- * 'FieldCascade'
     , FieldCascade(..)
     , renderFieldCascade
@@ -15,3 +16,8 @@ module Database.Persist.FieldDef
     ) where
 
 import Database.Persist.FieldDef.Internal
+
+import Database.Persist.Types.Base
+    ( isHaskellField
+    )
+
diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index 27ab77d45..b066585ae 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -407,12 +407,6 @@ overUnboundEntityDef
 overUnboundEntityDef f ubed =
     ubed { unboundEntityDef = f (unboundEntityDef ubed) }
 
-lookupKeyVal :: Text -> [Text] -> Maybe Text
-lookupKeyVal key = lookupPrefix $ key `mappend` "="
-
-lookupPrefix :: Text -> [Text] -> Maybe Text
-lookupPrefix prefix = msum . map (T.stripPrefix prefix)
-
 -- | Construct an entity definition.
 mkEntityDef
     :: PersistSettings
@@ -465,10 +459,28 @@ mkEntityDef ps name entattribs lines =
             _ ->
                 case (setFieldComments comments <$> takeColsEx ps (tokenText <$> x)) of
                   Just sm ->
-                      (sm : acc, [])
+                      (maybeSetSelfReference sm : acc, [])
                   Nothing ->
                       (acc, [])
 
+    maybeSetSelfReference field = go (fieldType field)
+      where
+        go ft =
+            case ft of
+                FTTypeCon Nothing x
+                    | x == name ->
+                        field
+                            { fieldReference =
+                                SelfReference
+                            }
+                    | otherwise ->
+                        field
+                FTTypeCon _ _ ->
+                    field
+                FTList ft' ->
+                    go ft'
+                _ ->
+                    field
     autoIdField = mkAutoIdField ps entName idSqlType
     idSqlType = maybe SqlInt64 (const $ SqlOther "Primary Key") primaryComposite
 
diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs
index 15b6222ac..f3b6598c5 100644
--- a/persistent/Database/Persist/Sql/Internal.hs
+++ b/persistent/Database/Persist/Sql/Internal.hs
@@ -85,7 +85,7 @@ mkColumns allDefs t overrides =
     (cols, getEntityUniques t, getEntityForeignDefs t)
   where
     cols :: [Column]
-    cols = map goId idCol `mappend` map go (getEntityFields t)
+    cols = map goId idCol `mappend` map go (getEntityFieldsDatabase t)
 
     idCol :: [FieldDef]
     idCol = case entityPrimary t of
diff --git a/persistent/Database/Persist/Sql/Types/Internal.hs b/persistent/Database/Persist/Sql/Types/Internal.hs
index 831071e7d..da3983be7 100644
--- a/persistent/Database/Persist/Sql/Types/Internal.hs
+++ b/persistent/Database/Persist/Sql/Types/Internal.hs
@@ -42,7 +42,6 @@ import Database.Persist.Class
     , BackendCompatible(..)
     )
 import Database.Persist.Class.PersistStore (IsPersistBackend (..))
-import Database.Persist.Types
 import Database.Persist.SqlBackend.Internal
 import Database.Persist.SqlBackend.Internal.InsertSqlResult
 import Database.Persist.SqlBackend.Internal.MkSqlBackend
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index bfe409703..3421b62df 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -235,11 +234,12 @@ embedEntityDefsMap rawEnts = (embedEntityMap, noCycleEnts)
         let entName = getEntityHaskellName entDef
          in overEntityFields (map (breakCycleField entName)) entDef
 
-    breakCycleField entName f = case f of
-        FieldDef { fieldReference = EmbedRef em } ->
-            f { fieldReference = EmbedRef $ breakCycleEmbed [entName] em }
-        _ ->
-            f
+    breakCycleField entName f =
+        case fieldReference f of
+            EmbedRef em ->
+                f { fieldReference = EmbedRef $ breakCycleEmbed [entName] em }
+            _ ->
+                f
 
     breakCycleEmbed ancestors em =
         em { embeddedFields = breakCycleEmField (emName : ancestors) <$> embeddedFields em
@@ -249,8 +249,10 @@ embedEntityDefsMap rawEnts = (embedEntityMap, noCycleEnts)
 
     breakCycleEmField ancestors emf = case embeddedHaskell <$> membed of
         Nothing -> emf
-        Just embName -> if embName `elem` ancestors
-            then emf { emFieldEmbed = Nothing, emFieldCycle = Just embName }
+        Just embName ->
+            if embName `elem` ancestors
+            then
+                emf { emFieldEmbed = Nothing, emFieldCycle = Just embName }
             else emf { emFieldEmbed = breakCycleEmbed ancestors <$> membed }
         where
             membed = emFieldEmbed emf
@@ -321,7 +323,8 @@ instance Lift FieldSqlTypeExp where
 
 instance Lift EntityDefSqlTypeExp where
     lift (EntityDefSqlTypeExp ent sqlTypeExp sqlTypeExps) =
-        [|ent { entityFields = $(lift $ FieldsSqlTypeExp (getEntityFields ent) sqlTypeExps)
+        [|ent { entityFields =
+                    $(lift $ FieldsSqlTypeExp (getEntityFieldsDatabase ent) sqlTypeExps)
               , entityId = $(lift $ FieldSqlTypeExp (entityId ent) sqlTypeExp)
               }
         |]
@@ -333,7 +336,12 @@ type EmbedEntityMap = M.Map EntityNameHS EmbedEntityDef
 
 constructEmbedEntityMap :: [EntityDef] -> EmbedEntityMap
 constructEmbedEntityMap =
-    M.fromList . fmap (\ent -> (entityHaskell ent, toEmbedEntityDef ent))
+    M.fromList . fmap
+        (\ent ->
+                ( entityHaskell ent
+                , toEmbedEntityDef ent
+                )
+        )
 
 type EntityMap = M.Map EntityNameHS EntityDef
 
@@ -369,8 +377,10 @@ mEmbedded ents (FTApp x y) =
     -- special casing this is obviously a hack
     -- This problem may not be solvable with the current QuasiQuoted approach though
     if x == FTTypeCon Nothing "Key"
-        then Left $ Just FTKeyCon
-        else mEmbedded ents y
+        then
+            Left $ Just FTKeyCon
+        else
+            mEmbedded ents y
 
 setEmbedField :: EntityNameHS -> EmbedEntityMap -> FieldDef -> FieldDef
 setEmbedField entName allEntities field = field
@@ -396,7 +406,8 @@ setEmbedField entName allEntities field = field
                              then EmbedRef em
                         else if maybeNullable field
                              then SelfReference
-                        else case fieldType field of
+                        else
+                            case fieldType field of
                                  FTList _ -> SelfReference
                                  _ -> error $ unpack $ unEntityNameHS entName <> ": a self reference must be a Maybe"
             existing ->
@@ -405,13 +416,17 @@ setEmbedField entName allEntities field = field
 
 mkEntityDefSqlTypeExp :: EmbedEntityMap -> EntityMap -> EntityDef -> EntityDefSqlTypeExp
 mkEntityDefSqlTypeExp emEntities entityMap ent =
-    EntityDefSqlTypeExp ent (getSqlType $ entityId ent) (map getSqlType $ getEntityFields ent)
+    EntityDefSqlTypeExp ent (getSqlType $ entityId ent) (map getSqlType $ getEntityFieldsDatabase ent)
   where
     getSqlType field =
         maybe
             (defaultSqlTypeExp field)
             (SqlType' . SqlOther)
-            (listToMaybe $ mapMaybe (\case {FieldAttrSqltype x -> Just x; _ -> Nothing}) $ fieldAttrs field)
+            (listToMaybe $ mapMaybe attrSqlType $ fieldAttrs field)
+
+    attrSqlType = \case
+        FieldAttrSqltype x -> Just x
+        _ -> Nothing
 
     -- In the case of embedding, there won't be any datatype created yet.
     -- We just use SqlString, as the data will be serialized to JSON.
@@ -425,7 +440,8 @@ mkEntityDefSqlTypeExp emEntities entityMap ent =
                 case fieldReference field of
                     ForeignRef refName ft ->
                         case M.lookup refName entityMap of
-                            Nothing  -> SqlTypeExp ft
+                            Nothing  ->
+                                SqlTypeExp ft
                             -- A ForeignRef is blindly set to an Int64 in setEmbedField
                             -- correct that now
                             Just ent' ->
@@ -475,7 +491,7 @@ mkPersist mps ents' = do
         , symbolToFieldInstances
         ]
   where
-    ents = map (fixEntityDef . setDefaultIdFields mps) ents'
+    ents = embedEntityDefs $ map (setDefaultIdFields mps) ents'
     entityMap = constructEntityMap ents
 
 setDefaultIdFields :: MkPersistSettings -> EntityDef -> EntityDef
@@ -506,12 +522,14 @@ setDefaultIdFields mps ed
 
 -- | Implement special preprocessing on EntityDef as necessary for 'mkPersist'.
 -- For example, strip out any fields marked as MigrationOnly.
+--
+-- This should be called when performing Haskell codegen, but the 'EntityDef'
+-- *should* keep all of the fields present when defining 'entityDef'. This is
+-- necessary so that migrations know to keep these columns around, or to delete
+-- them, as appropriate.
 fixEntityDef :: EntityDef -> EntityDef
 fixEntityDef =
-    overEntityFields (filter keepField)
-  where
-    keepField fd = FieldAttrMigrationOnly `notElem` fieldAttrs fd &&
-                   FieldAttrSafeToRemove `notElem` fieldAttrs fd
+    overEntityFields (filter isHaskellField)
 
 -- | Settings to be passed to the 'mkPersist' function.
 data MkPersistSettings = MkPersistSettings
@@ -589,7 +607,6 @@ data MkPersistSettings = MkPersistSettings
     -- @since 2.13.0.0
     }
 
-
 {-# DEPRECATED mpsGeneric "The mpsGeneric function adds a considerable amount of overhead and complexity to the library without bringing significant benefit. We would like to remove it. If you require this feature, please comment on the linked GitHub issue, and we'll either keep it around, or we can figure out a nicer way to solve your problem.\n\n Github: https://github.com/yesodweb/persistent/issues/1204" #-}
 
 -- |  Set the 'ImplicitIdDef' in the given 'MkPersistSettings'. The default
@@ -1185,19 +1202,21 @@ fieldError tableName fieldName err = mconcat
     ]
 
 mkEntity :: EntityMap -> MkPersistSettings -> EntityDef -> Q [Dec]
-mkEntity entityMap mps entDef = do
-    entityDefExp <-
-        if mpsGeneric mps
-           then liftAndFixKeys entityMap entDef
-           else makePersistEntityDefExp mps entityMap entDef
-    let name = mkEntityDefName entDef
-    let clazz = ConT ''PersistEntity `AppT` genDataType
+mkEntity entityMap mps preEntDef = do
+    entityDefExp <- liftAndFixKeys entityMap preEntDef
+    let
+        entDef = fixEntityDef preEntDef
+        genDataType = genericDataType mps entName backendT
+        entName = entityHaskell entDef
+        name = mkEntityDefName entDef
+        clazz = ConT ''PersistEntity `AppT` genDataType
+
     tpf <- mkToPersistFields mps entDef
     fpv <- mkFromPersistValues mps entDef
     utv <- mkUniqueToValues $ entityUniques entDef
     puk <- mkUniqueKeys entDef
     let primaryField = entityId entDef
-    fields <- mapM (mkField mps entDef) $ primaryField : getEntityFields entDef
+    fields <- mapM (mkField mps entDef) $ primaryField : getEntityFieldsDatabase entDef
     fkc <- mapM (mkForeignKeysComposite mps entDef) $ entityForeigns entDef
 
     toFieldNames <- mkToFieldNames $ entityUniques entDef
@@ -1294,9 +1313,6 @@ mkEntity entityMap mps entDef = do
         , FunD 'fieldLens lensClauses
         ]
       ] `mappend` lenses) `mappend` keyInstanceDecs
-  where
-    genDataType = genericDataType mps entName backendT
-    entName = entityHaskell entDef
 
 mkUniqueKeyInstances :: MkPersistSettings -> EntityDef -> Q [Dec]
 mkUniqueKeyInstances mps entDef = do
@@ -1513,6 +1529,9 @@ share :: [[EntityDef] -> Q [Dec]] -> [EntityDef] -> Q [Dec]
 share fs x = mconcat <$> mapM ($ x) fs
 
 -- | Save the @EntityDef@s passed in under the given name.
+--
+-- This function was deprecated in @persistent-2.13.0.0@. It doesn't properly
+-- fix foreign keys. Please refer to 'mkEntityDefList' for a replacement.
 mkSave :: String -> [EntityDef] -> Q [Dec]
 mkSave name' defs' = do
     let name = mkName name'
@@ -1521,6 +1540,8 @@ mkSave name' defs' = do
            , FunD name [normalClause [] defs]
            ]
 
+{-# DEPRECATED mkSave "This function is broken. mkEntityDefList is a drop-in replacement that will properly handle foreign keys correctly." #-}
+
 data Dep = Dep
     { depTarget :: EntityNameHS
     , depSourceTable :: EntityNameHS
@@ -1743,67 +1764,56 @@ derivePersistFieldJSON s = do
 -- migrateAll = 'migrateModels' entities
 -- @
 --
+-- The function 'mkMigrate' currently implements exactly this behavior now. If
+-- you're splitting up the entity definitions into separate files, then it is
+-- better to use the entity definition list and the concatenate all the models
+-- together into a big list to call with 'migrateModels'.
+--
+-- @
+-- module Foo where
+--
+--     share [mkPersist s, mkEntityDefList "fooModels"] ...
+--
+--
+-- module Bar where
+--
+--     share [mkPersist s, mkEntityDefList "barModels"] ...
+--
+-- module Migration where
+--
+--     import Foo
+--     import Bar
+--
+--     migrateAll = migrateModels (fooModels <> barModels)
+-- @
+--
 -- @since 2.13.0.0
 migrateModels :: [EntityDef] -> Migration
-migrateModels eds =
-    forM_ eds $ \ed ->
-        migrate eds ed
+migrateModels defs=
+    forM_ (filter isMigrated defs) $ \def ->
+        migrate defs def
+  where
+    isMigrated def = pack "no-migrate" `notElem` entityAttrs def
 
 -- | Creates a single function to perform all migrations for the entities
 -- defined here. One thing to be aware of is dependencies: if you have entities
 -- with foreign references, make sure to place those definitions after the
 -- entities they reference.
+--
+-- In @persistent-2.13.0.0@, this was changed to *ignore* the input entity def
+-- list, and instead defer to 'mkEntityDefList' to get the correct entities.
+-- This avoids problems where the QuasiQuoter is unable to know what the right
+-- reference types are. This sets 'mkPersist' to be the "single source of truth"
+-- for entity definitions.
 mkMigrate :: String -> [EntityDef] -> Q [Dec]
-mkMigrate fun allDefs = do
-    body' <- body
-    return
-        [ SigD (mkName fun) typ
-        , FunD (mkName fun) [normalClause [] body']
+mkMigrate fun eds = do
+    let entityDefListName = ("entityDefListFor" <> fun)
+    body <- [| migrateModels $(varE (mkName entityDefListName)) |]
+    edList <- mkEntityDefList entityDefListName eds
+    pure $ edList <>
+        [ SigD (mkName fun) (ConT ''Migration)
+        , FunD (mkName fun) [normalClause [] body]
         ]
-  where
-    defs = filter isMigrated allDefs
-    isMigrated def = "no-migrate" `notElem` entityAttrs def
-    typ = ConT ''Migration
-    entityMap = constructEntityMap allDefs
-    body :: Q Exp
-    body =
-        case defs of
-            [] -> [|return ()|]
-            _  -> do
-              defsName <- newName "defs"
-              defsStmt <- do
-                defs' <- mapM (liftAndFixKeys entityMap) defs
-                let defsExp = ListE defs'
-                return $ LetS [ValD (VarP defsName) (NormalB defsExp) []]
-              stmts <- mapM (toStmt $ VarE defsName) defs
-              return (DoE $ defsStmt : stmts)
-    toStmt :: Exp -> EntityDef -> Q Stmt
-    toStmt defsExp ed = do
-        u <- liftAndFixKeys entityMap ed
-        m <- [|migrate|]
-        return $ NoBindS $ m `AppE` defsExp `AppE` u
-
-makePersistEntityDefExp :: MkPersistSettings -> EntityMap -> EntityDef -> Q Exp
-makePersistEntityDefExp mps entityMap entDef@EntityDef{..} =
-    [|EntityDef
-        entityHaskell
-        entityDB
-        $(liftAndFixKey entityMap entityId)
-        entityAttrs
-        $(fieldDefReferences mps entDef entityFields)
-        entityUniques
-        entityForeigns
-        entityDerives
-        entityExtra
-        entitySum
-        entityComments
-    |]
-
-fieldDefReferences :: MkPersistSettings -> EntityDef -> [FieldDef] -> Q Exp
-fieldDefReferences mps entDef fieldDefs =
-  fmap ListE $ forM fieldDefs $ \fieldDef -> do
-    let fieldDefConE = ConE (filterConName mps entDef fieldDef)
-    pure $ VarE 'persistFieldDef `AppE` fieldDefConE
 
 liftAndFixKeys :: EntityMap -> EntityDef -> Q Exp
 liftAndFixKeys entityMap EntityDef{..} =
@@ -1968,7 +1978,7 @@ requirePersistentExtensions = requireExtensions requiredExtensions
 
 mkSymbolToFieldInstances :: MkPersistSettings -> EntityDef -> Q [Dec]
 mkSymbolToFieldInstances mps ed = do
-    fmap join $ forM (keyAndEntityFields ed) $ \fieldDef -> do
+    fmap join $ forM (keyAndEntityFields (fixEntityDef ed)) $ \fieldDef -> do
         let fieldNameT :: Q Type
             fieldNameT =
                 litT $ strTyLit
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index 5650e49de..cd853bca5 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -280,15 +280,15 @@ data ReferenceDef = NoReference
 -- But it is only used for fieldReference
 -- so it only has data needed for embedding
 data EmbedEntityDef = EmbedEntityDef
-    { embeddedHaskell :: !EntityNameHS
-    , embeddedFields  :: ![EmbedFieldDef]
+    { embeddedHaskell :: EntityNameHS
+    , embeddedFields  :: [EmbedFieldDef]
     } deriving (Show, Eq, Read, Ord, Lift)
 
 -- | An EmbedFieldDef is the same as a FieldDef
 -- But it is only used for embeddedFields
 -- so it only has data needed for embedding
 data EmbedFieldDef = EmbedFieldDef
-    { emFieldDB    :: !FieldNameDB
+    { emFieldDB    :: FieldNameDB
     , emFieldEmbed :: Maybe EmbedEntityDef
     , emFieldCycle :: Maybe EntityNameHS
     -- ^ 'emFieldEmbed' can create a cycle (issue #311)
@@ -297,24 +297,40 @@ data EmbedFieldDef = EmbedFieldDef
     }
     deriving (Show, Eq, Read, Ord, Lift)
 
+-- | Returns 'True' if the 'FieldDef' does not have a 'MigrationOnly' or
+-- 'SafeToRemove' flag from the QuasiQuoter.
+--
+-- @since 2.13.0.0
+isHaskellField :: FieldDef -> Bool
+isHaskellField fd =
+    FieldAttrMigrationOnly `notElem` fieldAttrs fd &&
+    FieldAttrSafeToRemove `notElem` fieldAttrs fd
+
 toEmbedEntityDef :: EntityDef -> EmbedEntityDef
 toEmbedEntityDef ent = embDef
   where
     embDef = EmbedEntityDef
-      { embeddedHaskell = entityHaskell ent
-      , embeddedFields = map toEmbedFieldDef $ entityFields ent
-      }
+        { embeddedHaskell = entityHaskell ent
+        , embeddedFields =
+            map toEmbedFieldDef
+            $ filter isHaskellField
+            $ entityFields ent
+        }
     toEmbedFieldDef :: FieldDef -> EmbedFieldDef
     toEmbedFieldDef field =
-      EmbedFieldDef { emFieldDB       = fieldDB field
-                    , emFieldEmbed = case fieldReference field of
-                        EmbedRef em -> Just em
-                        SelfReference -> Just embDef
-                        _ -> Nothing
-                    , emFieldCycle = case fieldReference field of
-                        SelfReference -> Just $ entityHaskell ent
-                        _ -> Nothing
-                    }
+        EmbedFieldDef
+            { emFieldDB =
+                fieldDB field
+            , emFieldEmbed =
+                case fieldReference field of
+                    EmbedRef em -> Just em
+                    SelfReference -> Just embDef
+                    _ -> Nothing
+            , emFieldCycle =
+                case fieldReference field of
+                    SelfReference -> Just $ entityHaskell ent
+                    _ -> Nothing
+            }
 
 -- | Type for storing the Uniqueness constraint in the Schema.  Assume you have
 -- the following schema with a uniqueness constraint:
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 01086c08f..4e9dd8f5c 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -158,6 +158,12 @@ test-suite test
                       , TypeFamilies
 
     other-modules:   
+        Database.Persist.TH.EmbedSpec
+        Database.Persist.TH.ImplicitIdColSpec
+        Database.Persist.TH.MigrationOnlySpec
+        Database.Persist.TH.OverloadedLabelSpec
+        Database.Persist.TH.SharedPrimaryKeyImportedSpec
+        Database.Persist.TH.SharedPrimaryKeySpec
         Database.Persist.THSpec
         TemplateTestImports
         Database.Persist.TH.SharedPrimaryKeySpec
diff --git a/persistent/test/Database/Persist/TH/EmbedSpec.hs b/persistent/test/Database/Persist/TH/EmbedSpec.hs
new file mode 100644
index 000000000..0411157ad
--- /dev/null
+++ b/persistent/test/Database/Persist/TH/EmbedSpec.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Persist.TH.EmbedSpec where
+
+import TemplateTestImports
+
+import Data.Text (Text)
+
+import Database.Persist.ImplicitIdDef
+import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
+import Database.Persist.Types
+import Database.Persist.Types
+import Database.Persist.EntityDef
+import Database.Persist.EntityDef.Internal (toEmbedEntityDef)
+
+mkPersist sqlSettings [persistLowerCase|
+
+Thing
+    name String
+    foo  String MigrationOnly
+
+    deriving Eq Show
+
+EmbedThing
+    someThing Thing
+
+    deriving Eq Show
+
+SelfEmbed
+    name Text
+    self SelfEmbed Maybe
+    deriving Eq Show
+
+MutualEmbed
+    thing MutualTarget
+
+MutualTarget
+    thing [MutualEmbed]
+
+|]
+
+pass :: IO ()
+pass = pure ()
+
+asIO :: IO a -> IO a
+asIO = id
+
+spec :: Spec
+spec = describe "EmbedSpec" $ do
+    describe "SomeThing" $ do
+        let
+            edef =
+                entityDef $ Proxy @Thing
+        describe "toEmbedEntityDef" $ do
+            let
+                embedDef =
+                    toEmbedEntityDef edef
+            it "should have the same field count as Haskell fields" $ do
+                length (embeddedFields embedDef)
+                    `shouldBe`
+                        length (getEntityFields edef)
+
+    describe "EmbedThing" $ do
+        it "generates the right constructor" $ do
+            let embedThing :: EmbedThing
+                embedThing = EmbedThing (Thing "asdf")
+            pass
+
+    describe "SelfEmbed" $ do
+        let
+            edef =
+                entityDef $ Proxy @SelfEmbed
+        describe "fieldReference" $ do
+            let
+                [nameField, selfField] = getEntityFields edef
+            it "has self reference" $ do
+                fieldReference selfField
+                    `shouldBe`
+                        SelfReference
+        describe "toEmbedEntityDef" $ do
+            let
+                embedDef =
+                    toEmbedEntityDef edef
+            it "has the same field count as regular def" $ do
+                length (getEntityFields edef)
+                    `shouldBe`
+                        length (embeddedFields embedDef)
+
diff --git a/persistent/test/Database/Persist/TH/MigrationOnlySpec.hs b/persistent/test/Database/Persist/TH/MigrationOnlySpec.hs
new file mode 100644
index 000000000..bc1ff419f
--- /dev/null
+++ b/persistent/test/Database/Persist/TH/MigrationOnlySpec.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.Persist.TH.MigrationOnlySpec where
+
+import TemplateTestImports
+
+import Data.Text (Text)
+
+import Database.Persist.ImplicitIdDef
+import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
+import Database.Persist.Types
+
+mkPersist sqlSettings [persistLowerCase|
+
+HasMigrationOnly
+    name String
+    blargh Int MigrationOnly
+
+    deriving Eq Show
+|]
+
+pass :: IO ()
+pass = pure ()
+
+asIO :: IO a -> IO a
+asIO = id
+
+spec :: Spec
+spec = describe "MigrationOnlySpec" $ do
+    describe "HasMigrationOnly" $ do
+        let
+            edef =
+                entityDef $ Proxy @HasMigrationOnly
+        describe "getEntityFields" $ do
+            it "has one field" $ do
+                length (getEntityFields edef)
+                    `shouldBe` 1
+        describe "getEntityFieldsDatabase" $ do
+            it "has two fields" $ do
+                length (getEntityFieldsDatabase edef)
+                    `shouldBe` 2
+        describe "toPersistFields" $ do
+            it "should have one field" $ do
+                map toPersistValue (toPersistFields (HasMigrationOnly "asdf"))
+                    `shouldBe`
+                        map toPersistValue [SomePersistField ("asdf" :: Text)]
+        describe "fromPersistValues" $ do
+            it "should work with only item in list" $ do
+                fromPersistValues [PersistText "Hello"]
+                    `shouldBe`
+                        Right (HasMigrationOnly "Hello")
+
+
diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs
index eba70aca8..75ca735b8 100644
--- a/persistent/test/Database/Persist/THSpec.hs
+++ b/persistent/test/Database/Persist/THSpec.hs
@@ -47,6 +47,8 @@ import TemplateTestImports
 
 import qualified Database.Persist.TH.DiscoverEntitiesSpec as DiscoverEntitiesSpec
 import qualified Database.Persist.TH.ImplicitIdColSpec as ImplicitIdColSpec
+import qualified Database.Persist.TH.MigrationOnlySpec as MigrationOnlySpec
+import qualified Database.Persist.TH.EmbedSpec as EmbedSpec
 import qualified Database.Persist.TH.OverloadedLabelSpec as OverloadedLabelSpec
 import qualified Database.Persist.TH.SharedPrimaryKeyImportedSpec as SharedPrimaryKeyImportedSpec
 import qualified Database.Persist.TH.SharedPrimaryKeySpec as SharedPrimaryKeySpec
@@ -111,6 +113,7 @@ SharedPrimaryKeyWithCascade
 SharedPrimaryKeyWithCascadeAndCustomName
     Id (Key HasDefaultId) OnDeleteCascade sql=my_id
     name String
+
 |]
 
 share [mkPersist sqlSettings { mpsGeneric = False, mpsGenerateLenses = True }] [persistLowerCase|
@@ -139,11 +142,13 @@ instance Arbitrary Address where
     arbitrary = Address <$> arbitraryT <*> arbitraryT <*> arbitrary
 
 spec :: Spec
-spec = do
+spec = describe "THSpec" $ do
     OverloadedLabelSpec.spec
     SharedPrimaryKeySpec.spec
     SharedPrimaryKeyImportedSpec.spec
     ImplicitIdColSpec.spec
+    MigrationOnlySpec.spec
+    EmbedSpec.spec
     DiscoverEntitiesSpec.spec
     describe "TestDefaultKeyCol" $ do
         let FieldDef{..} =
diff --git a/persistent/test/main.hs b/persistent/test/main.hs
index 99c5d22ea..6335758af 100644
--- a/persistent/test/main.hs
+++ b/persistent/test/main.hs
@@ -30,10 +30,9 @@ import qualified Database.Persist.THSpec as THSpec
 
 main :: IO ()
 main = hspec $ do
-    describe "Database.Persist" $ do
-        describe "THSpec" THSpec.spec
+    describe "Database" $ describe "Persist" $ do
+        THSpec.spec
 
-    THSpec.spec
     describe "splitExtras" $ do
         let helloWorldTokens = Token "hello" :| [Token "world"]
             foobarbazTokens = Token "foo" :| [Token "bar", Token "baz"]