From 9f4cf5957c8f76e87281bf248fb2a5234338c735 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Tue, 20 Apr 2021 13:31:53 -0600
Subject: [PATCH 01/19] Implicit ID Column COnfiguration

---
 persistent/Database/Persist/Quasi.hs       | 34 +++++++++++-------
 persistent/Database/Persist/TH.hs          | 40 ++++++++++++++--------
 persistent/test/Database/Persist/THSpec.hs | 17 +++++++++
 3 files changed, 64 insertions(+), 27 deletions(-)

diff --git a/persistent/Database/Persist/Quasi.hs b/persistent/Database/Persist/Quasi.hs
index c97860c06..dc10fedf3 100644
--- a/persistent/Database/Persist/Quasi.hs
+++ b/persistent/Database/Persist/Quasi.hs
@@ -856,7 +856,9 @@ mkEntityDef ps name entattribs lines =
         -- idField is the user-specified Id
         -- otherwise useAutoIdField
         -- but, adjust it if the user specified a Primary
-        , entityId = setComposite primaryComposite $ fromMaybe autoIdField idField
+        , entityId =
+            setComposite primaryComposite
+            $ fromMaybe autoIdField idField
         , entityAttrs = entattribs
         , entityFields = cols
         , entityUniques = uniqs
@@ -879,13 +881,12 @@ mkEntityDef ps name entattribs lines =
         fmap tokenText <$> attribs
 
     attribPrefix = flip lookupKeyVal entattribs
-    idName | Just _ <- attribPrefix "id" = error "id= is deprecated, ad a field named 'Id' and use sql="
-           | otherwise = Nothing
 
-    (idField, primaryComposite, uniqs, foreigns) = foldl' (\(mid, mp, us, fs) attr ->
-        let (i, p, u, f) = takeConstraint ps name' cols attr
-            squish xs m = xs `mappend` maybeToList m
-        in (just1 mid i, just1 mp p, squish us u, squish fs f)) (Nothing, Nothing, [],[]) textAttribs
+    idName
+        | Just _ <- attribPrefix "id" =
+            error "id= is deprecated, ad a field named 'Id' and use sql="
+        | otherwise =
+            Nothing
 
     cols :: [FieldDef]
     cols = reverse . fst . foldr k ([], []) $ reverse attribs
@@ -901,12 +902,18 @@ mkEntityDef ps name entattribs lines =
                   Nothing ->
                       (acc, [])
 
-    autoIdField = mkAutoIdField ps entName (FieldNameDB `fmap` idName) idSqlType
-    idSqlType = maybe SqlInt64 (const $ SqlOther "Primary Key") primaryComposite
+    autoIdField =
+        mkAutoIdField ps entName
+
+    (idField, primaryComposite, uniqs, foreigns) = foldl' (\(mid, mp, us, fs) attr ->
+        let (i, p, u, f) = takeConstraint ps name' cols attr
+            squish xs m = xs `mappend` maybeToList m
+        in (just1 mid i, just1 mp p, squish us u, squish fs f)) (Nothing, Nothing, [],[]) textAttribs
 
     setComposite Nothing fd = fd
     setComposite (Just c) fd = fd
         { fieldReference = CompositeRef c
+        , fieldSqlType = SqlOther "Primary Key"
         }
 
 setFieldComments :: [Text] -> FieldDef -> FieldDef
@@ -920,16 +927,17 @@ just1 (Just x) (Just y) = error $ "expected only one of: "
   `mappend` show x `mappend` " " `mappend` show y
 just1 x y = x `mplus` y
 
-mkAutoIdField :: PersistSettings -> EntityNameHS -> Maybe FieldNameDB -> SqlType -> FieldDef
-mkAutoIdField ps entName idName idSqlType =
+mkAutoIdField :: PersistSettings -> EntityNameHS -> FieldDef
+mkAutoIdField ps entName =
     FieldDef
         { fieldHaskell = FieldNameHS "Id"
         -- this should be modeled as a Maybe
         -- but that sucks for non-ID field
         -- TODO: use a sumtype FieldDef | IdFieldDef
-        , fieldDB = fromMaybe (FieldNameDB $ psIdName ps) idName
+        , fieldDB = FieldNameDB $ psIdName ps
         , fieldType = FTTypeCon Nothing $ keyConName $ unEntityNameHS entName
-        , fieldSqlType = idSqlType
+        , fieldSqlType =
+            SqlInt64
         -- the primary field is actually a reference to the entity
         , fieldReference = ForeignRef entName defaultReferenceTypeCon
         , fieldAttrs = []
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index ca2bfd164..e3c0fc623 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -967,30 +967,42 @@ mkKeyTypeDec mps entDef = do
     supplement :: [Name] -> [Name]
     supplement names = names <> (filter (`notElem` names) $ mpsDeriveInstances mps)
 
--- | Returns 'True' if the key definition has more than 1 field.
+-- | Returns 'True' if the key definition has less than 2 fields.
 --
 -- @since 2.11.0.0
 pkNewtype :: MkPersistSettings -> EntityDef -> Bool
 pkNewtype mps entDef = length (keyFields mps entDef) < 2
 
 defaultIdType :: EntityDef -> Bool
-defaultIdType entDef = fieldType (entityId entDef) == FTTypeCon Nothing (keyIdText entDef)
+defaultIdType entDef =
+    fieldType (entityId entDef) == FTTypeCon Nothing (keyIdText entDef)
 
 keyFields :: MkPersistSettings -> EntityDef -> [(Name, Strict, Type)]
-keyFields mps entDef = case entityPrimary entDef of
-  Just pdef -> map primaryKeyVar (compositeFields pdef)
-  Nothing   -> if defaultIdType entDef
-    then [idKeyVar backendKeyType]
-    else [idKeyVar $ ftToType $ fieldType $ entityId entDef]
+keyFields mps entDef =
+    case entityPrimary entDef of
+        Just pdef ->
+            map primaryKeyVar (compositeFields pdef)
+        Nothing ->
+            pure . idKeyVar $
+                if defaultIdType entDef
+                then backendKeyType
+                else ftToType $ fieldType $ entityId entDef
   where
     backendKeyType
-        | mpsGeneric mps = ConT ''BackendKey `AppT` backendT
-        | otherwise      = ConT ''BackendKey `AppT` mpsBackend mps
-    idKeyVar ft = (unKeyName entDef, notStrict, ft)
-    primaryKeyVar fieldDef = ( keyFieldName mps entDef fieldDef
-                       , notStrict
-                       , ftToType $ fieldType fieldDef
-                       )
+        | mpsGeneric mps =
+            ConT ''BackendKey `AppT` backendT
+        | otherwise =
+            ConT ''BackendKey `AppT` mpsBackend mps
+    idKeyVar ft =
+        ( unKeyName entDef
+        , notStrict
+        , ft
+        )
+    primaryKeyVar fieldDef =
+        ( keyFieldName mps entDef fieldDef
+        , notStrict
+        , ftToType $ fieldType fieldDef
+        )
 
 mkKeyToValues :: MkPersistSettings -> EntityDef -> Q Dec
 mkKeyToValues mps entDef = do
diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs
index dd8930ba9..2e3c3ba09 100644
--- a/persistent/test/Database/Persist/THSpec.hs
+++ b/persistent/test/Database/Persist/THSpec.hs
@@ -80,6 +80,10 @@ HasMultipleColPrimaryDef
     barbaz String
     Primary foobar barbaz
 
+TestDefaultKeyCol
+    Id TestDefaultKeyColId
+    name String
+
 HasIdDef
     Id Int
     name String
@@ -134,6 +138,19 @@ spec = do
     OverloadedLabelSpec.spec
     SharedPrimaryKeySpec.spec
     SharedPrimaryKeyImportedSpec.spec
+    describe "TestDefaultKeyCol" $ do
+        let FieldDef{..} =
+                entityId (entityDef (Proxy @TestDefaultKeyCol))
+        it "should be a BackendKey SqlBackend" $ do
+            -- the purpose of this test is to verify that a custom Id column of
+            -- the form:
+            -- > ModelName
+            -- >     Id ModelNameId
+            --
+            -- should behave like an implicit id column.
+            TestDefaultKeyColKey (SqlBackendKey 32)
+                `shouldBe`
+                    toSqlKey 32
     describe "HasDefaultId" $ do
         let FieldDef{..} =
                 entityId (entityDef (Proxy @HasDefaultId))

From 14610650a16ca46010f5d1d36e43d6414de4548d Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Tue, 20 Apr 2021 18:01:56 -0600
Subject: [PATCH 02/19] PersistSettings is internal

---
 persistent/Database/Persist/Quasi.hs          | 47 +++++++++++++++++--
 persistent/Database/Persist/Quasi/Internal.hs |  1 +
 persistent/Database/Persist/TH.hs             |  5 +-
 3 files changed, 48 insertions(+), 5 deletions(-)

diff --git a/persistent/Database/Persist/Quasi.hs b/persistent/Database/Persist/Quasi.hs
index fdc98d9e2..2bd030221 100644
--- a/persistent/Database/Persist/Quasi.hs
+++ b/persistent/Database/Persist/Quasi.hs
@@ -1,10 +1,8 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
 
 {-|
 This module defines the Persistent entity syntax used in the quasiquoter to generate persistent entities.
@@ -415,10 +413,53 @@ Unfortunately, we can't use this to create Haddocks for you, because <https://gi
 -}
 module Database.Persist.Quasi
     ( parse
-    , PersistSettings (..)
+    -- * 'PersistSettings'
+    , PersistSettings
     , upperCaseSettings
     , lowerCaseSettings
     , nullable
+    -- ** Getters and Setters
+    , module Database.Persist.Quasi
     ) where
 
+import Data.Text (Text)
 import Database.Persist.Quasi.Internal
+
+-- | Retrieve the function in the 'PersistSettings' that modifies the names into
+-- database names.
+--
+-- @since 2.13.0.0
+getPsToDBName :: PersistSettings -> Text -> Text
+getPsToDBName = psToDBName
+
+-- | Set the name modification function that translates the QuasiQuoted names
+-- for use in the database.
+--
+-- @since 2.13.0.0
+setPsToDBName :: (Text -> Text) -> PersistSettings -> PersistSettings
+setPsToDBName f ps = ps { psToDBName = f }
+
+-- | Retrieve whether or not the 'PersistSettings' will generate code with
+-- strict fields.
+--
+-- @since 2.13.0.0
+getPsStrictFields :: PersistSettings -> Bool
+getPsStrictFields = psStrictFields
+
+-- | Set whether or not the 'PersistSettings' will make fields strict.
+--
+-- @since 2.13.0.0
+setPsStrictFields :: Bool -> PersistSettings -> PersistSettings
+setPsStrictFields a ps = ps { psStrictFields = a }
+
+-- | Retrievce the default name of the @id@ column.
+--
+-- @since 2.13.0.0
+getPsIdName :: PersistSettings -> Text
+getPsIdName = psIdName
+
+-- | Set the default name of the @id@ column.
+--
+-- @since 2.13.0.0
+setPsIdName :: Text -> PersistSettings -> PersistSettings
+setPsIdName n ps = ps { psIdName = n }
diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index 255065d36..e50113168 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -100,6 +100,7 @@ parseFieldType t0 =
 
 data PersistSettings = PersistSettings
     { psToDBName :: !(Text -> Text)
+    -- ^ Modify the Haskell-style name into a database-style name.
     , psStrictFields :: !Bool
     -- ^ Whether fields are by default strict. Default value: @True@.
     --
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 5f546f309..208596a3a 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -244,9 +244,10 @@ embedEntityDefsMap rawEnts = (embedEntityMap, noCycleEnts)
         where
             membed = emFieldEmbed emf
 
--- calls parse to Quasi.parse individual entities in isolation
+-- | Calls 'parse' to Quasi.parse individual entities in isolation
 -- afterwards, sets references to other entities
--- | @since 2.5.3
+--
+-- @since 2.5.3
 parseReferences :: PersistSettings -> Text -> Q Exp
 parseReferences ps s = lift $
     map (mkEntityDefSqlTypeExp embedEntityMap entityMap) noCycleEnts

From f60d18d5b71f99258afdfd48a03fae65ec24f085 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Tue, 20 Apr 2021 18:24:31 -0600
Subject: [PATCH 03/19] start teasing out the module structure

---
 persistent/Database/Persist/Quasi/Internal.hs | 57 ++++++------
 persistent/Database/Persist/Types/Base.hs     | 88 +------------------
 persistent/Database/Persist/Types/FieldDef.hs |  6 ++
 .../Persist/Types/FieldDef/Internal.hs        | 56 ++++++++++++
 persistent/Database/Persist/Types/Names.hs    | 54 ++++++++++++
 persistent/persistent.cabal                   |  3 +
 6 files changed, 152 insertions(+), 112 deletions(-)
 create mode 100644 persistent/Database/Persist/Types/FieldDef.hs
 create mode 100644 persistent/Database/Persist/Types/FieldDef/Internal.hs
 create mode 100644 persistent/Database/Persist/Types/Names.hs

diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index e50113168..7ddc0fff3 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -316,7 +316,8 @@ fixForeignKeysAll unEnts = map fixForeignKeys unEnts
     fixForeignKeys (UnboundEntityDef foreigns ent) =
       ent { entityForeigns = map (fixForeignKey ent) foreigns }
 
-    -- check the count and the sqltypes match and update the foreignFields with the names of the referenced columns
+    -- check the count and the sqltypes match and update the foreignFields with
+    -- the names of the referenced columns
     fixForeignKey :: EntityDef -> UnboundForeignDef -> ForeignDef
     fixForeignKey ent (UnboundForeignDef foreignFieldTexts parentFieldTexts fdef) =
         case mfdefs of
@@ -394,10 +395,11 @@ fixForeignKeysAll unEnts = map fixForeignKeys unEnts
         lengthError pdef = error $ "found " ++ show (length foreignFieldTexts) ++ " fkeys and " ++ show (length pdef) ++ " pkeys: fdef=" ++ show fdef ++ " pdef=" ++ show pdef
 
 
-data UnboundEntityDef = UnboundEntityDef
-                        { _unboundForeignDefs :: [UnboundForeignDef]
-                        , unboundEntityDef :: EntityDef
-                        }
+data UnboundEntityDef
+    = UnboundEntityDef
+    { _unboundForeignDefs :: [UnboundForeignDef]
+    , unboundEntityDef :: EntityDef
+    }
 
 overUnboundEntityDef
     :: (EntityDef -> EntityDef) -> UnboundEntityDef -> UnboundEntityDef
@@ -411,29 +413,30 @@ lookupPrefix :: Text -> [Text] -> Maybe Text
 lookupPrefix prefix = msum . map (T.stripPrefix prefix)
 
 -- | Construct an entity definition.
-mkEntityDef :: PersistSettings
-            -> Text -- ^ name
-            -> [Attr] -- ^ entity attributes
-            -> [Line] -- ^ indented lines
-            -> UnboundEntityDef
+mkEntityDef
+    :: PersistSettings
+    -> Text -- ^ name
+    -> [Attr] -- ^ entity attributes
+    -> [Line] -- ^ indented lines
+    -> UnboundEntityDef
 mkEntityDef ps name entattribs lines =
-  UnboundEntityDef foreigns $
-    EntityDef
-        { entityHaskell = EntityNameHS name'
-        , entityDB = EntityNameDB $ getDbName ps name' entattribs
-        -- idField is the user-specified Id
-        -- otherwise useAutoIdField
-        -- but, adjust it if the user specified a Primary
-        , entityId = setComposite primaryComposite $ fromMaybe autoIdField idField
-        , entityAttrs = entattribs
-        , entityFields = cols
-        , entityUniques = uniqs
-        , entityForeigns = []
-        , entityDerives = concat $ mapMaybe takeDerives textAttribs
-        , entityExtra = extras
-        , entitySum = isSum
-        , entityComments = Nothing
-        }
+    UnboundEntityDef foreigns $
+        EntityDef
+            { entityHaskell = entName
+            , entityDB = EntityNameDB $ getDbName ps name' entattribs
+            -- idField is the user-specified Id
+            -- otherwise useAutoIdField
+            -- but, adjust it if the user specified a Primary
+            , entityId = setComposite primaryComposite $ fromMaybe autoIdField idField
+            , entityAttrs = entattribs
+            , entityFields = cols
+            , entityUniques = uniqs
+            , entityForeigns = []
+            , entityDerives = concat $ mapMaybe takeDerives textAttribs
+            , entityExtra = extras
+            , entitySum = isSum
+            , entityComments = Nothing
+            }
   where
     entName = EntityNameHS name'
     (isSum, name') =
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index 1f6054bc2..fd8afbffa 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -42,6 +42,9 @@ import Language.Haskell.TH.Syntax (Lift(..))
     -- instance on pre-1.2.4 versions of `text`
 import Instances.TH.Lift ()
 
+import Database.Persist.Types.FieldDef.Internal
+import Database.Persist.Types.Names
+
 -- | A 'Checkmark' should be used as a field type whenever a
 -- uniqueness constraint should guarantee that a certain kind of
 -- record may appear at most once, but other kinds of records may
@@ -120,29 +123,6 @@ data WhyNullable = ByMaybeAttr
                  | ByNullableAttr
                   deriving (Eq, Show)
 
--- | Convenience operations for working with '-NameDB' types.
---
--- @since 2.12.0.0
-class DatabaseName a where
-  escapeWith :: (Text -> str) -> (a -> str)
-
--- | An 'EntityNameDB' represents the datastore-side name that @persistent@
--- will use for an entity.
---
--- @since 2.12.0.0
-newtype EntityNameDB = EntityNameDB { unEntityNameDB :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
-
-instance DatabaseName EntityNameDB where
-  escapeWith f (EntityNameDB n) = f n
-
--- | An 'EntityNameHS' represents the Haskell-side name that @persistent@
--- will use for an entity.
---
--- @since 2.12.0.0
-newtype EntityNameHS = EntityNameHS { unEntityNameHS :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
-
 -- | An 'EntityDef' represents the information that @persistent@ knows
 -- about an Entity. It uses this information to generate the Haskell
 -- datatype, the SQL migrations, and other relevant conversions.
@@ -268,68 +248,6 @@ data FieldType
     | FTList FieldType
     deriving (Show, Eq, Read, Ord, Lift)
 
--- | An 'EntityNameDB' represents the datastore-side name that @persistent@
--- will use for an entity.
---
--- @since 2.12.0.0
-newtype FieldNameDB = FieldNameDB { unFieldNameDB :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
-
--- | @since 2.12.0.0
-instance DatabaseName FieldNameDB where
-    escapeWith f (FieldNameDB n) = f n
-
--- | A 'FieldNameHS' represents the Haskell-side name that @persistent@
--- will use for a field.
---
--- @since 2.12.0.0
-newtype FieldNameHS = FieldNameHS { unFieldNameHS :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
-
--- | A 'FieldDef' represents the inormation that @persistent@ knows about
--- a field of a datatype. This includes information used to parse the field
--- out of the database and what the field corresponds to.
-data FieldDef = FieldDef
-    { fieldHaskell   :: !FieldNameHS
-    -- ^ The name of the field. Note that this does not corresponds to the
-    -- record labels generated for the particular entity - record labels
-    -- are generated with the type name prefixed to the field, so
-    -- a 'FieldDef' that contains a @'FieldNameHS' "name"@ for a type
-    -- @User@ will have a record field @userName@.
-    , fieldDB        :: !FieldNameDB
-    -- ^ The name of the field in the database. For SQL databases, this
-    -- corresponds to the column name.
-    , fieldType      :: !FieldType
-    -- ^ The type of the field in Haskell.
-    , fieldSqlType   :: !SqlType
-    -- ^ The type of the field in a SQL database.
-    , fieldAttrs     :: ![FieldAttr]
-    -- ^ User annotations for a field. These are provided with the @!@
-    -- operator.
-    , fieldStrict    :: !Bool
-    -- ^ If this is 'True', then the Haskell datatype will have a strict
-    -- record field. The default value for this is 'True'.
-    , fieldReference :: !ReferenceDef
-    , fieldCascade :: !FieldCascade
-    -- ^ Defines how operations on the field cascade on to the referenced
-    -- tables. This doesn't have any meaning if the 'fieldReference' is set
-    -- to 'NoReference' or 'SelfReference'. The cascade option here should
-    -- be the same as the one obtained in the 'fieldReference'.
-    --
-    -- @since 2.11.0
-    , fieldComments  :: !(Maybe Text)
-    -- ^ Optional comments for a 'Field'. There is not currently a way to
-    -- attach comments to a field in the quasiquoter.
-    --
-    -- @since 2.10.0
-    , fieldGenerated :: !(Maybe Text)
-    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
-    -- the expression to use for generation.
-    --
-    -- @since 2.11.0.0
-    }
-    deriving (Show, Eq, Read, Ord, Lift)
-
 isFieldNotGenerated :: FieldDef -> Bool
 isFieldNotGenerated = isNothing . fieldGenerated
 
diff --git a/persistent/Database/Persist/Types/FieldDef.hs b/persistent/Database/Persist/Types/FieldDef.hs
new file mode 100644
index 000000000..2124d7d63
--- /dev/null
+++ b/persistent/Database/Persist/Types/FieldDef.hs
@@ -0,0 +1,6 @@
+module Database.Persist.Types.FieldDef
+    (
+    ) where
+
+import Database.Persist.Types.FieldDef.Internal
+
diff --git a/persistent/Database/Persist/Types/FieldDef/Internal.hs b/persistent/Database/Persist/Types/FieldDef/Internal.hs
new file mode 100644
index 000000000..a121f88c1
--- /dev/null
+++ b/persistent/Database/Persist/Types/FieldDef/Internal.hs
@@ -0,0 +1,56 @@
+-- |  This module contains internal definitions for the 'FieldDef' type.
+-- Breaking changes to the interface of this module will not be represented
+-- as a breaking change in the version of the code. Please depend on
+-- "Database.Persist.Types.FieldDef" instead. If you need this module,
+-- please file an issue on GitHub.
+--
+-- @since 2.13.0.0
+module Database.Persist.Types.FieldDef.Internal where
+
+import Database.Persist.Types.Names
+import Language.Haskell.TH.Syntax (Lift)
+import Data.Text (Text)
+
+-- | A 'FieldDef' represents the inormation that @persistent@ knows about
+-- a field of a datatype. This includes information used to parse the field
+-- out of the database and what the field corresponds to.
+data FieldDef = FieldDef
+    { fieldHaskell   :: !FieldNameHS
+    -- ^ The name of the field. Note that this does not corresponds to the
+    -- record labels generated for the particular entity - record labels
+    -- are generated with the type name prefixed to the field, so
+    -- a 'FieldDef' that contains a @'FieldNameHS' "name"@ for a type
+    -- @User@ will have a record field @userName@.
+    , fieldDB        :: !FieldNameDB
+    -- ^ The name of the field in the database. For SQL databases, this
+    -- corresponds to the column name.
+    , fieldType      :: !FieldType
+    -- ^ The type of the field in Haskell.
+    , fieldSqlType   :: !SqlType
+    -- ^ The type of the field in a SQL database.
+    , fieldAttrs     :: ![FieldAttr]
+    -- ^ User annotations for a field. These are provided with the @!@
+    -- operator.
+    , fieldStrict    :: !Bool
+    -- ^ If this is 'True', then the Haskell datatype will have a strict
+    -- record field. The default value for this is 'True'.
+    , fieldReference :: !ReferenceDef
+    , fieldCascade :: !FieldCascade
+    -- ^ Defines how operations on the field cascade on to the referenced
+    -- tables. This doesn't have any meaning if the 'fieldReference' is set
+    -- to 'NoReference' or 'SelfReference'. The cascade option here should
+    -- be the same as the one obtained in the 'fieldReference'.
+    --
+    -- @since 2.11.0
+    , fieldComments  :: !(Maybe Text)
+    -- ^ Optional comments for a 'Field'. There is not currently a way to
+    -- attach comments to a field in the quasiquoter.
+    --
+    -- @since 2.10.0
+    , fieldGenerated :: !(Maybe Text)
+    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
+    -- the expression to use for generation.
+    --
+    -- @since 2.11.0.0
+    }
+    deriving (Show, Eq, Read, Ord, Lift)
diff --git a/persistent/Database/Persist/Types/Names.hs b/persistent/Database/Persist/Types/Names.hs
new file mode 100644
index 000000000..567c1974a
--- /dev/null
+++ b/persistent/Database/Persist/Types/Names.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE DeriveLift #-}
+
+-- | This module contains types and functions for working with and
+-- disambiguating database and Haskell names.
+--
+-- @since 2.13.0.0
+module Database.Persist.Types.Names where
+
+import Data.Text (Text)
+import Language.Haskell.TH.Syntax (Lift)
+-- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
+-- instance on pre-1.2.4 versions of `text`
+import Instances.TH.Lift ()
+
+-- | Convenience operations for working with '-NameDB' types.
+--
+-- @since 2.12.0.0
+class DatabaseName a where
+    escapeWith :: (Text -> str) -> (a -> str)
+
+-- | An 'EntityNameDB' represents the datastore-side name that @persistent@
+-- will use for an entity.
+--
+-- @since 2.12.0.0
+newtype FieldNameDB = FieldNameDB { unFieldNameDB :: Text }
+    deriving (Show, Eq, Read, Ord, Lift)
+
+-- | @since 2.12.0.0
+instance DatabaseName FieldNameDB where
+    escapeWith f (FieldNameDB n) = f n
+
+-- | A 'FieldNameHS' represents the Haskell-side name that @persistent@
+-- will use for a field.
+--
+-- @since 2.12.0.0
+newtype FieldNameHS = FieldNameHS { unFieldNameHS :: Text }
+    deriving (Show, Eq, Read, Ord, Lift)
+
+-- | An 'EntityNameHS' represents the Haskell-side name that @persistent@
+-- will use for an entity.
+--
+-- @since 2.12.0.0
+newtype EntityNameHS = EntityNameHS { unEntityNameHS :: Text }
+    deriving (Show, Eq, Read, Ord, Lift)
+
+-- | An 'EntityNameDB' represents the datastore-side name that @persistent@
+-- will use for an entity.
+--
+-- @since 2.12.0.0
+newtype EntityNameDB = EntityNameDB { unEntityNameDB :: Text }
+    deriving (Show, Eq, Read, Ord, Lift)
+
+instance DatabaseName EntityNameDB where
+    escapeWith f (EntityNameDB n) = f n
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 9b58142ed..b8b902b09 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -52,6 +52,9 @@ library
     exposed-modules: 
         Database.Persist
         Database.Persist.Types
+        Database.Persist.Types.Names
+        Database.Persist.Types.FieldDef
+        Database.Persist.Types.FieldDef.Internal
         Database.Persist.TH
 
         Database.Persist.Quasi

From 0dc2a08957ff300ab43175850d845e111e87706a Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Wed, 21 Apr 2021 15:29:33 -0600
Subject: [PATCH 04/19] move around, factor out the Names module

---
 persistent/Database/Persist.hs                |  1 +
 .../Database/Persist/Class/PersistEntity.hs   |  1 +
 .../Database/Persist/{Types => }/Names.hs     | 20 ++++-
 persistent/Database/Persist/Quasi/Internal.hs |  1 +
 persistent/Database/Persist/Sql/Internal.hs   |  1 +
 persistent/Database/Persist/Sql/Types.hs      |  1 +
 persistent/Database/Persist/SqlBackend.hs     |  1 +
 .../Database/Persist/SqlBackend/Internal.hs   |  1 +
 .../SqlBackend/Internal/MkSqlBackend.hs       |  1 +
 persistent/Database/Persist/Types.hs          |  2 +
 persistent/Database/Persist/Types/Base.hs     | 82 +++++++++++++------
 persistent/Database/Persist/Types/FieldDef.hs |  6 --
 persistent/persistent.cabal                   |  4 +-
 13 files changed, 88 insertions(+), 34 deletions(-)
 rename persistent/Database/Persist/{Types => }/Names.hs (71%)
 delete mode 100644 persistent/Database/Persist/Types/FieldDef.hs

diff --git a/persistent/Database/Persist.hs b/persistent/Database/Persist.hs
index e9846d4cc..7d1495961 100644
--- a/persistent/Database/Persist.hs
+++ b/persistent/Database/Persist.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE ExistentialQuantification #-}
+
 module Database.Persist
     ( module Database.Persist.Class
     , module Database.Persist.Types
diff --git a/persistent/Database/Persist/Class/PersistEntity.hs b/persistent/Database/Persist/Class/PersistEntity.hs
index edde12c87..b50095444 100644
--- a/persistent/Database/Persist/Class/PersistEntity.hs
+++ b/persistent/Database/Persist/Class/PersistEntity.hs
@@ -51,6 +51,7 @@ import GHC.TypeLits
 
 import Database.Persist.Class.PersistField
 import Database.Persist.Types.Base
+import Database.Persist.Names
 
 -- | Persistent serialized Haskell records to the database.
 -- A Database 'Entity' (A row in SQL, a document in MongoDB, etc)
diff --git a/persistent/Database/Persist/Types/Names.hs b/persistent/Database/Persist/Names.hs
similarity index 71%
rename from persistent/Database/Persist/Types/Names.hs
rename to persistent/Database/Persist/Names.hs
index 567c1974a..e075ff604 100644
--- a/persistent/Database/Persist/Types/Names.hs
+++ b/persistent/Database/Persist/Names.hs
@@ -4,7 +4,7 @@
 -- disambiguating database and Haskell names.
 --
 -- @since 2.13.0.0
-module Database.Persist.Types.Names where
+module Database.Persist.Names where
 
 import Data.Text (Text)
 import Language.Haskell.TH.Syntax (Lift)
@@ -52,3 +52,21 @@ newtype EntityNameDB = EntityNameDB { unEntityNameDB :: Text }
 
 instance DatabaseName EntityNameDB where
     escapeWith f (EntityNameDB n) = f n
+
+-- | A 'ConstraintNameDB' represents the datastore-side name that @persistent@
+-- will use for a constraint.
+--
+-- @since 2.12.0.0
+newtype ConstraintNameDB = ConstraintNameDB { unConstraintNameDB :: Text }
+  deriving (Show, Eq, Read, Ord, Lift)
+
+-- | @since 2.12.0.0
+instance DatabaseName ConstraintNameDB where
+  escapeWith f (ConstraintNameDB n) = f n
+
+-- | An 'ConstraintNameHS' represents the Haskell-side name that @persistent@
+-- will use for a constraint.
+--
+-- @since 2.12.0.0
+newtype ConstraintNameHS = ConstraintNameHS { unConstraintNameHS :: Text }
+  deriving (Show, Eq, Read, Ord, Lift)
diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index 7ddc0fff3..98250f2d9 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -48,6 +48,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Database.Persist.Types
 import Text.Read (readEither)
+import Database.Persist.Names
 
 data ParseState a = PSDone | PSFail String | PSSuccess a Text deriving Show
 
diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs
index 94649b02a..06c6ed92a 100644
--- a/persistent/Database/Persist/Sql/Internal.hs
+++ b/persistent/Database/Persist/Sql/Internal.hs
@@ -21,6 +21,7 @@ import qualified Data.Text as T
 import Database.Persist.Quasi
 import Database.Persist.Sql.Types
 import Database.Persist.Types
+import Database.Persist.Names
 import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
 
 -- | Record of functions to override the default behavior in 'mkColumns'.  It is
diff --git a/persistent/Database/Persist/Sql/Types.hs b/persistent/Database/Persist/Sql/Types.hs
index 8df81a30f..d21b75505 100644
--- a/persistent/Database/Persist/Sql/Types.hs
+++ b/persistent/Database/Persist/Sql/Types.hs
@@ -21,6 +21,7 @@ import Data.Text (Text, unpack)
 import Data.Time (NominalDiffTime)
 import Database.Persist.Sql.Types.Internal
 import Database.Persist.Types
+import Database.Persist.Names
 
 data Column = Column
     { cName      :: !FieldNameDB
diff --git a/persistent/Database/Persist/SqlBackend.hs b/persistent/Database/Persist/SqlBackend.hs
index 936502e6f..2c3a2cf0d 100644
--- a/persistent/Database/Persist/SqlBackend.hs
+++ b/persistent/Database/Persist/SqlBackend.hs
@@ -32,6 +32,7 @@ import qualified Database.Persist.SqlBackend.Internal as SqlBackend
        (SqlBackend(..))
 import Database.Persist.SqlBackend.Internal.MkSqlBackend as Mk (MkSqlBackendArgs(..))
 import Database.Persist.Types.Base
+import Database.Persist.Names
 import Database.Persist.SqlBackend.Internal.InsertSqlResult
 import Data.List.NonEmpty (NonEmpty)
 
diff --git a/persistent/Database/Persist/SqlBackend/Internal.hs b/persistent/Database/Persist/SqlBackend/Internal.hs
index b74332a26..ab2958631 100644
--- a/persistent/Database/Persist/SqlBackend/Internal.hs
+++ b/persistent/Database/Persist/SqlBackend/Internal.hs
@@ -12,6 +12,7 @@ import Data.Acquire
 import Database.Persist.Class.PersistStore
 import Conduit
 import Database.Persist.Types.Base
+import Database.Persist.Names
 import Data.Int
 import Data.IORef
 import Control.Monad.Reader
diff --git a/persistent/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs b/persistent/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs
index 4b5045d27..e7c04bb5c 100644
--- a/persistent/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs
+++ b/persistent/Database/Persist/SqlBackend/Internal/MkSqlBackend.hs
@@ -17,6 +17,7 @@ import Database.Persist.SqlBackend.Internal.Statement
 import Database.Persist.SqlBackend.Internal.InsertSqlResult
 import Database.Persist.SqlBackend.Internal.IsolationLevel
 import Database.Persist.Types.Base
+import Database.Persist.Names
 
 -- | This type shares many of the same field names as the 'SqlBackend' type.
 -- It's useful for library authors to use this when migrating from using the
diff --git a/persistent/Database/Persist/Types.hs b/persistent/Database/Persist/Types.hs
index 4625c2dc1..d681b7675 100644
--- a/persistent/Database/Persist/Types.hs
+++ b/persistent/Database/Persist/Types.hs
@@ -1,5 +1,6 @@
 module Database.Persist.Types
     ( module Database.Persist.Types.Base
+    , module Database.Persist.Names
     , SomePersistField (..)
     , Update (..)
     , BackendSpecificUpdate
@@ -12,6 +13,7 @@ module Database.Persist.Types
     , OverflowNatural(..)
     ) where
 
+import Database.Persist.Names
 import Database.Persist.Types.Base
 import Database.Persist.Class.PersistField
 import Database.Persist.Class.PersistEntity
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index fd8afbffa..038ca156f 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -42,8 +42,7 @@ import Language.Haskell.TH.Syntax (Lift(..))
     -- instance on pre-1.2.4 versions of `text`
 import Instances.TH.Lift ()
 
-import Database.Persist.Types.FieldDef.Internal
-import Database.Persist.Types.Names
+import Database.Persist.Names
 
 -- | A 'Checkmark' should be used as a field type whenever a
 -- uniqueness constraint should guarantee that a certain kind of
@@ -304,35 +303,26 @@ toEmbedEntityDef ent = embDef
                         _ -> Nothing
                     }
 
--- | A 'ConstraintNameDB' represents the datastore-side name that @persistent@
--- will use for a constraint.
+-- | Type for storing the Uniqueness constraint in the Schema.  Assume you have
+-- the following schema with a uniqueness constraint:
 --
--- @since 2.12.0.0
-newtype ConstraintNameDB = ConstraintNameDB { unConstraintNameDB :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
-
--- | @since 2.12.0.0
-instance DatabaseName ConstraintNameDB where
-  escapeWith f (ConstraintNameDB n) = f n
-
--- | An 'ConstraintNameHS' represents the Haskell-side name that @persistent@
--- will use for a constraint.
---
--- @since 2.12.0.0
-newtype ConstraintNameHS = ConstraintNameHS { unConstraintNameHS :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
-
--- Type for storing the Uniqueness constraint in the Schema.
--- Assume you have the following schema with a uniqueness
--- constraint:
+-- @
 -- Person
 --   name String
 --   age Int
 --   UniqueAge age
+-- @
 --
 -- This will be represented as:
--- UniqueDef (ConstraintNameHS (packPTH "UniqueAge"))
--- (ConstraintNameDB (packPTH "unique_age")) [(FieldNameHS (packPTH "age"), FieldNameDB (packPTH "age"))] []
+--
+-- @
+-- UniqueDef
+--     { uniqueHaskell = ConstraintNameHS (packPTH "UniqueAge")
+--     , uniqueDBName = ConstraintNameDB (packPTH "unique_age")
+--     , uniqueFields = [(FieldNameHS (packPTH "age"), FieldNameDB (packPTH "age"))]
+--     , uniqueAttrs = []
+--     }
+-- @
 --
 data UniqueDef = UniqueDef
     { uniqueHaskell :: !ConstraintNameHS
@@ -683,3 +673,47 @@ instance Exception OnlyUniqueException
 data PersistUpdate = Assign | Add | Subtract | Multiply | Divide
                    | BackendSpecificUpdate T.Text
     deriving (Read, Show, Lift)
+
+-- | A 'FieldDef' represents the inormation that @persistent@ knows about
+-- a field of a datatype. This includes information used to parse the field
+-- out of the database and what the field corresponds to.
+data FieldDef = FieldDef
+    { fieldHaskell   :: !FieldNameHS
+    -- ^ The name of the field. Note that this does not corresponds to the
+    -- record labels generated for the particular entity - record labels
+    -- are generated with the type name prefixed to the field, so
+    -- a 'FieldDef' that contains a @'FieldNameHS' "name"@ for a type
+    -- @User@ will have a record field @userName@.
+    , fieldDB        :: !FieldNameDB
+    -- ^ The name of the field in the database. For SQL databases, this
+    -- corresponds to the column name.
+    , fieldType      :: !FieldType
+    -- ^ The type of the field in Haskell.
+    , fieldSqlType   :: !SqlType
+    -- ^ The type of the field in a SQL database.
+    , fieldAttrs     :: ![FieldAttr]
+    -- ^ User annotations for a field. These are provided with the @!@
+    -- operator.
+    , fieldStrict    :: !Bool
+    -- ^ If this is 'True', then the Haskell datatype will have a strict
+    -- record field. The default value for this is 'True'.
+    , fieldReference :: !ReferenceDef
+    , fieldCascade :: !FieldCascade
+    -- ^ Defines how operations on the field cascade on to the referenced
+    -- tables. This doesn't have any meaning if the 'fieldReference' is set
+    -- to 'NoReference' or 'SelfReference'. The cascade option here should
+    -- be the same as the one obtained in the 'fieldReference'.
+    --
+    -- @since 2.11.0
+    , fieldComments  :: !(Maybe Text)
+    -- ^ Optional comments for a 'Field'. There is not currently a way to
+    -- attach comments to a field in the quasiquoter.
+    --
+    -- @since 2.10.0
+    , fieldGenerated :: !(Maybe Text)
+    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
+    -- the expression to use for generation.
+    --
+    -- @since 2.11.0.0
+    }
+    deriving (Show, Eq, Read, Ord, Lift)
diff --git a/persistent/Database/Persist/Types/FieldDef.hs b/persistent/Database/Persist/Types/FieldDef.hs
deleted file mode 100644
index 2124d7d63..000000000
--- a/persistent/Database/Persist/Types/FieldDef.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Database.Persist.Types.FieldDef
-    (
-    ) where
-
-import Database.Persist.Types.FieldDef.Internal
-
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index b8b902b09..84c850c02 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -52,9 +52,7 @@ library
     exposed-modules: 
         Database.Persist
         Database.Persist.Types
-        Database.Persist.Types.Names
-        Database.Persist.Types.FieldDef
-        Database.Persist.Types.FieldDef.Internal
+        Database.Persist.Names
         Database.Persist.TH
 
         Database.Persist.Quasi

From 7a71f8770a1364a3da50bcc7cdc86cbe678809ff Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Wed, 21 Apr 2021 16:12:35 -0600
Subject: [PATCH 05/19] start enumerating types, make entitydef abstract

---
 persistent/ChangeLog.md                       |  7 ++++
 .../Database/Persist/Class/PersistUnique.hs   |  5 ++-
 persistent/Database/Persist/Quasi/Internal.hs |  2 +-
 persistent/Database/Persist/Sql/Internal.hs   |  5 +--
 persistent/Database/Persist/Sql/Util.hs       | 13 ++----
 persistent/Database/Persist/TH.hs             | 31 --------------
 persistent/Database/Persist/Types.hs          | 33 ++++++++++++++-
 persistent/Database/Persist/Types/Base.hs     | 40 ++++++++++++-------
 persistent/persistent.cabal                   |  2 +
 9 files changed, 75 insertions(+), 63 deletions(-)

diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md
index 6082996bd..618829e21 100644
--- a/persistent/ChangeLog.md
+++ b/persistent/ChangeLog.md
@@ -31,6 +31,13 @@
     * Previously hidden modules are now exposed under the `Internal` namespace.
     * The `connLimitOffset` function used to have a `Bool` parameter. This
       parameter is unused and has been removed.
+* []()
+    * Moved the various `Name` types into `Databse.Persist.Names`
+    * Removed the `hasCompositeKey` function. See `hasCompositePrimaryKey` and
+      `hasNaturalKey` as replacements.
+    * The `EntityDef` constructor and field labels are not exported by default.
+      Get those from `Database.Persist.EntityDef.Internal`, but you should
+      migrate to the getters/setters in `Database.Persist.EntityDef` as you can.
 
 ## 2.12.1.1
 
diff --git a/persistent/Database/Persist/Class/PersistUnique.hs b/persistent/Database/Persist/Class/PersistUnique.hs
index fb87c1657..f2597f12b 100644
--- a/persistent/Database/Persist/Class/PersistUnique.hs
+++ b/persistent/Database/Persist/Class/PersistUnique.hs
@@ -39,6 +39,7 @@ import GHC.TypeLits (ErrorMessage(..))
 import Database.Persist.Class.PersistEntity
 import Database.Persist.Class.PersistStore
 import Database.Persist.Types
+import Database.Persist.EntityDef
 
 -- | Queries against 'Unique' keys (other than the id 'Key').
 --
@@ -302,7 +303,7 @@ onlyOneUniqueDef
     => proxy record
     -> UniqueDef
 onlyOneUniqueDef prxy =
-    case entityUniques (entityDef prxy) of
+    case getEntityUniques (entityDef prxy) of
         [uniq] -> uniq
         _ -> error "impossible due to OnlyOneUniqueKey constraint"
 
@@ -351,7 +352,7 @@ atLeastOneUniqueDef
     => proxy record
     -> NonEmpty UniqueDef
 atLeastOneUniqueDef prxy =
-    case entityUniques (entityDef prxy) of
+    case getEntityUniques (entityDef prxy) of
         (x:xs) -> x :| xs
         _ ->
             error "impossible due to AtLeastOneUniqueKey record constraint"
diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index 98250f2d9..93034c1e7 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -48,7 +48,7 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import Database.Persist.Types
 import Text.Read (readEither)
-import Database.Persist.Names
+import Database.Persist.EntityDef.Internal
 
 data ParseState a = PSDone | PSFail String | PSSuccess a Text deriving Show
 
diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs
index 06c6ed92a..62273dd7a 100644
--- a/persistent/Database/Persist/Sql/Internal.hs
+++ b/persistent/Database/Persist/Sql/Internal.hs
@@ -131,8 +131,7 @@ mkColumns allDefs t overrides =
             }
 
     tableName :: EntityNameDB
-    tableName = entityDB t
-
+    tableName = getEntityDBName t
 
     go :: FieldDef -> Column
     go fd =
@@ -196,5 +195,5 @@ refName (EntityNameDB table) (FieldNameDB column) =
 resolveTableName :: [EntityDef] -> EntityNameHS -> EntityNameDB
 resolveTableName [] (EntityNameHS t) = error $ "Table not found: " `Data.Monoid.mappend` T.unpack t
 resolveTableName (e:es) hn
-    | entityHaskell e == hn = entityDB e
+    | getEntityHaskellName e == hn = getEntityDBName e
     | otherwise = resolveTableName es hn
diff --git a/persistent/Database/Persist/Sql/Util.hs b/persistent/Database/Persist/Sql/Util.hs
index 3643cae23..efe622c3d 100644
--- a/persistent/Database/Persist/Sql/Util.hs
+++ b/persistent/Database/Persist/Sql/Util.hs
@@ -4,9 +4,8 @@ module Database.Persist.Sql.Util
     , keyAndEntityColumnNames
     , entityColumnCount
     , isIdField
-    , hasCompositeKey
-    , hasCompositePrimaryKey
     , hasNaturalKey
+    , hasCompositePrimaryKey
     , dbIdColumns
     , dbIdColumnsEsc
     , dbColumns
@@ -39,7 +38,7 @@ import Database.Persist.SqlBackend.Internal(SqlBackend(..))
 
 entityColumnNames :: EntityDef -> SqlBackend -> [Sql]
 entityColumnNames ent conn =
-     (if hasCompositeKey ent
+     (if hasNaturalKey ent
       then [] else [connEscapeFieldName conn . fieldDB $ entityId ent])
   <> map (connEscapeFieldName conn . fieldDB) (entityFields ent)
 
@@ -48,13 +47,7 @@ keyAndEntityColumnNames ent conn = map (connEscapeFieldName conn . fieldDB) (key
 
 entityColumnCount :: EntityDef -> Int
 entityColumnCount e = length (entityFields e)
-                    + if hasCompositeKey e then 0 else 1
-
-{-# DEPRECATED hasCompositeKey "hasCompositeKey is misleading - it returns True if the entity is defined with the Primary keyword. See issue #685 for discussion. \n If you want the same behavior, use 'hasNaturalKey'. If you want to know if the key has multiple fields, use 'hasCompositePrimaryKey'. This function will be removed in the next major version." #-}
--- | Deprecated as of 2.11. See 'hasNaturalKey' or 'hasCompositePrimaryKey'
--- for replacements.
-hasCompositeKey :: EntityDef -> Bool
-hasCompositeKey = Maybe.isJust . entityPrimary
+                    + if hasNaturalKey e then 0 else 1
 
 -- | Returns 'True' if the entity has a natural key defined with the
 -- Primary keyword.
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 208596a3a..59f6eae55 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -1853,37 +1853,6 @@ isStrict = Bang NoSourceUnpackedness SourceStrict
 instanceD :: Cxt -> Type -> [Dec] -> Dec
 instanceD = InstanceD Nothing
 
--- entityUpdates :: EntityDef -> [(EntityNameHS, FieldType, IsNullable, PersistUpdate)]
--- entityUpdates =
---     concatMap go . entityFields
---   where
---     go FieldDef {..} = map (\a -> (fieldHaskell, fieldType, nullable fieldAttrs, a)) [minBound..maxBound]
-
--- mkToUpdate :: String -> [(String, PersistUpdate)] -> Q Dec
--- mkToUpdate name pairs = do
---     pairs' <- mapM go pairs
---     return $ FunD (mkName name) $ degen pairs'
---   where
---     go (constr, pu) = do
---         pu' <- lift pu
---         return $ normalClause [RecP (mkName constr) []] pu'
-
-
--- mkToFieldName :: String -> [(String, String)] -> Dec
--- mkToFieldName func pairs =
---         FunD (mkName func) $ degen $ map go pairs
---   where
---     go (constr, name) =
---         normalClause [RecP (mkName constr) []] (LitE $ StringL name)
-
--- mkToValue :: String -> [String] -> Dec
--- mkToValue func = FunD (mkName func) . degen . map go
---   where
---     go constr =
---         let x = mkName "x"
---          in normalClause [ConP (mkName constr) [VarP x]]
---                    (VarE 'toPersistValue `AppE` VarE x)
-
 -- | Check that all of Persistent's required extensions are enabled, or else fail compilation
 --
 -- This function should be called before any code that depends on one of the required extensions being enabled.
diff --git a/persistent/Database/Persist/Types.hs b/persistent/Database/Persist/Types.hs
index d681b7675..ebcee2289 100644
--- a/persistent/Database/Persist/Types.hs
+++ b/persistent/Database/Persist/Types.hs
@@ -1,6 +1,7 @@
 module Database.Persist.Types
     ( module Database.Persist.Types.Base
     , module Database.Persist.Names
+    , module Database.Persist.EntityDef
     , SomePersistField (..)
     , Update (..)
     , BackendSpecificUpdate
@@ -14,6 +15,36 @@ module Database.Persist.Types
     ) where
 
 import Database.Persist.Names
-import Database.Persist.Types.Base
 import Database.Persist.Class.PersistField
 import Database.Persist.Class.PersistEntity
+import Database.Persist.EntityDef
+
+-- this module is a bit of a kitchen sink of types and concepts. the guts of
+-- persistent, just strewn across the table. in 2.13 let's get this cleaned up
+-- and a bit more tidy.
+import Database.Persist.Types.Base
+    ( FieldCascade(..)
+    , ForeignDef(..)
+    , CascadeAction(..)
+    , FieldDef(..)
+    , UniqueDef(..)
+    , FieldAttr(..)
+    , IsNullable(..)
+    , WhyNullable(..)
+    , ExtraLine
+    , FieldType(..)
+    , PersistException(..)
+    , ForeignFieldDef
+    , Attr
+    , CompositeDef(..)
+    , SqlType(..)
+    , ReferenceDef(..)
+    , noCascade
+    , parseFieldAttrs
+    , keyAndEntityFields
+    , PersistException(..)
+    , UpdateException(..)
+    , PersistValue(..)
+    , PersistFilter(..)
+    , PersistUpdate(..)
+    )
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index 038ca156f..ce739eada 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -1,16 +1,17 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE LambdaCase, PatternSynonyms #-}
 {-# LANGUAGE DeriveLift #-}
-{-# OPTIONS_GHC -fno-warn-deprecations #-} -- usage of Error typeclass
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+
 module Database.Persist.Types.Base
     ( module Database.Persist.Types.Base
+    -- * Re-exports
     , PersistValue(.., PersistLiteral, PersistLiteralEscaped, PersistDbSpecific)
     , LiteralType(..)
     ) where
 
 import Control.Arrow (second)
 import Control.Exception (Exception)
-import Control.Monad.Trans.Error (Error (..))
 import qualified Data.Aeson as A
 import Data.Bits (shiftL, shiftR)
 import Data.ByteString (ByteString, foldl')
@@ -21,7 +22,7 @@ import Data.Char (isSpace)
 import qualified Data.HashMap.Strict as HM
 import Data.Int (Int64)
 import Data.Map (Map)
-import Data.Maybe ( isNothing )
+import Data.Maybe (isNothing)
 #if !MIN_VERSION_base(4,11,0)
 -- This can be removed when GHC < 8.2.2 isn't supported anymore
 import Data.Semigroup ((<>))
@@ -34,10 +35,17 @@ import Data.Text.Encoding.Error (lenientDecode)
 import Data.Time (Day, TimeOfDay, UTCTime)
 import qualified Data.Vector as V
 import Data.Word (Word32)
-import Numeric (showHex, readHex)
-import Web.PathPieces (PathPiece(..))
-import Web.HttpApiData (ToHttpApiData (..), FromHttpApiData (..), parseUrlPieceMaybe, showTextData, readTextData, parseBoundedTextData)
 import Language.Haskell.TH.Syntax (Lift(..))
+import Numeric (readHex, showHex)
+import Web.HttpApiData
+       ( FromHttpApiData(..)
+       , ToHttpApiData(..)
+       , parseBoundedTextData
+       , parseUrlPieceMaybe
+       , readTextData
+       , showTextData
+       )
+import Web.PathPieces (PathPiece(..))
     -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
     -- instance on pre-1.2.4 versions of `text`
 import Instances.TH.Lift ()
@@ -108,10 +116,10 @@ instance PathPiece Checkmark where
   fromPathPiece "inactive" = Just Inactive
   fromPathPiece _ = Nothing
 
-data IsNullable = Nullable !WhyNullable
-                | NotNullable
-                  deriving (Eq, Show)
-
+data IsNullable
+    = Nullable !WhyNullable
+    | NotNullable
+    deriving (Eq, Show)
 
 -- | The reason why a field is 'nullable' is very important.  A
 -- field that is nullable because of a @Maybe@ tag will have its
@@ -421,8 +429,6 @@ data PersistException
     deriving Show
 
 instance Exception PersistException
-instance Error PersistException where
-    strMsg = PersistError . pack
 
 -- | A raw value which can be stored in any backend and can be marshalled to
 -- and from a 'PersistField'.
@@ -486,6 +492,7 @@ data LiteralType
 -- 'PersistLiteral_' directly.
 --
 -- @since 2.12.0.0
+pattern PersistDbSpecific :: ByteString -> PersistValue
 pattern PersistDbSpecific bs <- PersistLiteral_ _ bs where
     PersistDbSpecific bs = PersistLiteral_ DbSpecific bs
 
@@ -495,6 +502,7 @@ pattern PersistDbSpecific bs <- PersistLiteral_ _ bs where
 -- 'PersistDbSpecific' for more details.
 --
 -- @since 2.12.0.0
+pattern PersistLiteralEscaped :: ByteString -> PersistValue
 pattern PersistLiteralEscaped bs <- PersistLiteral_ _ bs where
     PersistLiteralEscaped bs = PersistLiteral_ Escaped bs
 
@@ -504,6 +512,7 @@ pattern PersistLiteralEscaped bs <- PersistLiteral_ _ bs where
 -- 'PersistDbSpecific' for more details.
 --
 -- @since 2.12.0.0
+pattern PersistLiteral :: ByteString -> PersistValue
 pattern PersistLiteral bs <- PersistLiteral_ _ bs where
     PersistLiteral bs = PersistLiteral_ Unescaped bs
 
@@ -670,8 +679,9 @@ instance Show OnlyUniqueException where
 instance Exception OnlyUniqueException
 
 
-data PersistUpdate = Assign | Add | Subtract | Multiply | Divide
-                   | BackendSpecificUpdate T.Text
+data PersistUpdate
+    = Assign | Add | Subtract | Multiply | Divide
+    | BackendSpecificUpdate T.Text
     deriving (Read, Show, Lift)
 
 -- | A 'FieldDef' represents the inormation that @persistent@ knows about
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 84c850c02..8217246f9 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -53,6 +53,8 @@ library
         Database.Persist
         Database.Persist.Types
         Database.Persist.Names
+        Database.Persist.EntityDef
+        Database.Persist.EntityDef.Internal
         Database.Persist.TH
 
         Database.Persist.Quasi

From c6f8003f570b7f7ad9b95ff7115f8e1c5ec8a8be Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Wed, 21 Apr 2021 16:12:59 -0600
Subject: [PATCH 06/19] entity def abstraction

---
 persistent/Database/Persist/EntityDef.hs      | 50 +++++++++++++++++++
 .../Database/Persist/EntityDef/Internal.hs    | 15 ++++++
 2 files changed, 65 insertions(+)
 create mode 100644 persistent/Database/Persist/EntityDef.hs
 create mode 100644 persistent/Database/Persist/EntityDef/Internal.hs

diff --git a/persistent/Database/Persist/EntityDef.hs b/persistent/Database/Persist/EntityDef.hs
new file mode 100644
index 000000000..fb4a1e366
--- /dev/null
+++ b/persistent/Database/Persist/EntityDef.hs
@@ -0,0 +1,50 @@
+-- | An 'EntityDef' represents metadata about a type that @persistent@ uses to
+-- store the type in the database, as well as generate Haskell code from it.
+--
+-- @since 2.13.0.0
+module Database.Persist.EntityDef
+    ( -- * The 'EntityDef' type
+      EntityDef
+      -- * Construction
+      -- * Accessors
+    , getEntityUniques
+    , getEntityHaskellName
+    , getEntityDBName
+    , entitiesPrimary
+    , keyAndEntityFields
+     -- * Setters
+    ) where
+
+import Database.Persist.EntityDef.Internal
+
+import Database.Persist.Types.Base
+    ( UniqueDef
+    )
+import Database.Persist.Names
+
+-- | Retrieve the list of 'UniqueDef' from an 'EntityDef'. This currently does
+-- not include a @Primary@ key, if one is defined. A future version of
+-- @persistent@ will include a @Primary@ key among the 'Unique' constructors for
+-- the 'Entity'.
+--
+-- @since 2.13.0.0
+getEntityUniques
+    :: EntityDef
+    -> [UniqueDef]
+getEntityUniques = entityUniques
+
+-- | Retrieve the Haskell name of the given entity.
+--
+-- @since 2.13.0.0
+getEntityHaskellName
+    :: EntityDef
+    -> EntityNameHS
+getEntityHaskellName = entityHaskell
+
+-- | Return the database name for the given entity.
+--
+-- @since 2.13.0.0
+getEntityDBName
+    :: EntityDef
+    -> EntityNameDB
+getEntityDBName = entityDB
diff --git a/persistent/Database/Persist/EntityDef/Internal.hs b/persistent/Database/Persist/EntityDef/Internal.hs
new file mode 100644
index 000000000..b2cf7daef
--- /dev/null
+++ b/persistent/Database/Persist/EntityDef/Internal.hs
@@ -0,0 +1,15 @@
+-- | The 'EntityDef' type, fields, and constructor are exported from this
+-- module. Breaking changes to the 'EntityDef' type are not reflected in
+-- the major version of the API. Please import from
+-- "Database.Persist.EntityDef" instead.
+--
+-- If you need this module, please file a GitHub issue why.
+--
+-- @since 2.13.0.0
+module Database.Persist.EntityDef.Internal
+    ( EntityDef(..)
+    , entitiesPrimary
+    , keyAndEntityFields
+    ) where
+
+import Database.Persist.Types.Base

From 56cebd64ea72948160157002ca08e7182e0200f4 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Wed, 21 Apr 2021 17:27:11 -0600
Subject: [PATCH 07/19] teasing out the EntityDef stuff

---
 persistent/Database/Persist/EntityDef.hs      | 63 +++++++++++++++-
 .../Database/Persist/EntityDef/Internal.hs    |  1 +
 persistent/Database/Persist/Sql/Class.hs      | 10 +--
 persistent/Database/Persist/Sql/Internal.hs   |  8 +-
 .../Persist/Sql/Orphan/PersistQuery.hs        |  2 +-
 .../Persist/Sql/Orphan/PersistStore.hs        | 14 ++--
 persistent/Database/Persist/Sql/Util.hs       | 22 +++---
 persistent/Database/Persist/TH.hs             | 75 ++++++++++---------
 persistent/Database/Persist/Types.hs          |  3 +
 9 files changed, 133 insertions(+), 65 deletions(-)

diff --git a/persistent/Database/Persist/EntityDef.hs b/persistent/Database/Persist/EntityDef.hs
index fb4a1e366..c09714849 100644
--- a/persistent/Database/Persist/EntityDef.hs
+++ b/persistent/Database/Persist/EntityDef.hs
@@ -7,18 +7,28 @@ module Database.Persist.EntityDef
       EntityDef
       -- * Construction
       -- * Accessors
-    , getEntityUniques
     , getEntityHaskellName
     , getEntityDBName
+    , getEntityFields
+    , getEntityForeignDefs
+    , getEntityUniques
+    , getEntityId
+    , getEntityKeyFields
+    , isEntitySum
+    , entityPrimary
     , entitiesPrimary
     , keyAndEntityFields
      -- * Setters
+    , overEntityFields
     ) where
 
 import Database.Persist.EntityDef.Internal
 
 import Database.Persist.Types.Base
     ( UniqueDef
+    , ForeignDef
+    , FieldDef
+    , entityKeyFields
     )
 import Database.Persist.Names
 
@@ -48,3 +58,54 @@ getEntityDBName
     :: EntityDef
     -> EntityNameDB
 getEntityDBName = entityDB
+
+-- |
+--
+-- @since 2.13.0.0
+getEntityForeignDefs
+    :: EntityDef
+    -> [ForeignDef]
+getEntityForeignDefs = entityForeigns
+
+-- | Retrieve the list of 'FieldDef' that makes up the fields of the entity.
+--
+-- This does not return the fields for an @Id@ column or an implicit @id@. It
+-- will return the key columns if you used the @Primary@ syntax for defining the
+-- primary key.
+--
+-- @since 2.13.0.0
+getEntityFields
+    :: EntityDef
+    -> [FieldDef]
+getEntityFields = entityFields
+
+-- |
+--
+-- @since 2.13.0.0
+isEntitySum
+    :: EntityDef
+    -> Bool
+isEntitySum = entitySum
+
+-- |
+--
+-- @since 2.13.0.0
+getEntityId
+    :: EntityDef
+    -> FieldDef
+getEntityId = entityId
+
+getEntityKeyFields
+    :: EntityDef
+    -> [FieldDef]
+getEntityKeyFields = entityKeyFields
+
+setEntityFields :: [FieldDef] -> EntityDef -> EntityDef
+setEntityFields fd ed = ed { entityFields = fd }
+
+overEntityFields
+    :: ([FieldDef] -> [FieldDef])
+    -> EntityDef
+    -> EntityDef
+overEntityFields f ed =
+    setEntityFields (f (getEntityFields ed)) ed
diff --git a/persistent/Database/Persist/EntityDef/Internal.hs b/persistent/Database/Persist/EntityDef/Internal.hs
index b2cf7daef..1d6f11af1 100644
--- a/persistent/Database/Persist/EntityDef/Internal.hs
+++ b/persistent/Database/Persist/EntityDef/Internal.hs
@@ -8,6 +8,7 @@
 -- @since 2.13.0.0
 module Database.Persist.EntityDef.Internal
     ( EntityDef(..)
+    , entityPrimary
     , entitiesPrimary
     , keyAndEntityFields
     ) where
diff --git a/persistent/Database/Persist/Sql/Class.hs b/persistent/Database/Persist/Sql/Class.hs
index 9a4aa9a71..9b9044a9f 100644
--- a/persistent/Database/Persist/Sql/Class.hs
+++ b/persistent/Database/Persist/Sql/Class.hs
@@ -74,8 +74,8 @@ instance
               $ map fieldDB
               -- Hacky for a composite key because
               -- it selects the same field multiple times
-              $ entityKeyFields entDef ++ entityFields entDef
-          name = escapeWith escape (entityDB entDef)
+              $ getEntityKeyFields entDef ++ getEntityFields entDef
+          name = escapeWith escape (getEntityDBName entDef)
           entDef = entityDef (Nothing :: Maybe record)
     rawSqlColCountReason a =
         case fst (rawSqlCols (error "RawSql") a) of
@@ -85,7 +85,7 @@ instance
       (rowKey, rowVal) -> Entity <$> keyFromValues rowKey
                                  <*> fromPersistValues rowVal
       where
-        nKeyFields = length $ entityKeyFields entDef
+        nKeyFields = length $ getEntityKeyFields entDef
         entDef = entityDef (Nothing :: Maybe record)
 
 -- | This newtype wrapper is useful when selecting an entity out of the
@@ -156,7 +156,7 @@ instance
               $ map fieldDB
               -- Hacky for a composite key because
               -- it selects the same field multiple times
-              $ entityKeyFields entDef ++ entityFields entDef
+              $ getEntityKeyFields entDef ++ getEntityFields entDef
           name = pack $ symbolVal (Proxy :: Proxy prefix)
           entDef = entityDef (Nothing :: Maybe record)
     rawSqlColCountReason a =
@@ -167,7 +167,7 @@ instance
       (rowKey, rowVal) -> fmap EntityWithPrefix $ Entity <$> keyFromValues rowKey
                                  <*> fromPersistValues rowVal
       where
-        nKeyFields = length $ entityKeyFields entDef
+        nKeyFields = length $ getEntityKeyFields entDef
         entDef = entityDef (Nothing :: Maybe record)
 
 -- | @since 1.0.1
diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs
index 62273dd7a..15b6222ac 100644
--- a/persistent/Database/Persist/Sql/Internal.hs
+++ b/persistent/Database/Persist/Sql/Internal.hs
@@ -82,15 +82,15 @@ mkColumns
     -> BackendSpecificOverrides
     -> ([Column], [UniqueDef], [ForeignDef])
 mkColumns allDefs t overrides =
-    (cols, entityUniques t, entityForeigns t)
+    (cols, getEntityUniques t, getEntityForeignDefs t)
   where
     cols :: [Column]
-    cols = map goId idCol `mappend` map go (entityFields t)
+    cols = map goId idCol `mappend` map go (getEntityFields t)
 
     idCol :: [FieldDef]
     idCol = case entityPrimary t of
         Just _ -> []
-        Nothing -> [entityId t]
+        Nothing -> [getEntityId t]
 
     goId :: FieldDef -> Column
     goId fd =
@@ -137,7 +137,7 @@ mkColumns allDefs t overrides =
     go fd =
         Column
             { cName = fieldDB fd
-            , cNull = nullable (fieldAttrs fd) /= NotNullable || entitySum t
+            , cNull = nullable (fieldAttrs fd) /= NotNullable || isEntitySum t
             , cSqlType = fieldSqlType fd
             , cDefault = defaultAttribute $ fieldAttrs fd
             , cGenerated = fieldGenerated fd
diff --git a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs
index 24f6f8f9a..e88816eb3 100644
--- a/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs
+++ b/persistent/Database/Persist/Sql/Orphan/PersistQuery.hs
@@ -157,7 +157,7 @@ instance PersistQueryRead SqlBackend where
                            _ -> return xs
                       Just pdef ->
                            let pks = map fieldHaskell $ compositeFields pdef
-                               keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) xs
+                               keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ getEntityFields t) xs
                            in return keyvals
             case keyFromValues keyvals of
                 Right k -> return k
diff --git a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs
index 906e2972b..3a6cb03a9 100644
--- a/persistent/Database/Persist/Sql/Orphan/PersistStore.hs
+++ b/persistent/Database/Persist/Sql/Orphan/PersistStore.hs
@@ -19,7 +19,7 @@ module Database.Persist.Sql.Orphan.PersistStore
 import GHC.Generics (Generic)
 import Control.Exception (throwIO)
 import Control.Monad.IO.Class
-import Control.Monad.Trans.Reader (ReaderT, ask, withReaderT)
+import Control.Monad.Trans.Reader (ReaderT, ask)
 import Data.Acquire (with)
 import qualified Data.Aeson as A
 import Data.ByteString.Char8 (readInteger)
@@ -90,7 +90,7 @@ getTableName rec = withCompatibleBackend $ do
 
 -- | useful for a backend to implement tableName by adding escaping
 tableDBName :: (PersistEntity record) => record -> EntityNameDB
-tableDBName rec = entityDB $ entityDef (Just rec)
+tableDBName rec = getEntityDBName $ entityDef (Just rec)
 
 -- | get the SQL string for the field that an EntityField represents
 -- Useful for raw SQL queries
@@ -198,7 +198,7 @@ instance PersistStoreWrite SqlBackend where
                        Nothing -> error $ "ISRManyKeys is used when Primary is defined " ++ show sql
                        Just pdef ->
                             let pks = map fieldHaskell $ compositeFields pdef
-                                keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ entityFields t) fs
+                                keyvals = map snd $ filter (\(a, _) -> let ret=isJust (find (== a) pks) in ret) $ zip (map fieldHaskell $ getEntityFields t) fs
                             in  case keyFromValues keyvals of
                                     Right k -> return k
                                     Left e  -> error $ "ISRManyKeys: unexpected keyvals result: " `mappend` unpack e
@@ -225,7 +225,7 @@ instance PersistStoreWrite SqlBackend where
                     ent = entityDef vals
                     valss = map mkInsertValues vals
 
-    insertMany_ vals0 = runChunked (length $ entityFields t) insertMany_' vals0
+    insertMany_ vals0 = runChunked (length $ getEntityFields t) insertMany_' vals0
       where
         t = entityDef vals0
         insertMany_' vals = do
@@ -235,9 +235,9 @@ instance PersistStoreWrite SqlBackend where
                   [ "INSERT INTO "
                   , connEscapeTableName conn t
                   , "("
-                  , T.intercalate "," $ map (connEscapeFieldName conn . fieldDB) $ entityFields t
+                  , T.intercalate "," $ map (connEscapeFieldName conn . fieldDB) $ getEntityFields t
                   , ") VALUES ("
-                  , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (entityFields t)
+                  , T.intercalate "),(" $ replicate (length valss) $ T.intercalate "," $ map (const "?") (getEntityFields t)
                   , ")"
                   ]
           rawExecute sql (concat valss)
@@ -250,7 +250,7 @@ instance PersistStoreWrite SqlBackend where
                 [ "UPDATE "
                 , connEscapeTableName conn t
                 , " SET "
-                , T.intercalate "," (map (go conn . fieldDB) $ entityFields t)
+                , T.intercalate "," (map (go conn . fieldDB) $ getEntityFields t)
                 , " WHERE "
                 , wher
                 ]
diff --git a/persistent/Database/Persist/Sql/Util.hs b/persistent/Database/Persist/Sql/Util.hs
index efe622c3d..505ef4f64 100644
--- a/persistent/Database/Persist/Sql/Util.hs
+++ b/persistent/Database/Persist/Sql/Util.hs
@@ -27,8 +27,8 @@ import qualified Data.Text as T
 import Database.Persist (
     Entity(Entity), EntityDef, EntityField, FieldNameHS(FieldNameHS)
   , PersistEntity(..), PersistValue
-  , keyFromValues, fromPersistValues, fieldDB, entityId, entityPrimary
-  , entityFields, entityKeyFields, fieldHaskell, compositeFields, persistFieldDef
+  , keyFromValues, fromPersistValues, fieldDB, getEntityId, entityPrimary
+  , getEntityFields, getEntityKeyFields, fieldHaskell, compositeFields, persistFieldDef
   , keyAndEntityFields, toPersistValue, FieldNameDB, Update(..), PersistUpdate(..)
   , FieldDef(..)
   )
@@ -39,14 +39,14 @@ import Database.Persist.SqlBackend.Internal(SqlBackend(..))
 entityColumnNames :: EntityDef -> SqlBackend -> [Sql]
 entityColumnNames ent conn =
      (if hasNaturalKey ent
-      then [] else [connEscapeFieldName conn . fieldDB $ entityId ent])
-  <> map (connEscapeFieldName conn . fieldDB) (entityFields ent)
+      then [] else [connEscapeFieldName conn . fieldDB $ getEntityId ent])
+  <> map (connEscapeFieldName conn . fieldDB) (getEntityFields ent)
 
 keyAndEntityColumnNames :: EntityDef -> SqlBackend -> [Sql]
 keyAndEntityColumnNames ent conn = map (connEscapeFieldName conn . fieldDB) (keyAndEntityFields ent)
 
 entityColumnCount :: EntityDef -> Int
-entityColumnCount e = length (entityFields e)
+entityColumnCount e = length (getEntityFields e)
                     + if hasNaturalKey e then 0 else 1
 
 -- | Returns 'True' if the entity has a natural key defined with the
@@ -142,15 +142,15 @@ dbIdColumns :: SqlBackend -> EntityDef -> [Text]
 dbIdColumns conn = dbIdColumnsEsc (connEscapeFieldName conn)
 
 dbIdColumnsEsc :: (FieldNameDB -> Text) -> EntityDef -> [Text]
-dbIdColumnsEsc esc t = map (esc . fieldDB) $ entityKeyFields t
+dbIdColumnsEsc esc t = map (esc . fieldDB) $ getEntityKeyFields t
 
 dbColumns :: SqlBackend -> EntityDef -> [Text]
 dbColumns conn t = case entityPrimary t of
     Just _  -> flds
-    Nothing -> escapeColumn (entityId t) : flds
+    Nothing -> escapeColumn (getEntityId t) : flds
   where
     escapeColumn = connEscapeFieldName conn . fieldDB
-    flds = map escapeColumn (entityFields t)
+    flds = map escapeColumn (getEntityFields t)
 
 parseEntityValues :: PersistEntity record
                   => EntityDef -> [PersistValue] -> Either Text (Entity record)
@@ -159,7 +159,7 @@ parseEntityValues t vals =
       Just pdef ->
             let pks = map fieldHaskell $ compositeFields pdef
                 keyvals = map snd . filter ((`elem` pks) . fst)
-                        $ zip (map fieldHaskell $ entityFields t) vals
+                        $ zip (map fieldHaskell $ getEntityFields t) vals
             in fromPersistValuesComposite' keyvals vals
       Nothing -> fromPersistValues' vals
   where
@@ -230,7 +230,7 @@ mkInsertValues
     -> [PersistValue]
 mkInsertValues entity =
     Maybe.catMaybes
-        . zipWith redactGeneratedCol (entityFields . entityDef $ Just entity)
+        . zipWith redactGeneratedCol (getEntityFields . entityDef $ Just entity)
         . map toPersistValue
         $ toPersistFields entity
   where
@@ -252,7 +252,7 @@ mkInsertPlaceholders
     -- ^ An `escape` function
     -> [(Text, Text)]
 mkInsertPlaceholders ed escape =
-    Maybe.mapMaybe redactGeneratedCol (entityFields ed)
+    Maybe.mapMaybe redactGeneratedCol (getEntityFields ed)
   where
     redactGeneratedCol fd = case fieldGenerated fd of
         Nothing ->
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 59f6eae55..2b95f1079 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -114,6 +114,8 @@ import Database.Persist.Quasi
 import Database.Persist.Sql
        (Migration, PersistFieldSql, SqlBackend, migrate, sqlType)
 
+import Database.Persist.EntityDef.Internal (EntityDef(..))
+
 -- | Converts a quasi-quoted syntax into a list of entity definitions, to be
 -- used as input to the template haskell generation code (mkPersist).
 persistWith :: PersistSettings -> QuasiQuoter
@@ -213,16 +215,15 @@ embedEntityDefsMap rawEnts = (embedEntityMap, noCycleEnts)
     -- let Haskell tie the knot
     embedEntityMap = constructEmbedEntityMap entsWithEmbeds
     entsWithEmbeds = map setEmbedEntity rawEnts
-    setEmbedEntity ent = ent
-        { entityFields = map (setEmbedField (entityHaskell ent) embedEntityMap) $ entityFields ent
-        }
+    setEmbedEntity ent =
+        overEntityFields (setEmbedField (entityHaskell ent) embedEntityMap) ent
 
     -- self references are already broken
     -- look at every emFieldEmbed to see if it refers to an already seen EntityNameHS
     -- so start with entityHaskell ent and accumulate embeddedHaskell em
     breakCycleEnt entDef =
         let entName = entityHaskell entDef
-         in entDef { entityFields = map (breakCycleField entName) $ entityFields entDef }
+         in entDef { getEntityFields = map (breakCycleField entName) $ getEntityFields entDef }
 
     breakCycleField entName f = case f of
         FieldDef { fieldReference = EmbedRef em } ->
@@ -310,7 +311,7 @@ instance Lift FieldSqlTypeExp where
 
 instance Lift EntityDefSqlTypeExp where
     lift (EntityDefSqlTypeExp ent sqlTypeExp sqlTypeExps) =
-        [|ent { entityFields = $(lift $ FieldsSqlTypeExp (entityFields ent) sqlTypeExps)
+        [|ent { getEntityFields = $(lift $ FieldsSqlTypeExp (getEntityFields ent) sqlTypeExps)
               , entityId = $(lift $ FieldSqlTypeExp (entityId ent) sqlTypeExp)
               }
         |]
@@ -394,7 +395,7 @@ setEmbedField entName allEntities field = field
 
 mkEntityDefSqlTypeExp :: EmbedEntityMap -> EntityMap -> EntityDef -> EntityDefSqlTypeExp
 mkEntityDefSqlTypeExp emEntities entityMap ent =
-    EntityDefSqlTypeExp ent (getSqlType $ entityId ent) (map getSqlType $ entityFields ent)
+    EntityDefSqlTypeExp ent (getSqlType $ entityId ent) (map getSqlType $ getEntityFields ent)
   where
     getSqlType field =
         maybe
@@ -470,8 +471,8 @@ mkPersist mps ents' = do
 -- | Implement special preprocessing on EntityDef as necessary for 'mkPersist'.
 -- For example, strip out any fields marked as MigrationOnly.
 fixEntityDef :: EntityDef -> EntityDef
-fixEntityDef ed =
-    ed { entityFields = filter keepField $ entityFields ed }
+fixEntityDef =
+    overEntityFields (filter keepField)
   where
     keepField fd = FieldAttrMigrationOnly `notElem` fieldAttrs fd &&
                    FieldAttrSafeToRemove `notElem` fieldAttrs fd
@@ -626,14 +627,14 @@ dataTypeDec mps entDef = do
 
     cols :: [VarBangType]
     cols = do
-        fieldDef <- entityFields entDef
+        fieldDef <- getEntityFields entDef
         let recordName = fieldDefToRecordName mps entDef fieldDef
             strictness = if fieldStrict fieldDef then isStrict else notStrict
             fieldIdType = maybeIdType mps fieldDef Nothing Nothing
          in pure (recordName, strictness, fieldIdType)
 
     constrs
-        | entitySum entDef = map sumCon $ entityFields entDef
+        | entitySum entDef = map sumCon $ getEntityFields entDef
         | otherwise = [RecC (mkEntityDefName entDef) cols]
 
     sumCon fieldDef = NormalC
@@ -661,7 +662,7 @@ mkUnique mps entDef (UniqueDef constr _ fields attrs) =
     NormalC (mkConstraintName constr) types
   where
     types =
-      map (go . flip lookup3 (entityFields entDef) . unFieldNameHS . fst) fields
+      map (go . flip lookup3 (getEntityFields entDef) . unFieldNameHS . fst) fields
 
     force = "!force" `elem` attrs
 
@@ -728,7 +729,9 @@ degen [] =
 degen x = x
 
 mkToPersistFields :: MkPersistSettings -> EntityDef -> Q Dec
-mkToPersistFields mps ed@EntityDef { entitySum = isSum, entityFields = fields } = do
+mkToPersistFields mps ed = do
+    let isSum = isEntitySum ed
+        fields = getEntityFields ed
     clauses <-
         if isSum
             then sequence $ zipWith goSum fields [1..]
@@ -798,15 +801,13 @@ mapLeft _ (Right r) = Right r
 mapLeft f (Left l)  = Left (f l)
 
 mkFromPersistValues :: MkPersistSettings -> EntityDef -> Q [Clause]
-mkFromPersistValues _ entDef@(EntityDef { entitySum = False }) =
-    fromValues entDef "fromPersistValues" entE $ entityFields entDef
-  where
-    entE = entityDefConE entDef
-
-mkFromPersistValues mps entDef@(EntityDef { entitySum = True }) = do
-    nothing <- [|Left ("Invalid fromPersistValues input: sum type with all nulls. Entity: " `mappend` entName)|]
-    clauses <- mkClauses [] $ entityFields entDef
-    return $ clauses `mappend` [normalClause [WildP] nothing]
+mkFromPersistValues mps entDef
+    | isEntitySum entDef = do
+        nothing <- [|Left ("Invalid fromPersistValues input: sum type with all nulls. Entity: " `mappend` entName)|]
+        clauses <- mkClauses [] $ getEntityFields entDef
+        return $ clauses `mappend` [normalClause [WildP] nothing]
+    | otherwise =
+        fromValues entDef "fromPersistValues" entE $ getEntityFields entDef
   where
     entName = unEntityNameHS $ entityHaskell entDef
     mkClauses _ [] = return []
@@ -824,6 +825,8 @@ mkFromPersistValues mps entDef@(EntityDef { entitySum = True }) = do
         let clause = Clause [pat] (GuardedB [(guard', InfixE (Just constr) fmapE (Just fs))]) []
         clauses <- mkClauses (field : before) after
         return $ clause : clauses
+    entE = entityDefConE entDef
+
 
 type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
 
@@ -847,8 +850,8 @@ mkLensClauses mps entDef = do
             [ConP (keyIdName entDef) []]
             (lens' `AppE` getId `AppE` setId)
     if entitySum entDef
-        then return $ idClause : map (toSumClause lens' keyVar valName xName) (entityFields entDef)
-        else return $ idClause : map (toClause lens' getVal dot keyVar valName xName) (entityFields entDef)
+        then return $ idClause : map (toSumClause lens' keyVar valName xName) (getEntityFields entDef)
+        else return $ idClause : map (toClause lens' getVal dot keyVar valName xName) (getEntityFields entDef)
   where
     toClause lens' getVal dot keyVar valName xName fieldDef = normalClause
         [ConP (filterConName mps entDef fieldDef) []]
@@ -876,7 +879,7 @@ mkLensClauses mps entDef = do
 
             -- FIXME It would be nice if the types expressed that the Field is
             -- a sum type and therefore could result in Maybe.
-            : if length (entityFields entDef) > 1 then [emptyMatch] else []
+            : if length (getEntityFields entDef) > 1 then [emptyMatch] else []
         setter = LamE
             [ ConP 'Entity [VarP keyVar, WildP]
             , VarP xName
@@ -1118,7 +1121,7 @@ mkEntity entityMap mps entDef = do
     utv <- mkUniqueToValues $ entityUniques entDef
     puk <- mkUniqueKeys entDef
     let primaryField = entityId entDef
-    fields <- mapM (mkField mps entDef) $ primaryField : entityFields entDef
+    fields <- mapM (mkField mps entDef) $ primaryField : getEntityFields entDef
     fkc <- mapM (mkForeignKeysComposite mps entDef) $ entityForeigns entDef
 
     toFieldNames <- mkToFieldNames $ entityUniques entDef
@@ -1296,7 +1299,7 @@ entityText = unEntityNameHS . entityHaskell
 mkLenses :: MkPersistSettings -> EntityDef -> Q [Dec]
 mkLenses mps _ | not (mpsGenerateLenses mps) = return []
 mkLenses _ ent | entitySum ent = return []
-mkLenses mps ent = fmap mconcat $ forM (entityFields ent) $ \field -> do
+mkLenses mps ent = fmap mconcat $ forM (getEntityFields ent) $ \field -> do
     let lensName = mkName $ T.unpack $ recNameNoUnderscore mps (entityHaskell ent) (fieldHaskell field)
         fieldName = fieldDefToRecordName mps ent field
     needleN <- newName "needle"
@@ -1379,7 +1382,7 @@ maybeTyp may typ | may = ConT ''Maybe `AppT` typ
 entityToPersistValueHelper :: (PersistEntity record) => record -> PersistValue
 entityToPersistValueHelper entity = PersistMap $ zip columnNames fieldsAsPersistValues
     where
-        columnNames = map (unFieldNameHS . fieldHaskell) (entityFields (entityDef (Just entity)))
+        columnNames = map (unFieldNameHS . fieldHaskell) (getEntityFields (entityDef (Just entity)))
         fieldsAsPersistValues = map toPersistValue $ toPersistFields entity
 
 entityFromPersistValueHelper :: (PersistEntity record)
@@ -1422,7 +1425,7 @@ persistFieldFromEntity mps entDef = do
         ]
   where
     typ = genericDataType mps (entityHaskell entDef) backendT
-    entFields = entityFields entDef
+    entFields = getEntityFields entDef
     columnNames = map (unpack . unFieldNameHS . fieldHaskell) entFields
 
 -- | Apply the given list of functions to the same @EntityDef@s.
@@ -1457,7 +1460,7 @@ mkDeleteCascade mps defs = do
   where
     getDeps :: EntityDef -> [Dep]
     getDeps def =
-        concatMap getDeps' $ entityFields $ fixEntityDef def
+        concatMap getDeps' $ getEntityFields $ fixEntityDef def
       where
         getDeps' :: FieldDef -> [Dep]
         getDeps' field@FieldDef {..} =
@@ -1549,7 +1552,7 @@ mkUniqueKeys def = do
     return $ FunD 'persistUniqueKeys [c]
   where
     clause = do
-        xs <- forM (entityFields def) $ \fieldDef -> do
+        xs <- forM (getEntityFields def) $ \fieldDef -> do
             let x = fieldHaskell fieldDef
             x' <- newName $ '_' : unpack (unFieldNameHS x)
             return (x, x')
@@ -1694,7 +1697,7 @@ makePersistEntityDefExp mps entityMap entDef@EntityDef{..} =
         entityDB
         $(liftAndFixKey entityMap entityId)
         entityAttrs
-        $(fieldDefReferences mps entDef entityFields)
+        $(fieldDefReferences mps entDef getEntityFields)
         entityUniques
         entityForeigns
         entityDerives
@@ -1716,7 +1719,7 @@ liftAndFixKeys entityMap EntityDef{..} =
         entityDB
         $(liftAndFixKey entityMap entityId)
         entityAttrs
-        $(ListE <$> mapM (liftAndFixKey entityMap) entityFields)
+        $(ListE <$> mapM (liftAndFixKey entityMap) getEntityFields)
         entityUniques
         entityForeigns
         entityDerives
@@ -1792,7 +1795,7 @@ mkJSON mps def = do
     obj <- newName "obj"
     mzeroE <- [|mzero|]
 
-    xs <- mapM fieldToJSONValName (entityFields def)
+    xs <- mapM fieldToJSONValName (getEntityFields def)
 
     let conName = mkName $ unpack $ unEntityNameHS $ entityHaskell def
         typ = genericDataType mps (entityHaskell def) backendT
@@ -1800,7 +1803,7 @@ mkJSON mps def = do
         toJSON' = FunD 'toJSON $ return $ normalClause
             [ConP conName $ map VarP xs]
             (objectE `AppE` ListE pairs)
-        pairs = zipWith toPair (entityFields def) xs
+        pairs = zipWith toPair (getEntityFields def) xs
         toPair f x = InfixE
             (Just (packE `AppE` LitE (StringL $ unpack $ unFieldNameHS $ fieldHaskell f)))
             dotEqualE
@@ -1815,7 +1818,7 @@ mkJSON mps def = do
                 )
             , normalClause [WildP] mzeroE
             ]
-        pulls = map toPull $ entityFields def
+        pulls = map toPull $ getEntityFields def
         toPull f = InfixE
             (Just $ VarE obj)
             (if maybeNullable f then dotColonQE else dotColonE)
@@ -2033,7 +2036,7 @@ keyConName :: EntityDef -> Name
 keyConName entDef = mkName $ T.unpack $ resolveConflict $ keyText entDef
   where
     resolveConflict kn = if conflict then kn `mappend` "'" else kn
-    conflict = any ((== FieldNameHS "key") . fieldHaskell) $ entityFields entDef
+    conflict = any ((== FieldNameHS "key") . fieldHaskell) $ getEntityFields entDef
 
 keyConExp :: EntityDef -> Exp
 keyConExp = ConE . keyConName
diff --git a/persistent/Database/Persist/Types.hs b/persistent/Database/Persist/Types.hs
index ebcee2289..61a26d912 100644
--- a/persistent/Database/Persist/Types.hs
+++ b/persistent/Database/Persist/Types.hs
@@ -32,6 +32,7 @@ import Database.Persist.Types.Base
     , IsNullable(..)
     , WhyNullable(..)
     , ExtraLine
+    , Checkmark(..)
     , FieldType(..)
     , PersistException(..)
     , ForeignFieldDef
@@ -47,4 +48,6 @@ import Database.Persist.Types.Base
     , PersistValue(..)
     , PersistFilter(..)
     , PersistUpdate(..)
+    , EmbedEntityDef(..)
+    , EmbedFieldDef(..)
     )

From 7dbdf39c9ff91a9b23206160f297fe86fd431325 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Thu, 22 Apr 2021 21:42:01 -0600
Subject: [PATCH 08/19] builds

---
 .../Database/Persist/MongoDB.hs               |   9 +-
 persistent-mysql/Database/Persist/MySQL.hs    |  56 ++++-----
 .../Database/Persist/Postgresql.hs            |  64 +++++-----
 persistent-qq/test/PersistentTestModels.hs    |   2 +-
 .../Database/Persist/Redis/Internal.hs        |   1 +
 persistent-sqlite/Database/Persist/Sqlite.hs  |  40 +++---
 persistent-test/src/ForeignKey.hs             |   4 +-
 persistent-test/src/PersistentTest.hs         |   4 +-
 persistent-test/src/PersistentTestModels.hs   |   2 +-
 persistent-test/src/RenameTest.hs             |   4 +-
 persistent-test/src/TreeTest.hs               |   8 +-
 persistent/Database/Persist/EntityDef.hs      |  25 ++++
 .../Database/Persist/EntityDef/Internal.hs    |   1 +
 persistent/Database/Persist/FieldDef.hs       |  17 +++
 .../Database/Persist/FieldDef/Internal.hs     |  14 +++
 persistent/Database/Persist/Sql/Types.hs      |   1 -
 persistent/Database/Persist/TH.hs             | 118 ++++++++++++++----
 persistent/Database/Persist/Types.hs          |   3 +
 persistent/Database/Persist/Types/Base.hs     |   2 +-
 .../Persist/Types/FieldDef/Internal.hs        |  56 ---------
 persistent/persistent.cabal                   |   2 +
 .../TH/SharedPrimaryKeyImportedSpec.hs        |   4 +-
 .../Persist/TH/SharedPrimaryKeySpec.hs        |   4 +-
 persistent/test/Database/Persist/THSpec.hs    |   1 +
 persistent/test/main.hs                       |   1 +
 25 files changed, 262 insertions(+), 181 deletions(-)
 create mode 100644 persistent/Database/Persist/FieldDef.hs
 create mode 100644 persistent/Database/Persist/FieldDef/Internal.hs
 delete mode 100644 persistent/Database/Persist/Types/FieldDef/Internal.hs

diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs
index 25cb38b70..96ef4b3d6 100644
--- a/persistent-mongoDB/Database/Persist/MongoDB.hs
+++ b/persistent-mongoDB/Database/Persist/MongoDB.hs
@@ -156,6 +156,7 @@ import Database.MongoDB.Query (Database)
 
 import Database.Persist
 import qualified Database.Persist.Sql as Sql
+import Database.Persist.EntityDef.Internal (toEmbedEntityDef)
 
 instance HasPersistBackend DB.MongoContext where
     type BaseBackend DB.MongoContext = DB.MongoContext
@@ -448,13 +449,13 @@ entityToInsertDoc (Entity key record) = keyToMongoDoc key ++ toInsertDoc record
 
 collectionName :: (PersistEntity record, PersistEntityBackend record ~ DB.MongoContext)
                => record -> Text
-collectionName = unEntityNameDB . entityDB . entityDef . Just
+collectionName = unEntityNameDB . getEntityDBName . entityDef . Just
 
 -- | convert a PersistEntity into document fields.
 -- unlike 'toInsertDoc', nulls are included.
 recordToDocument :: (PersistEntity record, PersistEntityBackend record ~ DB.MongoContext)
                  => record -> DB.Document
-recordToDocument record = zipToDoc (map fieldDB $ entityFields entity) (toPersistFields record)
+recordToDocument record = zipToDoc (map fieldDB $ getEntityFields entity) (toPersistFields record)
   where
     entity = entityDef $ Just record
 
@@ -658,7 +659,7 @@ collectionNameFromKey = collectionName . recordTypeFromKey
 
 projectionFromEntityDef :: EntityDef -> DB.Projector
 projectionFromEntityDef eDef =
-  map toField (entityFields eDef)
+  map toField (getEntityFields eDef)
   where
     toField :: FieldDef -> DB.Field
     toField fDef = (unFieldNameDB (fieldDB fDef)) DB.=: (1 :: Int)
@@ -920,7 +921,7 @@ fromPersistValuesThrow :: (Trans.MonadIO m, PersistEntity record, PersistEntityB
 fromPersistValuesThrow entDef doc =
     case eitherFromPersistValues entDef doc of
         Left t -> Trans.liftIO . throwIO $ PersistMarshalError $
-                   unEntityNameHS (entityHaskell entDef) `mappend` ": " `mappend` t
+                   unEntityNameHS (getEntityHaskellName entDef) `mappend` ": " `mappend` t
         Right entity -> return entity
 
 mapLeft :: (a -> c) -> Either a b -> Either c b
diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs
index 5de7eaac2..244d1e762 100644
--- a/persistent-mysql/Database/Persist/MySQL.hs
+++ b/persistent-mysql/Database/Persist/MySQL.hs
@@ -141,7 +141,7 @@ open' ci logFunc = do
             , connCommit     = const $ MySQL.commit   conn
             , connRollback   = const $ MySQL.rollback conn
             , connEscapeFieldName = T.pack . escapeF
-            , connEscapeTableName = T.pack . escapeE . entityDB
+            , connEscapeTableName = T.pack . escapeE . getEntityDBName
             , connEscapeRawName = T.pack . escapeDBName . T.unpack
             , connNoLimit    = "LIMIT 18446744073709551615"
             -- This noLimit is suggested by MySQL's own docs, see
@@ -174,7 +174,7 @@ insertSql' ent vals =
     (fieldNames, placeholders) = unzip (Util.mkInsertPlaceholders ent escapeFT)
     sql = T.concat
         [ "INSERT INTO "
-        , escapeET $ entityDB ent
+        , escapeET $ getEntityDBName ent
         , "("
         , T.intercalate "," fieldNames
         , ") VALUES("
@@ -339,7 +339,7 @@ migrate' :: MySQL.ConnectInfo
          -> EntityDef
          -> IO (Either [Text] [(Bool, Text)])
 migrate' connectInfo allDefs getter val = do
-    let name = entityDB val
+    let name = getEntityDBName val
     let (newcols, udefs, fdefs) = mysqlMkColumns allDefs val
     old <- getColumns connectInfo getter val newcols
     let udspair = map udToPair udefs
@@ -360,7 +360,7 @@ migrate' connectInfo allDefs getter val = do
                     let refTarget =
                           addReference allDefs refConstraintName refTblName cname (crFieldCascade cRef)
 
-                    guard $ cname /= fieldDB (entityId val)
+                    guard $ cname /= fieldDB (getEntityId val)
                     return $ AlterColumn name refTarget
 
 
@@ -445,19 +445,19 @@ addTable cols entity = AddTable $ concat
            ]
     where
       nonIdCols =
-          filter (\c -> cName c /= fieldDB (entityId entity) ) cols
-      name = entityDB entity
+          filter (\c -> cName c /= fieldDB (getEntityId entity) ) cols
+      name = getEntityDBName entity
       idtxt = case entityPrimary entity of
                 Just pdef -> concat [" PRIMARY KEY (", intercalate "," $ map (escapeF . fieldDB) $ compositeFields pdef, ")"]
                 Nothing ->
-                  let defText = defaultAttribute $ fieldAttrs $ entityId entity
-                      sType = fieldSqlType $ entityId entity
+                  let defText = defaultAttribute $ fieldAttrs $ getEntityId entity
+                      sType = fieldSqlType $ getEntityId entity
                       autoIncrementText = case (sType, defText) of
                         (SqlInt64, Nothing) -> " AUTO_INCREMENT"
                         _ -> ""
-                      maxlen = findMaxLenOfField (entityId entity)
+                      maxlen = findMaxLenOfField (getEntityId entity)
                   in concat
-                         [ escapeF $ fieldDB $ entityId entity
+                         [ escapeF $ fieldDB $ getEntityId entity
                          , " " <> showSqlType sType maxlen False
                          , " NOT NULL"
                          , autoIncrementText
@@ -474,8 +474,8 @@ findTypeOfColumn allDefs name col =
         )
         ((,) col)
         $ do
-            entDef   <- find ((== name) . entityDB) allDefs
-            fieldDef <- find ((== col)  . fieldDB) (entityFields entDef)
+            entDef   <- find ((== name) . getEntityDBName) allDefs
+            fieldDef <- find ((== col)  . fieldDB) (getEntityFields entDef)
             return (fieldType fieldDef)
 
 -- | Find out the maxlen of a column (default to 200)
@@ -483,8 +483,8 @@ findMaxLenOfColumn :: [EntityDef] -> EntityNameDB -> FieldNameDB -> (FieldNameDB
 findMaxLenOfColumn allDefs name col =
    maybe (col, 200)
          ((,) col) $ do
-           entDef     <- find ((== name) . entityDB) allDefs
-           fieldDef   <- find ((== col) . fieldDB) (entityFields entDef)
+           entDef     <- find ((== name) . getEntityDBName) allDefs
+           fieldDef   <- find ((== col) . fieldDB) (getEntityFields entDef)
            findMaxLenOfField fieldDef
 
 -- | Find out the maxlen of a field
@@ -518,8 +518,8 @@ addReference allDefs fkeyname reftable cname fc =
             ++ " (allDefs = " ++ show allDefs ++ ")"
     referencedColumns =
         fromMaybe errorMessage $ do
-            entDef <- find ((== reftable) . entityDB) allDefs
-            return $ map fieldDB $ entityKeyFields entDef
+            entDef <- find ((== reftable) . getEntityDBName) allDefs
+            return $ map fieldDB $ getEntityKeyFields entDef
 
 data AlterColumn = Change Column
                  | Add' Column
@@ -607,15 +607,15 @@ getColumns connectInfo getter def cols = do
                 Nothing -> rs
                 (Just r) -> (unFieldNameDB $ cName c, r) : rs
     vals = [ PersistText $ pack $ MySQL.connectDatabase connectInfo
-           , PersistText $ unEntityNameDB $ entityDB def
-        --   , PersistText $ unDBName $ fieldDB $ entityId def
+           , PersistText $ unEntityNameDB $ getEntityDBName def
+        --   , PersistText $ unDBName $ fieldDB $ getEntityId def
            ]
 
     helperClmns = CL.mapM getIt .| CL.consume
         where
           getIt row = fmap (either Left (Right . Left)) .
                       liftIO .
-                      getColumn connectInfo getter (entityDB def) row $ ref
+                      getColumn connectInfo getter (getEntityDBName def) row $ ref
             where ref = case row of
                     (PersistText cname : _) -> (Map.lookup cname refMap)
                     _ -> Nothing
@@ -823,7 +823,7 @@ getAlters
 getAlters allDefs edef (c1, u1) (c2, u2) =
     (getAltersC c1 c2, getAltersU u1 u2)
   where
-    tblName = entityDB edef
+    tblName = getEntityDBName edef
     getAltersC [] old = concatMap dropColumn old
     getAltersC (new:news) old =
         let (alters, old') = findAlters edef allDefs new old
@@ -886,8 +886,8 @@ findAlters edef allDefs col@(Column name isNull type_ def gen _defConstraintName
                 refAdd  =
                     case (ref == ref', ref) of
                         (False, Just ColumnReference {crTableName=tname, crConstraintName=cname, crFieldCascade = cfc })
-                            | tname /= entityDB edef
-                            , unConstraintNameDB cname /= unFieldNameDB (fieldDB (entityId edef))
+                            | tname /= getEntityDBName edef
+                            , unConstraintNameDB cname /= unFieldNameDB (fieldDB (getEntityId edef))
                             ->
                             [addReference allDefs cname tname name cfc]
                         _ -> []
@@ -1197,7 +1197,7 @@ mockMigrate :: MySQL.ConnectInfo
          -> EntityDef
          -> IO (Either [Text] [(Bool, Text)])
 mockMigrate _connectInfo allDefs _getter val = do
-    let name = entityDB val
+    let name = getEntityDBName val
     let (newcols, udefs, fdefs) = mysqlMkColumns allDefs val
     let udspair = map udToPair udefs
     case () of
@@ -1259,7 +1259,7 @@ mockMigration mig = do
                 , connCommit = undefined
                 , connRollback = undefined
                 , connEscapeFieldName = T.pack . escapeDBName . T.unpack . unFieldNameDB
-                , connEscapeTableName = T.pack . escapeDBName . T.unpack . unEntityNameDB . entityDB
+                , connEscapeTableName = T.pack . escapeDBName . T.unpack . unEntityNameDB . getEntityDBName
                 , connEscapeRawName = T.pack . escapeDBName . T.unpack
                 , connNoLimit = undefined
                 , connRDBMS = undefined
@@ -1459,8 +1459,8 @@ 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 (entityFields entityDef')
-    tableName = T.pack . escapeE . entityDB $ entityDef'
+    entityFieldNames = map fieldDbToText (getEntityFields entityDef')
+    tableName = T.pack . escapeE . getEntityDBName $ entityDef'
     copyUnlessValues = map snd fieldsToMaybeCopy
     recordValues = concatMap (map toPersistValue . toPersistFields) records
     recordPlaceholders = Util.commaSeparated $ map (Util.parenWrapped . Util.commaSeparated . map (const "?") . toPersistFields) records
@@ -1496,7 +1496,7 @@ mkBulkInsertQuery records fieldValues updates =
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' fields ent n
   where
-    fields = entityFields ent
+    fields = getEntityFields ent
 
 repsertManySql :: EntityDef -> Int -> Text
 repsertManySql ent n = putManySql' fields ent n
@@ -1509,7 +1509,7 @@ putManySql' (filter isFieldNotGenerated -> fields) ent n = q
     fieldDbToText = (T.pack . escapeF) . fieldDB
     mkAssignment f = T.concat [f, "=VALUES(", f, ")"]
 
-    table = (T.pack . escapeE) . entityDB $ ent
+    table = (T.pack . escapeE) . getEntityDBName $ ent
     columns = Util.commaSeparated $ map fieldDbToText fields
     placeholders = map (const "?") fields
     updates = map (mkAssignment . fieldDbToText) fields
diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs
index 6313b6802..e783a1234 100644
--- a/persistent-postgresql/Database/Persist/Postgresql.hs
+++ b/persistent-postgresql/Database/Persist/Postgresql.hs
@@ -370,7 +370,7 @@ createBackend logFunc serverVersion smap conn =
         , connCommit     = const $ PG.commit   conn
         , connRollback   = const $ PG.rollback conn
         , connEscapeFieldName = escapeF
-        , connEscapeTableName = escapeE . entityDB
+        , connEscapeTableName = escapeE . getEntityDBName
         , connEscapeRawName = escape
         , connNoLimit    = "LIMIT ALL"
         , connRDBMS      = "postgresql"
@@ -392,13 +392,13 @@ insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult
 insertSql' ent vals =
     case entityPrimary ent of
         Just _pdef -> ISRManyKeys sql vals
-        Nothing -> ISRSingle (sql <> " RETURNING " <> escapeF (fieldDB (entityId ent)))
+        Nothing -> ISRSingle (sql <> " RETURNING " <> escapeF (fieldDB (getEntityId ent)))
   where
     (fieldNames, placeholders) = unzip (Util.mkInsertPlaceholders ent escapeF)
     sql = T.concat
         [ "INSERT INTO "
-        , escapeE $ entityDB ent
-        , if null (entityFields ent)
+        , escapeE $ getEntityDBName ent
+        , if null (getEntityFields ent)
             then " DEFAULT VALUES"
             else T.concat
                 [ "("
@@ -413,7 +413,7 @@ upsertSql' :: EntityDef -> NonEmpty (FieldNameHS, FieldNameDB) -> Text -> Text
 upsertSql' ent uniqs updateVal =
     T.concat
         [ "INSERT INTO "
-        , escapeE (entityDB ent)
+        , escapeE (getEntityDBName ent)
         , "("
         , T.intercalate "," fieldNames
         , ") VALUES ("
@@ -432,7 +432,7 @@ upsertSql' ent uniqs updateVal =
     wher = T.intercalate " AND " $ map (singleClause . snd) $ NEL.toList uniqs
 
     singleClause :: FieldNameDB -> Text
-    singleClause field = escapeE (entityDB ent) <> "." <> (escapeF field) <> " =?"
+    singleClause field = escapeE (getEntityDBName ent) <> "." <> (escapeF field) <> " =?"
 
 -- | SQL for inserting multiple rows at once and returning their primary keys.
 insertManySql' :: EntityDef -> [[PersistValue]] -> InsertSqlResult
@@ -442,7 +442,7 @@ insertManySql' ent valss =
     (fieldNames, placeholders)= unzip (Util.mkInsertPlaceholders ent escapeF)
     sql = T.concat
         [ "INSERT INTO "
-        , escapeE (entityDB ent)
+        , escapeE (getEntityDBName ent)
         , "("
         , T.intercalate "," fieldNames
         , ") VALUES ("
@@ -789,7 +789,7 @@ migrate' allDefs getter entity = fmap (fmap $ map showAlterDb) $ do
             return $ Right $ migrationText exists' old''
         (errs, _) -> return $ Left errs
   where
-    name = entityDB entity
+    name = getEntityDBName entity
     (newcols', udefs, fdefs) = postgresMkColumns allDefs entity
     migrationText exists' old''
         | not exists' =
@@ -827,7 +827,7 @@ mkForeignAlt
     -> Maybe AlterDB
 mkForeignAlt entity fdef = pure $ AlterColumn tableName_ addReference
   where
-    tableName_ = entityDB entity
+    tableName_ = getEntityDBName entity
     addReference =
         AddReference
             (foreignRefTableDBName fdef)
@@ -860,10 +860,10 @@ addTable cols entity =
             Just _ ->
                 cols
             _ ->
-                filter (\c -> cName c /= fieldDB (entityId entity) ) cols
+                filter (\c -> cName c /= fieldDB (getEntityId entity) ) cols
 
     name =
-        entityDB entity
+        getEntityDBName entity
     idtxt =
         case entityPrimary entity of
             Just pdef ->
@@ -873,10 +873,10 @@ addTable cols entity =
                     , ")"
                     ]
             Nothing ->
-                let defText = defaultAttribute $ fieldAttrs $ entityId entity
-                    sType = fieldSqlType $ entityId entity
+                let defText = defaultAttribute $ fieldAttrs $ getEntityId entity
+                    sType = fieldSqlType $ getEntityId entity
                 in  T.concat
-                        [ escapeF $ fieldDB (entityId entity)
+                        [ escapeF $ fieldDB (getEntityId entity)
                         , maySerial sType defText
                         , " PRIMARY KEY UNIQUE"
                         , mayDefault defText
@@ -947,7 +947,7 @@ getColumns getter def cols = do
 
     stmt <- getter sqlv
     let vals =
-            [ PersistText $ unEntityNameDB $ entityDB def
+            [ PersistText $ unEntityNameDB $ getEntityDBName def
             ]
     columns <- with (stmtQuery stmt vals) (\src -> runConduit $ src .| processColumns .| CL.consume)
     let sqlc = T.concat
@@ -994,7 +994,7 @@ getColumns getter def cols = do
                $ groupBy ((==) `on` fst) rows
     processColumns =
         CL.mapM $ \x'@((PersistText cname) : _) -> do
-            col <- liftIO $ getColumn getter (entityDB def) x' (Map.lookup cname refMap)
+            col <- liftIO $ getColumn getter (getEntityDBName def) x' (Map.lookup cname refMap)
             pure $ case col of
                 Left e -> Left e
                 Right c -> Right $ Left c
@@ -1248,12 +1248,12 @@ findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName
 
                 refAdd Nothing = []
                 refAdd (Just colRef) =
-                    case find ((== crTableName colRef) . entityDB) defs of
+                    case find ((== crTableName colRef) . getEntityDBName) defs of
                         Just refdef
-                            | _oldName /= fieldDB (entityId edef)
+                            | _oldName /= fieldDB (getEntityId edef)
                             ->
                             [AddReference
-                                (entityDB edef)
+                                (getEntityDBName edef)
                                 (crConstraintName colRef)
                                 [name]
                                 (Util.dbIdColumnsEsc escapeF refdef)
@@ -1269,7 +1269,7 @@ findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName
                         else refDrop ref' ++ refAdd ref
                 modNull = case (isNull, isNull') of
                             (True, False) ->  do
-                                guard $ name /= fieldDB (entityId edef)
+                                guard $ name /= fieldDB (getEntityId edef)
                                 pure (IsNull col)
                             (False, True) ->
                                 let up = case def of
@@ -1328,18 +1328,18 @@ getAddReference
     -> ColumnReference
     -> Maybe AlterDB
 getAddReference allDefs entity cname cr@ColumnReference {crTableName = s, crConstraintName=constraintName} = do
-    guard $ cname /= fieldDB (entityId entity)
+    guard $ cname /= fieldDB (getEntityId entity)
     pure $ AlterColumn
         table
         (AddReference s constraintName [cname] id_ (crFieldCascade cr)
         )
   where
-    table = entityDB entity
+    table = getEntityDBName entity
     id_ =
         fromMaybe
             (error $ "Could not find ID of entity " ++ show s)
             $ do
-                entDef <- find ((== s) . entityDB) allDefs
+                entDef <- find ((== s) . getEntityDBName) allDefs
                 return $ Util.dbIdColumnsEsc escapeF entDef
 
 showColumn :: Column -> Text
@@ -1672,7 +1672,7 @@ mockMigrate allDefs _ entity = fmap (fmap $ map showAlterDb) $ do
         ([], old'') -> return $ Right $ migrationText False old''
         (errs, _) -> return $ Left errs
   where
-    name = entityDB entity
+    name = getEntityDBName entity
     migrationText exists' old'' =
         if not exists'
             then createText newcols fdefs udspair
@@ -1724,7 +1724,7 @@ mockMigration mig = do
                 , connCommit = undefined
                 , connRollback = undefined
                 , connEscapeFieldName = escapeF
-                , connEscapeTableName = escapeE . entityDB
+                , connEscapeTableName = escapeE . getEntityDBName
                 , connEscapeRawName = escape
                 , connNoLimit = undefined
                 , connRDBMS = undefined
@@ -1738,14 +1738,14 @@ mockMigration mig = do
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns fields ent n
   where
-    fields = entityFields ent
-    conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (entityUniques ent)
+    fields = getEntityFields ent
+    conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (getEntityUniques ent)
 
 repsertManySql :: EntityDef -> Int -> Text
 repsertManySql ent n = putManySql' conflictColumns fields ent n
   where
     fields = keyAndEntityFields ent
-    conflictColumns = escapeF . fieldDB <$> entityKeyFields ent
+    conflictColumns = escapeF . fieldDB <$> getEntityKeyFields ent
 
 -- | This type is used to determine how to update rows using Postgres'
 -- @INSERT ... ON CONFLICT KEY UPDATE@ functionality, exposed via
@@ -1858,7 +1858,7 @@ upsertManyWhere [] _ _ _ = return ()
 upsertManyWhere records fieldValues updates filters = do
     conn <- asks projectBackend
     let uniqDef = -- onlyOneUniqueDef (Nothing :: Maybe record)
-            case entityUniques (entityDef (Nothing :: Maybe record)) of
+            case getEntityUniques (entityDef (Nothing :: Maybe record)) of
                 [uniq] -> uniq
                 _ -> error "impossible due to OnlyOneUniqueKey constraint"
             -- TODO: use onlyOneUniqueDef when it's exported
@@ -1928,8 +1928,8 @@ 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 (entityFields entityDef')
-    nameOfTable = escapeE . entityDB $ entityDef'
+    entityFieldNames = map fieldDbToText (getEntityFields entityDef')
+    nameOfTable = escapeE . getEntityDBName $ entityDef'
     copyUnlessValues = map snd fieldsToMaybeCopy
     recordValues = concatMap (map toPersistValue . toPersistFields) records
     recordPlaceholders =
@@ -1991,7 +1991,7 @@ putManySql' conflictColumns (filter isFieldNotGenerated -> fields) ent n = q
     fieldDbToText = escapeF . fieldDB
     mkAssignment f = T.concat [f, "=EXCLUDED.", f]
 
-    table = escapeE . entityDB $ ent
+    table = escapeE . getEntityDBName $ ent
     columns = Util.commaSeparated $ map fieldDbToText fields
     placeholders = map (const "?") fields
     updates = map (mkAssignment . fieldDbToText) fields
diff --git a/persistent-qq/test/PersistentTestModels.hs b/persistent-qq/test/PersistentTestModels.hs
index 30216c6a2..db6af42c9 100644
--- a/persistent-qq/test/PersistentTestModels.hs
+++ b/persistent-qq/test/PersistentTestModels.hs
@@ -144,7 +144,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
 
     entityDef = revFields . entityDef . unRfoProxy
       where
-        revFields ed = ed { entityFields = reverse (entityFields ed) }
+        revFields = overEntityFields reverse
         unRfoProxy :: proxy (ReverseFieldOrder a) -> Proxy a
         unRfoProxy _ = Proxy
 
diff --git a/persistent-redis/Database/Persist/Redis/Internal.hs b/persistent-redis/Database/Persist/Redis/Internal.hs
index ce0c83c1e..8f4ab66d4 100644
--- a/persistent-redis/Database/Persist/Redis/Internal.hs
+++ b/persistent-redis/Database/Persist/Redis/Internal.hs
@@ -14,6 +14,7 @@ import Data.Text (Text, unpack)
 import qualified Data.Text as T
 import Control.Monad.Fail (MonadFail)
 
+import Database.Persist.EntityDef.Internal
 import Database.Persist.Class
 import Database.Persist.Types
 import Database.Persist.Redis.Parser
diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs
index 5b636f541..0e4d58867 100644
--- a/persistent-sqlite/Database/Persist/Sqlite.hs
+++ b/persistent-sqlite/Database/Persist/Sqlite.hs
@@ -282,7 +282,7 @@ wrapConnectionInfo connInfo conn logFunc = do
             , connCommit = helper "COMMIT"
             , connRollback = ignoreExceptions . helper "ROLLBACK"
             , connEscapeFieldName = escape . unFieldNameDB
-            , connEscapeTableName = escape . unEntityNameDB . entityDB
+            , connEscapeTableName = escape . unEntityNameDB . getEntityDBName
             , connEscapeRawName = escape
             , connNoLimit = "LIMIT -1"
             , connRDBMS = "sqlite"
@@ -341,7 +341,7 @@ insertSql' ent vals =
           ISRManyKeys sql vals
             where sql = T.concat
                     [ "INSERT INTO "
-                    , escapeE $ entityDB ent
+                    , escapeE $ getEntityDBName ent
                     , "("
                     , T.intercalate "," $ map (escapeF . fieldDB) cols
                     , ") VALUES("
@@ -353,14 +353,14 @@ insertSql' ent vals =
             where
               sel = T.concat
                   [ "SELECT "
-                  , escapeF $ fieldDB (entityId ent)
+                  , escapeF $ fieldDB (getEntityId ent)
                   , " FROM "
-                  , escapeE $ entityDB ent
+                  , escapeE $ getEntityDBName ent
                   , " WHERE _ROWID_=last_insert_rowid()"
                   ]
               ins = T.concat
                   [ "INSERT INTO "
-                  , escapeE $ entityDB ent
+                  , escapeE $ getEntityDBName ent
                   , if null cols
                         then " VALUES(null)"
                         else T.concat
@@ -375,7 +375,7 @@ insertSql' ent vals =
     notGenerated =
         isNothing . fieldGenerated
     cols =
-        filter notGenerated $ entityFields ent
+        filter notGenerated $ getEntityFields ent
 
 execute' :: Sqlite.Connection -> Sqlite.Statement -> [PersistValue] -> IO Int64
 execute' conn stmt vals = flip finally (liftIO $ Sqlite.reset conn stmt) $ do
@@ -441,7 +441,7 @@ migrate' allDefs getter val = do
                     return $ Right sql
   where
     def = val
-    table = entityDB def
+    table = getEntityDBName def
     go = do
         x <- CL.head
         case x of
@@ -473,7 +473,7 @@ mockMigration mig = do
                 , connCommit = helper "COMMIT"
                 , connRollback = ignoreExceptions . helper "ROLLBACK"
                 , connEscapeFieldName = escape . unFieldNameDB
-                , connEscapeTableName = escape . unEntityNameDB . entityDB
+                , connEscapeTableName = escape . unEntityNameDB . getEntityDBName
                 , connEscapeRawName = escape
                 , connNoLimit = "LIMIT -1"
                 , connRDBMS = "sqlite"
@@ -497,7 +497,7 @@ safeToRemove :: EntityDef -> FieldNameDB -> Bool
 safeToRemove def (FieldNameDB colName)
     = any (elem FieldAttrSafeToRemove . fieldAttrs)
     $ filter ((== FieldNameDB colName) . fieldDB)
-    $ entityFields def
+    $ getEntityFields def
 
 getCopyTable :: [EntityDef]
              -> (Text -> IO Statement)
@@ -525,12 +525,12 @@ getCopyTable allDefs getter def = do
                 names <- getCols
                 return $ name : names
             Just y -> error $ "Invalid result from PRAGMA table_info: " ++ show y
-    table = entityDB def
+    table = getEntityDBName def
     tableTmp = EntityNameDB $ unEntityNameDB table <> "_backup"
     (cols, uniqs, fdef) = sqliteMkColumns allDefs def
     cols' = filter (not . safeToRemove def . cName) cols
     newSql = mkCreateTable False def (cols', uniqs, fdef)
-    tmpSql = mkCreateTable True def { entityDB = tableTmp } (cols', uniqs, [])
+    tmpSql = mkCreateTable True (setEntityDBName tableTmp def) (cols', uniqs, [])
     dropTmp = "DROP TABLE " <> escapeE tableTmp
     dropOld = "DROP TABLE " <> escapeE table
     copyToTemp common = T.concat
@@ -560,7 +560,7 @@ mkCreateTable isTemp entity (cols, uniqs, fdefs) =
         [ "CREATE"
         , if isTemp then " TEMP" else ""
         , " TABLE "
-        , escapeE $ entityDB entity
+        , escapeE $ getEntityDBName entity
         , "("
         ]
 
@@ -580,15 +580,15 @@ mkCreateTable isTemp entity (cols, uniqs, fdefs) =
             ]
 
         Nothing ->
-            [ escapeF $ fieldDB (entityId entity)
+            [ escapeF $ fieldDB (getEntityId entity)
             , " "
-            , showSqlType $ fieldSqlType $ entityId entity
+            , showSqlType $ fieldSqlType $ getEntityId entity
             , " PRIMARY KEY"
-            , mayDefault $ defaultAttribute $ fieldAttrs $ entityId entity
+            , mayDefault $ defaultAttribute $ fieldAttrs $ getEntityId entity
             , T.concat $ map (sqlColumn isTemp) nonIdCols
             ]
 
-    nonIdCols = filter (\c -> cName c /= fieldDB (entityId entity)) cols
+    nonIdCols = filter (\c -> cName c /= fieldDB (getEntityId entity)) cols
 
 mayDefault :: Maybe Text -> Text
 mayDefault def = case def of
@@ -674,14 +674,14 @@ escape s =
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns fields ent n
   where
-    fields = entityFields ent
-    conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (entityUniques ent)
+    fields = getEntityFields ent
+    conflictColumns = concatMap (map (escapeF . snd) . uniqueFields) (getEntityUniques ent)
 
 repsertManySql :: EntityDef -> Int -> Text
 repsertManySql ent n = putManySql' conflictColumns fields ent n
   where
     fields = keyAndEntityFields ent
-    conflictColumns = escapeF . fieldDB <$> entityKeyFields ent
+    conflictColumns = escapeF . fieldDB <$> getEntityKeyFields ent
 
 putManySql' :: [Text] -> [FieldDef] -> EntityDef -> Int -> Text
 putManySql' conflictColumns fields ent n = q
@@ -689,7 +689,7 @@ putManySql' conflictColumns fields ent n = q
     fieldDbToText = escapeF . fieldDB
     mkAssignment f = T.concat [f, "=EXCLUDED.", f]
 
-    table = escapeE . entityDB $ ent
+    table = escapeE . getEntityDBName $ ent
     columns = Util.commaSeparated $ map fieldDbToText fields
     placeholders = map (const "?") fields
     updates = map (mkAssignment . fieldDbToText) fields
diff --git a/persistent-test/src/ForeignKey.hs b/persistent-test/src/ForeignKey.hs
index 863661478..fa1250604 100644
--- a/persistent-test/src/ForeignKey.hs
+++ b/persistent-test/src/ForeignKey.hs
@@ -8,6 +8,8 @@ import Data.Proxy
 import qualified Data.List as List
 import Init
 
+import Database.Persist.EntityDef.Internal (entityExtra)
+
 -- mpsGeneric = False is due to a bug or at least lack of a feature in mkKeyTypeDec TH.hs
 share [mkPersist persistSettings { mpsGeneric = False }, mkMigrate "compositeMigrate"] [persistLowerCase|
 SimpleCascadeChild
@@ -204,7 +206,7 @@ specsWith runDb = describe "foreign keys options" $ do
                 , fcOnDelete = Just Cascade
                 }
             Just refField =
-                List.find isRefCol (entityFields ed)
+                List.find isRefCol (getEntityFields ed)
 
         it "parses into fieldCascade"  $ do
             fieldCascade refField `shouldBe` expected
diff --git a/persistent-test/src/PersistentTest.hs b/persistent-test/src/PersistentTest.hs
index 09833ea8c..93553b7fc 100644
--- a/persistent-test/src/PersistentTest.hs
+++ b/persistent-test/src/PersistentTest.hs
@@ -632,11 +632,11 @@ specsWith runDb = describe "persistent" $ do
   describe "documentation syntax" $ do
     let edef = entityDef (Proxy :: Proxy Relationship)
     it "provides comments on entity def" $ do
-      entityComments edef
+      getEntityComments edef
         `shouldBe`
           Just "This is a doc comment for a relationship.\nYou need to put the pipe character for each line of documentation.\nBut you can resume the doc comments afterwards.\n"
     it "provides comments on the field" $ do
-      let [nameField, _] = entityFields edef
+      let [nameField, _] = getEntityFields edef
       fieldComments nameField
         `shouldBe`
           Just "Fields should be documentable.\n"
diff --git a/persistent-test/src/PersistentTestModels.hs b/persistent-test/src/PersistentTestModels.hs
index ee9c340fa..80d698f3a 100644
--- a/persistent-test/src/PersistentTestModels.hs
+++ b/persistent-test/src/PersistentTestModels.hs
@@ -225,7 +225,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
       where
         unRfoProxy :: proxy (ReverseFieldOrder a) -> Proxy a
         unRfoProxy _ = Proxy
-        revFields ed = ed { entityFields = reverse (entityFields ed) }
+        revFields = overEntityFields reverse
 
     toPersistFields = reverse . toPersistFields . unRFO
     newtype EntityField (ReverseFieldOrder a) b = EFRFO {unEFRFO :: EntityField a b}
diff --git a/persistent-test/src/RenameTest.hs b/persistent-test/src/RenameTest.hs
index 5491b8aa3..9e2a35443 100644
--- a/persistent-test/src/RenameTest.hs
+++ b/persistent-test/src/RenameTest.hs
@@ -75,7 +75,7 @@ specsWith
 specsWith runDb = describe "rename specs" $ do
     describe "LowerCaseTable" $ do
         it "LowerCaseTable has the right sql name" $ do
-            fieldDB (entityId (entityDef (Proxy @LowerCaseTable)))
+            fieldDB (getEntityId (entityDef (Proxy @LowerCaseTable)))
                 `shouldBe`
                     FieldNameDB "my_id"
 
@@ -92,7 +92,7 @@ specsWith runDb = describe "rename specs" $ do
         key' @== key
 
     it "extra blocks" $
-        entityExtra (entityDef (Nothing :: Maybe LowerCaseTable)) @?=
+        getEntityExtra (entityDef (Nothing :: Maybe LowerCaseTable)) @?=
             Map.fromList
                 [ ("ExtraBlock", map T.words ["foo bar", "baz", "bin"])
                 , ("ExtraBlock2", map T.words ["something"])
diff --git a/persistent-test/src/TreeTest.hs b/persistent-test/src/TreeTest.hs
index 226468ccd..e97119c67 100644
--- a/persistent-test/src/TreeTest.hs
+++ b/persistent-test/src/TreeTest.hs
@@ -41,14 +41,14 @@ specsWith runDb = describe "tree" $ do
         gp <- getJust kgp
         treeFkparent gp @== Nothing
     describe "entityDef" $ do
-        let EntityDef{..} = entityDef (Proxy :: Proxy Tree)
+        let ed = entityDef (Proxy :: Proxy Tree)
         it "has the right haskell name" $ do
-            entityHaskell `shouldBe` EntityNameHS "Tree"
+            getEntityHaskellName ed `shouldBe` EntityNameHS "Tree"
         it "has the right DB name" $ do
-            entityDB `shouldBe` EntityNameDB "trees"
+            getEntityDBName ed `shouldBe` EntityNameDB "trees"
 
     describe "foreign ref" $ do
-        let [ForeignDef{..}] = entityForeigns (entityDef (Proxy :: Proxy Tree))
+        let [ForeignDef{..}] = getEntityForeignDefs (entityDef (Proxy :: Proxy Tree))
         it "has the right haskell name" $ do
             foreignRefTableHaskell `shouldBe`
                 EntityNameHS "Tree"
diff --git a/persistent/Database/Persist/EntityDef.hs b/persistent/Database/Persist/EntityDef.hs
index c09714849..1d80d9592 100644
--- a/persistent/Database/Persist/EntityDef.hs
+++ b/persistent/Database/Persist/EntityDef.hs
@@ -14,14 +14,21 @@ module Database.Persist.EntityDef
     , getEntityUniques
     , getEntityId
     , getEntityKeyFields
+    , getEntityComments
+    , getEntityExtra
     , isEntitySum
     , entityPrimary
     , entitiesPrimary
     , keyAndEntityFields
      -- * Setters
+    , setEntityId
+    , setEntityDBName
     , overEntityFields
     ) where
 
+import Data.Text (Text)
+import Data.Map (Map)
+
 import Database.Persist.EntityDef.Internal
 
 import Database.Persist.Types.Base
@@ -59,6 +66,18 @@ getEntityDBName
     -> EntityNameDB
 getEntityDBName = entityDB
 
+getEntityExtra :: EntityDef -> Map Text [[Text]]
+getEntityExtra = entityExtra
+
+-- |
+--
+-- @since 2.13.0.0
+setEntityDBName :: EntityNameDB -> EntityDef -> EntityDef
+setEntityDBName db ed = ed { entityDB = db }
+
+getEntityComments :: EntityDef -> Maybe Text
+getEntityComments = entityComments
+
 -- |
 --
 -- @since 2.13.0.0
@@ -95,6 +114,12 @@ getEntityId
     -> FieldDef
 getEntityId = entityId
 
+setEntityId
+    :: FieldDef
+    -> EntityDef
+    -> EntityDef
+setEntityId fd ed = ed { entityId = fd }
+
 getEntityKeyFields
     :: EntityDef
     -> [FieldDef]
diff --git a/persistent/Database/Persist/EntityDef/Internal.hs b/persistent/Database/Persist/EntityDef/Internal.hs
index 1d6f11af1..38af021bc 100644
--- a/persistent/Database/Persist/EntityDef/Internal.hs
+++ b/persistent/Database/Persist/EntityDef/Internal.hs
@@ -11,6 +11,7 @@ module Database.Persist.EntityDef.Internal
     , entityPrimary
     , entitiesPrimary
     , keyAndEntityFields
+    , toEmbedEntityDef
     ) where
 
 import Database.Persist.Types.Base
diff --git a/persistent/Database/Persist/FieldDef.hs b/persistent/Database/Persist/FieldDef.hs
new file mode 100644
index 000000000..d06d4ef0d
--- /dev/null
+++ b/persistent/Database/Persist/FieldDef.hs
@@ -0,0 +1,17 @@
+-- |
+--
+-- @since 2.13.0.0
+module Database.Persist.FieldDef
+    ( -- * The 'FieldDef' type
+      FieldDef
+      -- ** Helpers
+    , isFieldNotGenerated
+      -- * 'FieldCascade'
+    , FieldCascade(..)
+    , renderFieldCascade
+    , renderCascadeAction
+    , noCascade
+    , CascadeAction(..)
+    ) where
+
+import Database.Persist.FieldDef.Internal
diff --git a/persistent/Database/Persist/FieldDef/Internal.hs b/persistent/Database/Persist/FieldDef/Internal.hs
new file mode 100644
index 000000000..433806d37
--- /dev/null
+++ b/persistent/Database/Persist/FieldDef/Internal.hs
@@ -0,0 +1,14 @@
+-- | TODO: standard Internal moduel boilerplate
+--
+-- @since 2.13.0.0
+module Database.Persist.FieldDef.Internal
+    ( FieldDef(..)
+    , isFieldNotGenerated
+    , FieldCascade(..)
+    , renderFieldCascade
+    , renderCascadeAction
+    , noCascade
+    , CascadeAction(..)
+    ) where
+
+import Database.Persist.Types.Base
diff --git a/persistent/Database/Persist/Sql/Types.hs b/persistent/Database/Persist/Sql/Types.hs
index d21b75505..8df81a30f 100644
--- a/persistent/Database/Persist/Sql/Types.hs
+++ b/persistent/Database/Persist/Sql/Types.hs
@@ -21,7 +21,6 @@ import Data.Text (Text, unpack)
 import Data.Time (NominalDiffTime)
 import Database.Persist.Sql.Types.Internal
 import Database.Persist.Types
-import Database.Persist.Names
 
 data Column = Column
     { cName      :: !FieldNameDB
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 2b95f1079..40629da7c 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -17,8 +17,6 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 
--- {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-fields #-}
-
 -- | This module provides the tools for defining your database schema and using
 -- it to generate Haskell data types and migrations.
 module Database.Persist.TH
@@ -114,6 +112,7 @@ import Database.Persist.Quasi
 import Database.Persist.Sql
        (Migration, PersistFieldSql, SqlBackend, migrate, sqlType)
 
+import Database.Persist.Types.Base (toEmbedEntityDef)
 import Database.Persist.EntityDef.Internal (EntityDef(..))
 
 -- | Converts a quasi-quoted syntax into a list of entity definitions, to be
@@ -216,14 +215,16 @@ embedEntityDefsMap rawEnts = (embedEntityMap, noCycleEnts)
     embedEntityMap = constructEmbedEntityMap entsWithEmbeds
     entsWithEmbeds = map setEmbedEntity rawEnts
     setEmbedEntity ent =
-        overEntityFields (setEmbedField (entityHaskell ent) embedEntityMap) ent
+        overEntityFields
+            (map (setEmbedField (entityHaskell ent) embedEntityMap))
+            ent
 
     -- self references are already broken
     -- look at every emFieldEmbed to see if it refers to an already seen EntityNameHS
     -- so start with entityHaskell ent and accumulate embeddedHaskell em
     breakCycleEnt entDef =
-        let entName = entityHaskell entDef
-         in entDef { getEntityFields = map (breakCycleField entName) $ getEntityFields entDef }
+        let entName = getEntityHaskellName entDef
+         in overEntityFields (map (breakCycleField entName)) entDef
 
     breakCycleField entName f = case f of
         FieldDef { fieldReference = EmbedRef em } ->
@@ -311,7 +312,7 @@ instance Lift FieldSqlTypeExp where
 
 instance Lift EntityDefSqlTypeExp where
     lift (EntityDefSqlTypeExp ent sqlTypeExp sqlTypeExps) =
-        [|ent { getEntityFields = $(lift $ FieldsSqlTypeExp (getEntityFields ent) sqlTypeExps)
+        [|ent { entityFields = $(lift $ FieldsSqlTypeExp (getEntityFields ent) sqlTypeExps)
               , entityId = $(lift $ FieldSqlTypeExp (entityId ent) sqlTypeExp)
               }
         |]
@@ -465,9 +466,29 @@ mkPersist mps ents' = do
         , symbolToFieldInstances
         ]
   where
-    ents = map fixEntityDef ents'
+    ents = map (fixEntityDef . setDefaultIdFields mps) ents'
     entityMap = constructEntityMap ents
 
+setDefaultIdFields :: MkPersistSettings -> EntityDef -> EntityDef
+setDefaultIdFields mps ed =
+    case mpsImplicitIdSpec mps of
+        Nothing ->
+            ed
+        Just iis
+            | defaultIdType ed ->
+                setEntityId (setToMpsDefault iis (getEntityId ed)) ed
+            | otherwise ->
+                ed
+  where
+    setToMpsDefault :: ImplicitIdSpec -> FieldDef -> FieldDef
+    setToMpsDefault iis fd =
+        fd
+            { fieldType =
+                iisFieldType iis (getEntityHaskellName ed)
+            , fieldSqlType =
+                iisFieldSqlType iis
+            }
+
 -- | Implement special preprocessing on EntityDef as necessary for 'mkPersist'.
 -- For example, strip out any fields marked as MigrationOnly.
 fixEntityDef :: EntityDef -> EntityDef
@@ -480,11 +501,22 @@ fixEntityDef =
 -- | Settings to be passed to the 'mkPersist' function.
 data MkPersistSettings = MkPersistSettings
     { mpsBackend :: Type
-    -- ^ Which database backend we\'re using.
+    -- ^ Which database backend we\'re using. This type is used for the
+    -- 'PersistEntityBackend' associated type in the entities that are
+    -- generated.
+    --
+    -- If the 'mpsGeneric' value is set to 'True', then this type is used for
+    -- the non-Generic type alias. The data and type will be named:
     --
-    -- When generating data types, each type is given a generic version- which
-    -- works with any backend- and a type synonym for the commonly used
-    -- backend. This is where you specify that commonly used backend.
+    -- @
+    -- data ModelGeneric backend = Model { ... }
+    -- @
+    --
+    -- And, for convenience's sake, we provide a type alias:
+    --
+    -- @
+    -- type Model = ModelGeneric $(the type you give here)
+    -- @
     , mpsGeneric :: Bool
     -- ^ Create generic types that can be used with multiple backends. Good for
     -- reusable code, but makes error messages harder to understand. Default:
@@ -492,47 +524,83 @@ data MkPersistSettings = MkPersistSettings
     , mpsPrefixFields :: Bool
     -- ^ Prefix field names with the model name. Default: True.
     --
-    -- Note: this field is deprecated. Use the mpsFieldLabelModifier  and mpsConstraintLabelModifier instead.
+    -- Note: this field is deprecated. Use the mpsFieldLabelModifier  and
+    -- 'mpsConstraintLabelModifier' instead.
     , mpsFieldLabelModifier :: Text -> Text -> Text
-    -- ^ Customise the field accessors and lens names using the entity and field name.
-    -- Both arguments are upper cased.
+    -- ^ Customise the field accessors and lens names using the entity and field
+    -- name.  Both arguments are upper cased.
     --
     -- Default: appends entity and field.
     --
     -- Note: this setting is ignored if mpsPrefixFields is set to False.
+    --
     -- @since 2.11.0.0
     , mpsConstraintLabelModifier :: Text -> Text -> Text
-    -- ^ Customise the Constraint names using the entity and field name. The result
-    -- should be a valid haskell type (start with an upper cased letter).
+    -- ^ Customise the Constraint names using the entity and field name. The
+    -- result should be a valid haskell type (start with an upper cased letter).
     --
     -- Default: appends entity and field
     --
     -- Note: this setting is ignored if mpsPrefixFields is set to False.
+    --
     -- @since 2.11.0.0
     , mpsEntityJSON :: Maybe EntityJSON
     -- ^ Generate @ToJSON@/@FromJSON@ instances for each model types. If it's
     -- @Nothing@, no instances will be generated. Default:
     --
     -- @
-    --  Just EntityJSON
-    --      { entityToJSON = 'entityIdToJSON
-    --      , entityFromJSON = 'entityIdFromJSON
+    --  Just 'EntityJSON'
+    --      { 'entityToJSON' = 'entityIdToJSON
+    --      , 'entityFromJSON' = 'entityIdFromJSON
     --      }
     -- @
     , mpsGenerateLenses :: !Bool
-    -- ^ Instead of generating normal field accessors, generator lens-style accessors.
+    -- ^ Instead of generating normal field accessors, generator lens-style
+    -- accessors.
     --
     -- Default: False
     --
     -- @since 1.3.1
     , mpsDeriveInstances :: ![Name]
-    -- ^ Automatically derive these typeclass instances for all record and key types.
+    -- ^ Automatically derive these typeclass instances for all record and key
+    -- types.
     --
     -- Default: []
     --
     -- @since 2.8.1
+    , mpsImplicitIdSpec :: !(Maybe ImplicitIdSpec)
+    }
+
+-- |
+--
+-- @since 2.13.0.0
+data ImplicitIdSpec = ImplicitIdSpec
+    { iisFieldType :: EntityNameHS -> FieldType
+    , iisFieldSqlType :: SqlType
+    , iisType :: MkPersistSettings -> Type
     }
 
+getImplicitIdType :: MkPersistSettings -> Maybe Type
+getImplicitIdType mps =
+    (\x -> iisType x mps ) <$> mpsImplicitIdSpec mps
+
+-- |
+--
+-- @since 2.13.0.0
+autoIncrementingInteger :: ImplicitIdSpec
+autoIncrementingInteger =
+    ImplicitIdSpec
+        { iisFieldType = \entName ->
+            FTTypeCon Nothing $ unEntityNameHS entName `mappend` "Id"
+        , iisFieldSqlType =
+            SqlInt64
+        , iisType = \mps ->
+            ConT ''BackendKey `AppT`
+                if mpsGeneric mps
+                then backendT
+                else mpsBackend mps
+        }
+
 data EntityJSON = EntityJSON
     { entityToJSON :: Name
     -- ^ Name of the @toJSON@ implementation for @Entity a@.
@@ -556,6 +624,8 @@ mkPersistSettings backend = MkPersistSettings
         }
     , mpsGenerateLenses = False
     , mpsDeriveInstances = []
+    , mpsImplicitIdSpec =
+        Just autoIncrementingInteger
     }
 
 -- | Use the 'SqlPersist' backend.
@@ -747,7 +817,7 @@ mkToPersistFields mps ed = do
         let bod = ListE $ map (AppE sp . VarE) xs
         return $ normalClause [pat] bod
 
-    fieldCount = length fields
+    fieldCount = length (getEntityFields ed)
 
     goSum :: FieldDef -> Int -> Q Clause
     goSum fieldDef idx = do
@@ -1697,7 +1767,7 @@ makePersistEntityDefExp mps entityMap entDef@EntityDef{..} =
         entityDB
         $(liftAndFixKey entityMap entityId)
         entityAttrs
-        $(fieldDefReferences mps entDef getEntityFields)
+        $(fieldDefReferences mps entDef entityFields)
         entityUniques
         entityForeigns
         entityDerives
@@ -1719,7 +1789,7 @@ liftAndFixKeys entityMap EntityDef{..} =
         entityDB
         $(liftAndFixKey entityMap entityId)
         entityAttrs
-        $(ListE <$> mapM (liftAndFixKey entityMap) getEntityFields)
+        $(ListE <$> mapM (liftAndFixKey entityMap) entityFields)
         entityUniques
         entityForeigns
         entityDerives
diff --git a/persistent/Database/Persist/Types.hs b/persistent/Database/Persist/Types.hs
index 61a26d912..173d327e8 100644
--- a/persistent/Database/Persist/Types.hs
+++ b/persistent/Database/Persist/Types.hs
@@ -2,6 +2,7 @@ module Database.Persist.Types
     ( module Database.Persist.Types.Base
     , module Database.Persist.Names
     , module Database.Persist.EntityDef
+    , module Database.Persist.FieldDef
     , SomePersistField (..)
     , Update (..)
     , BackendSpecificUpdate
@@ -18,6 +19,7 @@ import Database.Persist.Names
 import Database.Persist.Class.PersistField
 import Database.Persist.Class.PersistEntity
 import Database.Persist.EntityDef
+import Database.Persist.FieldDef
 
 -- this module is a bit of a kitchen sink of types and concepts. the guts of
 -- persistent, just strewn across the table. in 2.13 let's get this cleaned up
@@ -50,4 +52,5 @@ import Database.Persist.Types.Base
     , PersistUpdate(..)
     , EmbedEntityDef(..)
     , EmbedFieldDef(..)
+    , LiteralType(..)
     )
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index ce739eada..1ca52c622 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -28,7 +28,7 @@ import Data.Maybe (isNothing)
 import Data.Semigroup ((<>))
 #endif
 import qualified Data.Scientific
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import Data.Text.Encoding.Error (lenientDecode)
diff --git a/persistent/Database/Persist/Types/FieldDef/Internal.hs b/persistent/Database/Persist/Types/FieldDef/Internal.hs
deleted file mode 100644
index a121f88c1..000000000
--- a/persistent/Database/Persist/Types/FieldDef/Internal.hs
+++ /dev/null
@@ -1,56 +0,0 @@
--- |  This module contains internal definitions for the 'FieldDef' type.
--- Breaking changes to the interface of this module will not be represented
--- as a breaking change in the version of the code. Please depend on
--- "Database.Persist.Types.FieldDef" instead. If you need this module,
--- please file an issue on GitHub.
---
--- @since 2.13.0.0
-module Database.Persist.Types.FieldDef.Internal where
-
-import Database.Persist.Types.Names
-import Language.Haskell.TH.Syntax (Lift)
-import Data.Text (Text)
-
--- | A 'FieldDef' represents the inormation that @persistent@ knows about
--- a field of a datatype. This includes information used to parse the field
--- out of the database and what the field corresponds to.
-data FieldDef = FieldDef
-    { fieldHaskell   :: !FieldNameHS
-    -- ^ The name of the field. Note that this does not corresponds to the
-    -- record labels generated for the particular entity - record labels
-    -- are generated with the type name prefixed to the field, so
-    -- a 'FieldDef' that contains a @'FieldNameHS' "name"@ for a type
-    -- @User@ will have a record field @userName@.
-    , fieldDB        :: !FieldNameDB
-    -- ^ The name of the field in the database. For SQL databases, this
-    -- corresponds to the column name.
-    , fieldType      :: !FieldType
-    -- ^ The type of the field in Haskell.
-    , fieldSqlType   :: !SqlType
-    -- ^ The type of the field in a SQL database.
-    , fieldAttrs     :: ![FieldAttr]
-    -- ^ User annotations for a field. These are provided with the @!@
-    -- operator.
-    , fieldStrict    :: !Bool
-    -- ^ If this is 'True', then the Haskell datatype will have a strict
-    -- record field. The default value for this is 'True'.
-    , fieldReference :: !ReferenceDef
-    , fieldCascade :: !FieldCascade
-    -- ^ Defines how operations on the field cascade on to the referenced
-    -- tables. This doesn't have any meaning if the 'fieldReference' is set
-    -- to 'NoReference' or 'SelfReference'. The cascade option here should
-    -- be the same as the one obtained in the 'fieldReference'.
-    --
-    -- @since 2.11.0
-    , fieldComments  :: !(Maybe Text)
-    -- ^ Optional comments for a 'Field'. There is not currently a way to
-    -- attach comments to a field in the quasiquoter.
-    --
-    -- @since 2.10.0
-    , fieldGenerated :: !(Maybe Text)
-    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
-    -- the expression to use for generation.
-    --
-    -- @since 2.11.0.0
-    }
-    deriving (Show, Eq, Read, Ord, Lift)
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 8217246f9..395fa4cdc 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -55,6 +55,8 @@ library
         Database.Persist.Names
         Database.Persist.EntityDef
         Database.Persist.EntityDef.Internal
+        Database.Persist.FieldDef
+        Database.Persist.FieldDef.Internal
         Database.Persist.TH
 
         Database.Persist.Quasi
diff --git a/persistent/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs b/persistent/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs
index 436ff3620..e3aa2e7eb 100644
--- a/persistent/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs
+++ b/persistent/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs
@@ -44,11 +44,11 @@ spec = describe "Shared Primary Keys Imported" $ do
                 `shouldBe`
                     sqlType (Proxy @ProfileId)
 
-    describe "entityId FieldDef" $ do
+    describe "getEntityId FieldDef" $ do
         it "should match underlying primary key" $ do
             let getSqlType :: PersistEntity a => Proxy a -> SqlType
                 getSqlType =
-                    fieldSqlType . entityId . entityDef
+                    fieldSqlType . getEntityId . entityDef
             getSqlType (Proxy @User)
                 `shouldBe`
                     getSqlType (Proxy @Profile)
diff --git a/persistent/test/Database/Persist/TH/SharedPrimaryKeySpec.hs b/persistent/test/Database/Persist/TH/SharedPrimaryKeySpec.hs
index 6fcd39b1f..c65e7e199 100644
--- a/persistent/test/Database/Persist/TH/SharedPrimaryKeySpec.hs
+++ b/persistent/test/Database/Persist/TH/SharedPrimaryKeySpec.hs
@@ -47,11 +47,11 @@ spec = describe "Shared Primary Keys" $ do
                 `shouldBe`
                     sqlType (Proxy @ProfileId)
 
-    describe "entityId FieldDef" $ do
+    describe "getEntityId FieldDef" $ do
         it "should match underlying primary key" $ do
             let getSqlType :: PersistEntity a => Proxy a -> SqlType
                 getSqlType =
-                    fieldSqlType . entityId . entityDef
+                    fieldSqlType . getEntityId . entityDef
             getSqlType (Proxy @User)
                 `shouldBe`
                     getSqlType (Proxy @Profile)
diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs
index 2e3c3ba09..79d3df11f 100644
--- a/persistent/test/Database/Persist/THSpec.hs
+++ b/persistent/test/Database/Persist/THSpec.hs
@@ -41,6 +41,7 @@ import Database.Persist.Sql
 import Database.Persist.Sql.Util
 import Database.Persist.TH
 import TemplateTestImports
+import Database.Persist.EntityDef.Internal
 
 import qualified Database.Persist.TH.SharedPrimaryKeySpec as SharedPrimaryKeySpec
 import qualified Database.Persist.TH.SharedPrimaryKeyImportedSpec as SharedPrimaryKeyImportedSpec
diff --git a/persistent/test/main.hs b/persistent/test/main.hs
index 01329e177..e40cd06b6 100644
--- a/persistent/test/main.hs
+++ b/persistent/test/main.hs
@@ -24,6 +24,7 @@ import qualified Data.ByteString.Char8 as BS8
 import Database.Persist.Class.PersistField
 import Database.Persist.Quasi.Internal
 import Database.Persist.Types
+import Database.Persist.EntityDef.Internal
 
 import qualified Database.Persist.THSpec as THSpec
 

From 731799d811572d2fa8bef97e95a17a39bf00ce30 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 14:55:06 -0600
Subject: [PATCH 09/19] testinggg

---
 .../persistent-postgresql.cabal               |   1 +
 .../test/ImplicitUuidSpec.hs                  |  65 ++++++++++
 persistent-postgresql/test/PgInit.hs          |  33 ++++-
 persistent-postgresql/test/main.hs            |   2 +
 persistent/Database/Persist/ImplicitIdDef.hs  |  42 +++++++
 .../Persist/ImplicitIdDef/Internal.hs         | 107 ++++++++++++++++
 persistent/Database/Persist/Quasi/Internal.hs |  14 +--
 persistent/Database/Persist/TH.hs             | 114 +++++++++---------
 persistent/Database/Persist/Types/Base.hs     |  11 +-
 persistent/persistent.cabal                   |  12 +-
 .../Persist/TH/OverloadedLabelSpec.hs         |   4 +-
 persistent/test/Database/Persist/THSpec.hs    |   2 +
 persistent/test/TemplateTestImports.hs        |   7 +-
 stack.yaml                                    |   3 +
 14 files changed, 335 insertions(+), 82 deletions(-)
 create mode 100644 persistent-postgresql/test/ImplicitUuidSpec.hs
 create mode 100644 persistent/Database/Persist/ImplicitIdDef.hs
 create mode 100644 persistent/Database/Persist/ImplicitIdDef/Internal.hs

diff --git a/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal
index f73a5888c..5f84ea35d 100644
--- a/persistent-postgresql/persistent-postgresql.cabal
+++ b/persistent-postgresql/persistent-postgresql.cabal
@@ -54,6 +54,7 @@ test-suite test
                      CustomConstraintTest
                      PgIntervalTest
                      UpsertWhere
+                     ImplicitUuidSpec
     ghc-options:     -Wall
 
     build-depends:   base                 >= 4.9 && < 5
diff --git a/persistent-postgresql/test/ImplicitUuidSpec.hs b/persistent-postgresql/test/ImplicitUuidSpec.hs
new file mode 100644
index 000000000..6045c9075
--- /dev/null
+++ b/persistent-postgresql/test/ImplicitUuidSpec.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 ImplicitUuidSpec where
+
+import PgInit
+
+import Database.Persist.Postgresql
+
+import Database.Persist.ImplicitIdDef
+
+do
+    let
+        uuidDef =
+           mkImplicitIdDefTypeable @UUID "uuid_generate_v1mc()"
+        settings =
+            setImplicitIdDef uuidDef sqlSettings
+    share
+        [mkPersist settings, mkMigrate "implicitUuidMigrate"] [persistLowerCase|
+
+WithDefUuid
+    name        Text sqltype=varchar(80)
+
+    deriving Eq Show Ord
+
+        |]
+
+wipe :: IO ()
+wipe = runConnAssert $ do
+    deleteWhere ([] :: [Filter WithDefUuid])
+
+itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ()))
+itDb msg action = it msg $ runConnAssert $ void action
+
+pass :: IO ()
+pass = pure ()
+
+specs :: Spec
+specs = describe "ImplicitUuidSpec" $ before_ wipe $ do
+    describe "WithDefUuidKey" $ do
+        it "works on UUIDs" $ do
+            let withDefUuidKey = WithDefUuidKey (UUID "Hello")
+            pass
+    describe "insert" $ do
+        itDb "successfully has a default" $ do
+            let matt = WithDefUuid
+                    { withDefUuidName =
+                        "Matt"
+                    }
+            k <- insert matt
+            mrec <- get k
+            mrec `shouldBe` Just matt
+
+
diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs
index 122b65228..bebd9fc6f 100644
--- a/persistent-postgresql/test/PgInit.hs
+++ b/persistent-postgresql/test/PgInit.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
@@ -29,11 +31,13 @@ module PgInit
     , Int32, Int64
     , liftIO
     , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
+    , setImplicitIdDef
     , SomeException
     , Text
     , TestFn(..)
     , LoggingT
     , ResourceT
+    , UUID(..)
     ) where
 
 import Init
@@ -64,7 +68,6 @@ import Data.Aeson (Value(..))
 import Database.Persist.Postgresql.JSON ()
 import Database.Persist.Sql.Raw.QQ
 import Database.Persist.SqlBackend
-import Database.Persist.Postgresql.JSON()
 import Database.Persist.TH
        ( MkPersistSettings(..)
        , mkMigrate
@@ -73,14 +76,25 @@ import Database.Persist.TH
        , persistUpperCase
        , share
        , sqlSettings
+       , setImplicitIdDef
        )
 import Test.Hspec
-       (Spec, afterAll_, before, beforeAll, describe, fdescribe, fit, it,
-       before_, SpecWith, Arg, hspec)
+       ( Arg
+       , Spec
+       , SpecWith
+       , afterAll_
+       , before
+       , beforeAll
+       , before_
+       , describe
+       , fdescribe
+       , fit
+       , hspec
+       , it
+       )
 import Test.Hspec.Expectations.Lifted
 import Test.QuickCheck.Instances ()
 import UnliftIO
-import Database.Persist.SqlBackend
 
 -- testing
 import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=))
@@ -199,3 +213,14 @@ instance Arbitrary Value where
                     . listOf -- [(,)] -> (,)
                     . liftA2 (,) arbText -- (,) -> Text and Value
                     $ limitIt 4 arbitrary -- Again, precaution against divergent recursion.
+
+-- * For "ImplicitUuidSpec"
+
+newtype UUID = UUID { unUUID :: Text }
+    deriving stock
+        (Show, Eq)
+    deriving newtype
+        PersistField
+
+instance PersistFieldSql UUID where
+    sqlType _ = SqlOther "UUID"
diff --git a/persistent-postgresql/test/main.hs b/persistent-postgresql/test/main.hs
index 60543a349..1ed95ae6d 100644
--- a/persistent-postgresql/test/main.hs
+++ b/persistent-postgresql/test/main.hs
@@ -20,6 +20,7 @@ import qualified Data.Text as T
 import Data.Time
 import Test.QuickCheck
 
+import qualified ImplicitUuidSpec
 import qualified ArrayAggTest
 import qualified CompositeTest
 import qualified ForeignKey
@@ -130,6 +131,7 @@ main = do
       , MigrationTest.migrationMigrate
       , PgIntervalTest.pgIntervalMigrate
       , UpsertWhere.upsertWhereMigrate
+      , ImplicitUuidSpec.implicitUuidMigrate
       ]
     PersistentTest.cleanDB
     ForeignKey.cleanDB
diff --git a/persistent/Database/Persist/ImplicitIdDef.hs b/persistent/Database/Persist/ImplicitIdDef.hs
new file mode 100644
index 000000000..0aa99d773
--- /dev/null
+++ b/persistent/Database/Persist/ImplicitIdDef.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module Database.Persist.ImplicitIdDef
+    ( -- * The Type
+      ImplicitIdDef
+      -- * Construction
+    , mkImplicitIdDef
+    -- * Autoincrementing Integer Key
+    , autoIncrementingInteger
+    -- * Getters
+    -- * Setters
+    , unsafeClearDefaultImplicitId
+    ) where
+
+import Language.Haskell.TH
+
+import Database.Persist.ImplicitIdDef.Internal
+import Database.Persist.Types.Base
+    ( FieldType(..)
+    , SqlType(..)
+    )
+import Database.Persist.Class (BackendKey)
+import Database.Persist.Names
+
+-- |
+--
+-- @since 2.13.0.0
+autoIncrementingInteger :: ImplicitIdDef
+autoIncrementingInteger =
+    ImplicitIdDef
+        { iidFieldType = \entName ->
+            FTTypeCon Nothing $ unEntityNameHS entName `mappend` "Id"
+        , iidFieldSqlType =
+            SqlInt64
+        , iidType = \isMpsGeneric mpsBackendType ->
+            ConT ''BackendKey `AppT`
+                if isMpsGeneric
+                then VarT (mkName "backend")
+                else mpsBackendType
+        , iidDefault =
+            Nothing
+        }
diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
new file mode 100644
index 000000000..9a565ce05
--- /dev/null
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE RankNTypes, AllowAmbiguousTypes, PolyKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Database.Persist.ImplicitIdDef.Internal where
+
+import Data.Proxy
+import Data.Text (Text)
+import Language.Haskell.TH (Type)
+import LiftType
+import Type.Reflection
+import qualified Data.Text as T
+
+import Database.Persist.Names
+import Database.Persist.Types
+import Database.Persist.Sql.Class
+
+-- |
+--
+-- @since 2.13.0.0
+data ImplicitIdDef = ImplicitIdDef
+    { iidFieldType :: EntityNameHS -> FieldType
+    , iidFieldSqlType :: SqlType
+    , iidType :: Bool -> Type -> Type
+    -- ^ The Bool argument is whether or not the 'MkPersistBackend' type has the
+    -- 'mpsGeneric' field set.
+    --
+    -- The 'Type' is the 'mpsBackend' value.
+    , iidDefault :: Maybe Text
+    }
+
+-- | Create an 'ImplicitIdDef' based on the 'Typeable' and 'PersistFieldSql'
+-- constraints in scope.
+--
+-- This function uses the @TypeApplications@ syntax.  Let's look at an example
+-- that works with Postgres UUIDs.
+--
+-- > newtype UUID = UUID Text
+-- >     deriving newtype PersistField
+-- >
+-- > instance PersistFieldSql UUID where
+-- >     sqlType _ = SqlOther "UUID"
+-- >
+-- > idDef :: ImplicitIdDef
+-- > idDef = mkImplicitIdDefTypeable @UUID "uuid_generate_v1mc()"
+--
+-- This 'ImplicitIdDef' will generate default UUID columns, and the database
+-- will call the @uuid_generate_v1mc()@  function to generate the value for new
+-- rows being inserted.
+--
+-- @since 2.13.0.0
+mkImplicitIdDef
+    :: forall t. (Typeable t, PersistFieldSql t)
+    => Text
+    -- ^ The default expression to use for columns. Should be valid SQL in the
+    -- language you're using.
+    -> ImplicitIdDef
+mkImplicitIdDef def =
+    ImplicitIdDef
+        { iidFieldType = \_ ->
+            fieldTypeFromTypeable @t
+        , iidFieldSqlType =
+            sqlType (Proxy @t)
+        , iidType =
+            \_ _ -> liftType @t
+        , iidDefault =
+            Just def
+        }
+
+fieldTypeFromTypeable :: forall (t :: *). Typeable t => FieldType
+fieldTypeFromTypeable = go (typeRep @t)
+  where
+    go :: forall k (a :: k). TypeRep a -> FieldType
+    go tr =
+        case tr of
+            Con tyCon ->
+                let
+                    tyName = T.pack $ tyConName tyCon
+                    modName = T.pack $ tyConModule tyCon
+                in
+                    FTTypeCon (Just modName) tyName
+            App trA trB ->
+                FTApp (go trA) (go trB)
+            Fun _ _ ->
+                error "No functions in field defs."
+
+-- | Remove the default attribute of the 'ImplicitIdDef' column. This will
+-- require you to provide an ID for the model with every insert, using
+-- 'insertKey' instead of 'insert', unless the type has some means of getting
+-- around that in the migrations.
+--
+-- As an example, the Postgresql @SERIAL@ type expands to an autoincrementing
+-- integer. Postgres will implicitly create the relevant series and set the
+-- default to be @NEXTVAL('series_name')@. A default is therefore unnecessary to
+-- use for this type.
+--
+-- However, for a @UUID@, postgres *does not* have an implicit default. You must
+-- either specify a default UUID generation function, or insert them yourself
+-- (again, using 'insertKey').
+--
+-- This function will be deprecated in the future when omiting the default
+-- implicit ID column is more fully supported.
+--
+-- @since 2.13.0.0
+unsafeClearDefaultImplicitId :: ImplicitIdDef -> ImplicitIdDef
+unsafeClearDefaultImplicitId iid = iid { iidDefault = Nothing }
+
diff --git a/persistent/Database/Persist/Quasi/Internal.hs b/persistent/Database/Persist/Quasi/Internal.hs
index 93034c1e7..27ab77d45 100644
--- a/persistent/Database/Persist/Quasi/Internal.hs
+++ b/persistent/Database/Persist/Quasi/Internal.hs
@@ -450,10 +450,6 @@ mkEntityDef ps name entattribs lines =
     textAttribs =
         fmap tokenText <$> attribs
 
-    attribPrefix = flip lookupKeyVal entattribs
-    idName | Just _ <- attribPrefix "id" = error "id= is deprecated, ad a field named 'Id' and use sql="
-           | otherwise = Nothing
-
     (idField, primaryComposite, uniqs, foreigns) = foldl' (\(mid, mp, us, fs) attr ->
         let (i, p, u, f) = takeConstraint ps name' cols attr
             squish xs m = xs `mappend` maybeToList m
@@ -473,7 +469,7 @@ mkEntityDef ps name entattribs lines =
                   Nothing ->
                       (acc, [])
 
-    autoIdField = mkAutoIdField ps entName (FieldNameDB `fmap` idName) idSqlType
+    autoIdField = mkAutoIdField ps entName idSqlType
     idSqlType = maybe SqlInt64 (const $ SqlOther "Primary Key") primaryComposite
 
     setComposite Nothing fd = fd
@@ -492,14 +488,14 @@ just1 (Just x) (Just y) = error $ "expected only one of: "
   `mappend` show x `mappend` " " `mappend` show y
 just1 x y = x `mplus` y
 
-mkAutoIdField :: PersistSettings -> EntityNameHS -> Maybe FieldNameDB -> SqlType -> FieldDef
-mkAutoIdField ps entName idName idSqlType =
+mkAutoIdField :: PersistSettings -> EntityNameHS -> SqlType -> FieldDef
+mkAutoIdField ps entName idSqlType =
     FieldDef
         { fieldHaskell = FieldNameHS "Id"
         -- this should be modeled as a Maybe
         -- but that sucks for non-ID field
         -- TODO: use a sumtype FieldDef | IdFieldDef
-        , fieldDB = fromMaybe (FieldNameDB $ psIdName ps) idName
+        , fieldDB = FieldNameDB $ psIdName ps
         , fieldType = FTTypeCon Nothing $ keyConName $ unEntityNameHS entName
         , fieldSqlType = idSqlType
         -- the primary field is actually a reference to the entity
@@ -509,6 +505,7 @@ mkAutoIdField ps entName idName idSqlType =
         , fieldComments = Nothing
         , fieldCascade = noCascade
         , fieldGenerated = Nothing
+        , fieldIsImplicitIdColumn = True
         }
 
 defaultReferenceTypeCon :: FieldType
@@ -567,6 +564,7 @@ takeCols onErr ps (n':typ:rest')
                 , fieldComments = Nothing
                 , fieldCascade = cascade_
                 , fieldGenerated = generated_
+                , fieldIsImplicitIdColumn = False
                 }
   where
     fieldAttrs_ = parseFieldAttrs attrs_
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 40629da7c..928bae68f 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
@@ -40,6 +41,9 @@ module Database.Persist.TH
     , EntityJSON(..)
     , mkPersistSettings
     , sqlSettings
+    -- ** Implicit ID Columns
+    , ImplicitIdDef
+    , setImplicitIdDef
       -- * Various other TH functions
     , mkMigrate
     , mkSave
@@ -112,8 +116,10 @@ import Database.Persist.Quasi
 import Database.Persist.Sql
        (Migration, PersistFieldSql, SqlBackend, migrate, sqlType)
 
-import Database.Persist.Types.Base (toEmbedEntityDef)
+import Database.Persist.ImplicitIdDef (autoIncrementingInteger)
+import Database.Persist.ImplicitIdDef.Internal
 import Database.Persist.EntityDef.Internal (EntityDef(..))
+import Database.Persist.Types.Base (toEmbedEntityDef)
 
 -- | Converts a quasi-quoted syntax into a list of entity definitions, to be
 -- used as input to the template haskell generation code (mkPersist).
@@ -302,9 +308,9 @@ data FieldSqlTypeExp = FieldSqlTypeExp FieldDef SqlTypeExp
 
 instance Lift FieldSqlTypeExp where
     lift (FieldSqlTypeExp FieldDef{..} sqlTypeExp) =
-        [|FieldDef fieldHaskell fieldDB fieldType $(lift sqlTypeExp) fieldAttrs fieldStrict fieldReference fieldCascade fieldComments fieldGenerated|]
+        [|FieldDef fieldHaskell fieldDB fieldType $(lift sqlTypeExp) fieldAttrs fieldStrict fieldReference fieldCascade fieldComments fieldGenerated fieldIsImplicitIdColumn|]
       where
-        FieldDef _x _ _ _ _ _ _ _ _ _ =
+        FieldDef _x _ _ _ _ _ _ _ _ _ _ =
             error "need to update this record wildcard match"
 #if MIN_VERSION_template_haskell(2,16,0)
     liftTyped = unsafeTExpCoerce . lift
@@ -470,23 +476,29 @@ mkPersist mps ents' = do
     entityMap = constructEntityMap ents
 
 setDefaultIdFields :: MkPersistSettings -> EntityDef -> EntityDef
-setDefaultIdFields mps ed =
-    case mpsImplicitIdSpec mps of
-        Nothing ->
-            ed
-        Just iis
-            | defaultIdType ed ->
-                setEntityId (setToMpsDefault iis (getEntityId ed)) ed
-            | otherwise ->
-                ed
+setDefaultIdFields mps ed
+    | defaultIdType ed =
+        ed -- setEntityId (setToMpsDefault (mpsImplicitIdDef mps) (getEntityId ed)) ed
+    | otherwise =
+        ed
   where
-    setToMpsDefault :: ImplicitIdSpec -> FieldDef -> FieldDef
-    setToMpsDefault iis fd =
+    setToMpsDefault :: ImplicitIdDef -> FieldDef -> FieldDef
+    setToMpsDefault iid fd =
         fd
             { fieldType =
-                iisFieldType iis (getEntityHaskellName ed)
+                iidFieldType iid (getEntityHaskellName ed)
             , fieldSqlType =
-                iisFieldSqlType iis
+                iidFieldSqlType iid
+            , fieldAttrs =
+                let
+                    old =
+                        fieldAttrs fd
+                 in
+                    case iidDefault iid of
+                        Nothing ->
+                            old
+                        Just def ->
+                            FieldAttrDefault def : old
             }
 
 -- | Implement special preprocessing on EntityDef as necessary for 'mkPersist'.
@@ -554,52 +566,40 @@ data MkPersistSettings = MkPersistSettings
     --      , 'entityFromJSON' = 'entityIdFromJSON
     --      }
     -- @
-    , mpsGenerateLenses :: !Bool
+    , mpsGenerateLenses :: Bool
     -- ^ Instead of generating normal field accessors, generator lens-style
     -- accessors.
     --
     -- Default: False
     --
     -- @since 1.3.1
-    , mpsDeriveInstances :: ![Name]
+    , mpsDeriveInstances :: [Name]
     -- ^ Automatically derive these typeclass instances for all record and key
     -- types.
     --
     -- Default: []
     --
     -- @since 2.8.1
-    , mpsImplicitIdSpec :: !(Maybe ImplicitIdSpec)
+    , mpsImplicitIdDef :: ImplicitIdDef
+    -- ^ TODO: document
+    --
+    -- @since 2.13.0.0
     }
 
--- |
+-- |  Set the 'ImplicitIdDef' in the given 'MkPersistSettings'. The default
+-- value is 'autoIncrementingInteger'.
 --
 -- @since 2.13.0.0
-data ImplicitIdSpec = ImplicitIdSpec
-    { iisFieldType :: EntityNameHS -> FieldType
-    , iisFieldSqlType :: SqlType
-    , iisType :: MkPersistSettings -> Type
-    }
+setImplicitIdDef :: ImplicitIdDef -> MkPersistSettings -> MkPersistSettings
+setImplicitIdDef iid mps =
+    mps { mpsImplicitIdDef = iid }
 
-getImplicitIdType :: MkPersistSettings -> Maybe Type
-getImplicitIdType mps =
-    (\x -> iisType x mps ) <$> mpsImplicitIdSpec mps
-
--- |
---
--- @since 2.13.0.0
-autoIncrementingInteger :: ImplicitIdSpec
-autoIncrementingInteger =
-    ImplicitIdSpec
-        { iisFieldType = \entName ->
-            FTTypeCon Nothing $ unEntityNameHS entName `mappend` "Id"
-        , iisFieldSqlType =
-            SqlInt64
-        , iisType = \mps ->
-            ConT ''BackendKey `AppT`
-                if mpsGeneric mps
-                then backendT
-                else mpsBackend mps
-        }
+getImplicitIdType :: MkPersistSettings -> Type
+getImplicitIdType = do
+    idDef <- mpsImplicitIdDef
+    isGeneric <- mpsGeneric
+    backendTy <- mpsBackend
+    pure $ iidType idDef isGeneric backendTy
 
 data EntityJSON = EntityJSON
     { entityToJSON :: Name
@@ -624,8 +624,8 @@ mkPersistSettings backend = MkPersistSettings
         }
     , mpsGenerateLenses = False
     , mpsDeriveInstances = []
-    , mpsImplicitIdSpec =
-        Just autoIncrementingInteger
+    , mpsImplicitIdDef =
+        autoIncrementingInteger
     }
 
 -- | Use the 'SqlPersist' backend.
@@ -1064,9 +1064,13 @@ mkKeyTypeDec mps entDef = do
 pkNewtype :: MkPersistSettings -> EntityDef -> Bool
 pkNewtype mps entDef = length (keyFields mps entDef) < 2
 
+-- | Kind of a nasty hack. Checks to see if the 'fieldType' matches what the
+-- QuasiQuoter produces for an implicit ID and
 defaultIdType :: EntityDef -> Bool
 defaultIdType entDef =
-    fieldType (entityId entDef) == FTTypeCon Nothing (keyIdText entDef)
+    fieldType field == FTTypeCon Nothing (keyIdText entDef)
+  where
+    field = getEntityId entDef
 
 keyFields :: MkPersistSettings -> EntityDef -> [(Name, Strict, Type)]
 keyFields mps entDef =
@@ -1074,16 +1078,8 @@ keyFields mps entDef =
         Just pdef ->
             map primaryKeyVar (compositeFields pdef)
         Nothing ->
-            pure . idKeyVar $
-                if defaultIdType entDef
-                then backendKeyType
-                else ftToType $ fieldType $ entityId entDef
+            pure . idKeyVar $ ftToType $ fieldType $ entityId entDef
   where
-    backendKeyType
-        | mpsGeneric mps =
-            ConT ''BackendKey `AppT` backendT
-        | otherwise =
-            ConT ''BackendKey `AppT` mpsBackend mps
     idKeyVar ft =
         ( unKeyName entDef
         , notStrict
@@ -1799,8 +1795,8 @@ liftAndFixKeys entityMap EntityDef{..} =
     |]
 
 liftAndFixKey :: EntityMap -> FieldDef -> Q Exp
-liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef fc mcomments fg) =
-    [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg|]
+liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fh) =
+    [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg fh|]
   where
     (fieldRef', sqlTyp') =
         fromMaybe (fieldRef, lift sqlTyp) $
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index 1ca52c622..ca6384846 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -1,7 +1,11 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, AllowAmbiguousTypes #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Database.Persist.Types.Base
     ( module Database.Persist.Types.Base
@@ -23,6 +27,7 @@ import qualified Data.HashMap.Strict as HM
 import Data.Int (Int64)
 import Data.Map (Map)
 import Data.Maybe (isNothing)
+import Type.Reflection
 #if !MIN_VERSION_base(4,11,0)
 -- This can be removed when GHC < 8.2.2 isn't supported anymore
 import Data.Semigroup ((<>))
@@ -725,5 +730,9 @@ data FieldDef = FieldDef
     -- the expression to use for generation.
     --
     -- @since 2.11.0.0
+    , fieldIsImplicitIdColumn :: !Bool
+    -- ^ 'True' if the field is an implicit ID column. 'False' otherwise.
+    --
+    -- @since 2.13.0.0
     }
     deriving (Show, Eq, Read, Ord, Lift)
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 395fa4cdc..739def1a5 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -26,6 +26,7 @@ library
       , containers               >= 0.5
       , fast-logger              >= 2.4
       , http-api-data            >= 0.3
+      , lift-type                >= 0.1.0.0 && < 0.2.0.0
       , monad-logger             >= 0.3.28
       , mtl
       , path-pieces              >= 0.2
@@ -35,12 +36,12 @@ library
       , silently
       , template-haskell         >= 2.11 && < 2.18
       , text                     >= 1.2
+      , th-lift-instances        >= 0.1.14    && < 0.2
       , time                     >= 1.6
       , transformers             >= 0.5
-      , unliftio-core
       , unliftio
+      , unliftio-core
       , unordered-containers
-      , th-lift-instances        >= 0.1.14    && < 0.2
       , vector
 
     default-extensions: 
@@ -57,6 +58,8 @@ library
         Database.Persist.EntityDef.Internal
         Database.Persist.FieldDef
         Database.Persist.FieldDef.Internal
+        Database.Persist.ImplicitIdDef
+        Database.Persist.ImplicitIdDef.Internal
         Database.Persist.TH
 
         Database.Persist.Quasi
@@ -155,11 +158,6 @@ test-suite test
                       , TypeFamilies
 
     other-modules:   
-        -- Database.Persist.Class.PersistEntity
-        -- Database.Persist.Class.PersistField
-        -- Database.Persist.Quasi
-        -- Database.Persist.Types
-        -- Database.Persist.Types.Base
         Database.Persist.THSpec
         TemplateTestImports
         Database.Persist.TH.SharedPrimaryKeySpec
diff --git a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs b/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs
index c2a4b4411..314871c65 100644
--- a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs
+++ b/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs
@@ -58,5 +58,5 @@ spec = describe "OverloadedLabels" $ do
 
         compiles
 
-compiles :: Expectation
-compiles = True `shouldBe` True
+compiles :: IO ()
+compiles = pure ()
diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs
index 79d3df11f..cf923a02f 100644
--- a/persistent/test/Database/Persist/THSpec.hs
+++ b/persistent/test/Database/Persist/THSpec.hs
@@ -268,6 +268,7 @@ spec = do
                                     , fieldComments = Nothing
                                     , fieldCascade = noCascade
                                     , fieldGenerated = Nothing
+                                    , fieldIsImplicitIdColumn = True
                                     }
                             , entityAttrs = []
                             , entityFields =
@@ -286,6 +287,7 @@ spec = do
                                         FieldCascade { fcOnUpdate = Nothing, fcOnDelete = Just Cascade }
                                     , fieldComments = Nothing
                                     , fieldGenerated = Nothing
+                                    , fieldIsImplicitIdColumn = False
                                     }
                                 ]
                             , entityUniques = []
diff --git a/persistent/test/TemplateTestImports.hs b/persistent/test/TemplateTestImports.hs
index 6be306b72..820c3aedf 100644
--- a/persistent/test/TemplateTestImports.hs
+++ b/persistent/test/TemplateTestImports.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module TemplateTestImports
@@ -8,9 +10,12 @@ module TemplateTestImports
 import Data.Aeson.TH
 import Test.QuickCheck
 
-import Test.Hspec as X
+import Data.Int as X
 import Database.Persist.Sql as X
 import Database.Persist.TH as X
+import Test.Hspec as X
+import Data.Proxy as X
+import Data.Text as X (Text)
 
 data Foo = Bar | Baz
     deriving (Show, Eq)
diff --git a/stack.yaml b/stack.yaml
index c548c33cf..613ca01e5 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -8,3 +8,6 @@ packages:
   - ./persistent-postgresql
   - ./persistent-redis
   - ./persistent-qq
+
+extra-deps:
+    - lift-type-0.1.0.0

From 7d4d940720e28fc7496fc325073aa6e484be27d7 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 16:30:00 -0600
Subject: [PATCH 10/19] it works

---
 .../persistent-postgresql.cabal               |   2 +
 .../test/ImplicitUuidSpec.hs                  |  29 +++-
 persistent-postgresql/test/PgInit.hs          |  24 +++-
 persistent-postgresql/test/main.hs            | 127 +++++++++---------
 .../Persist/ImplicitIdDef/Internal.hs         |   2 +-
 persistent/Database/Persist/Sql/Migration.hs  |   7 +
 persistent/Database/Persist/TH.hs             |  44 +++++-
 persistent/persistent.cabal                   |   1 +
 persistent/test/Database/Persist/THSpec.hs    |   2 +
 persistent/test/main.hs                       |   3 +
 10 files changed, 160 insertions(+), 81 deletions(-)

diff --git a/persistent-postgresql/persistent-postgresql.cabal b/persistent-postgresql/persistent-postgresql.cabal
index 5f84ea35d..96176a24b 100644
--- a/persistent-postgresql/persistent-postgresql.cabal
+++ b/persistent-postgresql/persistent-postgresql.cabal
@@ -77,6 +77,8 @@ test-suite test
                    , text
                    , time
                    , transformers
+                   , path-pieces
+                   , http-api-data
                    , unliftio-core
                    , unliftio
                    , unordered-containers
diff --git a/persistent-postgresql/test/ImplicitUuidSpec.hs b/persistent-postgresql/test/ImplicitUuidSpec.hs
index 6045c9075..b997cebb4 100644
--- a/persistent-postgresql/test/ImplicitUuidSpec.hs
+++ b/persistent-postgresql/test/ImplicitUuidSpec.hs
@@ -16,18 +16,20 @@ module ImplicitUuidSpec where
 
 import PgInit
 
+import Data.Proxy
 import Database.Persist.Postgresql
 
 import Database.Persist.ImplicitIdDef
+import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
 
 do
     let
         uuidDef =
-           mkImplicitIdDefTypeable @UUID "uuid_generate_v1mc()"
+           mkImplicitIdDef @UUID "uuid_generate_v1mc()"
         settings =
             setImplicitIdDef uuidDef sqlSettings
     share
-        [mkPersist settings, mkMigrate "implicitUuidMigrate"] [persistLowerCase|
+        [mkPersist settings, mkEntityDefList "entities"] [persistLowerCase|
 
 WithDefUuid
     name        Text sqltype=varchar(80)
@@ -36,9 +38,15 @@ WithDefUuid
 
         |]
 
+implicitUuidMigrate :: Migration
+implicitUuidMigrate = do
+    runSqlCommand $ rawExecute "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\"" []
+    migrateModels entities
+
 wipe :: IO ()
 wipe = runConnAssert $ do
-    deleteWhere ([] :: [Filter WithDefUuid])
+    rawExecute "DROP TABLE with_def_uuid;" []
+    runMigration implicitUuidMigrate
 
 itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ()))
 itDb msg action = it msg $ runConnAssert $ void action
@@ -46,12 +54,21 @@ itDb msg action = it msg $ runConnAssert $ void action
 pass :: IO ()
 pass = pure ()
 
-specs :: Spec
-specs = describe "ImplicitUuidSpec" $ before_ wipe $ do
+spec :: Spec
+spec = fdescribe "ImplicitUuidSpec" $ before_ wipe $ do
     describe "WithDefUuidKey" $ do
         it "works on UUIDs" $ do
             let withDefUuidKey = WithDefUuidKey (UUID "Hello")
             pass
+    describe "getEntityId" $ do
+        let idField = getEntityId (entityDef (Proxy @WithDefUuid))
+        it "has a UUID SqlType" $ asIO $ do
+            fieldSqlType idField `shouldBe` SqlOther "UUID"
+        it "has a UUID type" $ asIO $ do
+            fieldType idField `shouldBe` fieldTypeFromTypeable @UUID
+        it "is an implicit ID column" $ asIO $ do
+            fieldIsImplicitIdColumn idField `shouldBe` True
+
     describe "insert" $ do
         itDb "successfully has a default" $ do
             let matt = WithDefUuid
@@ -61,5 +78,3 @@ specs = describe "ImplicitUuidSpec" $ before_ wipe $ do
             k <- insert matt
             mrec <- get k
             mrec `shouldBe` Just matt
-
-
diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs
index bebd9fc6f..6ce11ac28 100644
--- a/persistent-postgresql/test/PgInit.hs
+++ b/persistent-postgresql/test/PgInit.hs
@@ -30,7 +30,8 @@ module PgInit
     , BS.ByteString
     , Int32, Int64
     , liftIO
-    , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
+    , mkPersist, migrateModels, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
+    , mkEntityDefList
     , setImplicitIdDef
     , SomeException
     , Text
@@ -64,19 +65,21 @@ import Init
 import Control.Exception (SomeException)
 import Control.Monad (forM_, liftM, replicateM, void, when)
 import Control.Monad.Trans.Reader
-import Data.Aeson (Value(..))
+import Data.Aeson (ToJSON, FromJSON, Value(..))
 import Database.Persist.Postgresql.JSON ()
 import Database.Persist.Sql.Raw.QQ
 import Database.Persist.SqlBackend
 import Database.Persist.TH
        ( MkPersistSettings(..)
        , mkMigrate
+       , migrateModels
        , mkPersist
        , persistLowerCase
        , persistUpperCase
        , share
        , sqlSettings
        , setImplicitIdDef
+       , mkEntityDefList
        )
 import Test.Hspec
        ( Arg
@@ -95,11 +98,14 @@ import Test.Hspec
 import Test.Hspec.Expectations.Lifted
 import Test.QuickCheck.Instances ()
 import UnliftIO
+import qualified Data.Text.Encoding as TE
 
 -- testing
 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
@@ -218,9 +224,19 @@ instance Arbitrary Value where
 
 newtype UUID = UUID { unUUID :: Text }
     deriving stock
-        (Show, Eq)
+        (Show, Eq, Ord, Read)
     deriving newtype
-        PersistField
+        (ToJSON, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)
 
 instance PersistFieldSql UUID where
     sqlType _ = SqlOther "UUID"
+
+instance PersistField UUID where
+    toPersistValue (UUID txt) =
+        PersistLiteral_ Escaped (TE.encodeUtf8 txt)
+    fromPersistValue pv =
+        case pv of
+            PersistLiteral_ Escaped bs ->
+                Right $ UUID (TE.decodeUtf8 bs)
+            _ ->
+                Left "Nope"
diff --git a/persistent-postgresql/test/main.hs b/persistent-postgresql/test/main.hs
index 1ed95ae6d..ecd91a77b 100644
--- a/persistent-postgresql/test/main.hs
+++ b/persistent-postgresql/test/main.hs
@@ -137,69 +137,70 @@ main = do
     ForeignKey.cleanDB
 
   hspec $ do
-    RenameTest.specsWith runConnAssert
-    DataTypeTest.specsWith runConnAssert
-        (Just (runMigrationSilent dataTypeMigrate))
-        [ TestFn "text" dataTypeTableText
-        , TestFn "textMaxLen" dataTypeTableTextMaxLen
-        , TestFn "bytes" dataTypeTableBytes
-        , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
-        , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
-        , TestFn "int" dataTypeTableInt
-        , TestFn "intList" dataTypeTableIntList
-        , TestFn "intMap" dataTypeTableIntMap
-        , TestFn "bool" dataTypeTableBool
-        , TestFn "day" dataTypeTableDay
-        , TestFn "time" (DataTypeTest.roundTime . dataTypeTableTime)
-        , TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)
-        , TestFn "jsonb" dataTypeTableJsonb
-        ]
-        [ ("pico", dataTypeTablePico) ]
-        dataTypeTableDouble
-    HtmlTest.specsWith
-        runConnAssert
-        (Just (runMigrationSilent HtmlTest.htmlMigrate))
+      ImplicitUuidSpec.spec
+      RenameTest.specsWith runConnAssert
+      DataTypeTest.specsWith runConnAssert
+          (Just (runMigrationSilent dataTypeMigrate))
+          [ TestFn "text" dataTypeTableText
+          , TestFn "textMaxLen" dataTypeTableTextMaxLen
+          , TestFn "bytes" dataTypeTableBytes
+          , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
+          , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
+          , TestFn "int" dataTypeTableInt
+          , TestFn "intList" dataTypeTableIntList
+          , TestFn "intMap" dataTypeTableIntMap
+          , TestFn "bool" dataTypeTableBool
+          , TestFn "day" dataTypeTableDay
+          , TestFn "time" (DataTypeTest.roundTime . dataTypeTableTime)
+          , TestFn "utc" (DataTypeTest.roundUTCTime . dataTypeTableUtc)
+          , TestFn "jsonb" dataTypeTableJsonb
+          ]
+          [ ("pico", dataTypeTablePico) ]
+          dataTypeTableDouble
+      HtmlTest.specsWith
+          runConnAssert
+          (Just (runMigrationSilent HtmlTest.htmlMigrate))
 
-    EmbedTest.specsWith runConnAssert
-    EmbedOrderTest.specsWith runConnAssert
-    LargeNumberTest.specsWith runConnAssert
-    ForeignKey.specsWith runConnAssert
-    UniqueTest.specsWith runConnAssert
-    MaxLenTest.specsWith runConnAssert
-    Recursive.specsWith runConnAssert
-    SumTypeTest.specsWith runConnAssert (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
-    MigrationTest.specsWith runConnAssert
-    MigrationOnlyTest.specsWith runConnAssert
+      EmbedTest.specsWith runConnAssert
+      EmbedOrderTest.specsWith runConnAssert
+      LargeNumberTest.specsWith runConnAssert
+      ForeignKey.specsWith runConnAssert
+      UniqueTest.specsWith runConnAssert
+      MaxLenTest.specsWith runConnAssert
+      Recursive.specsWith runConnAssert
+      SumTypeTest.specsWith runConnAssert (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
+      MigrationTest.specsWith runConnAssert
+      MigrationOnlyTest.specsWith runConnAssert
 
-        (Just
-            $ runMigrationSilent MigrationOnlyTest.migrateAll1
-            >> runMigrationSilent MigrationOnlyTest.migrateAll2
-        )
-    PersistentTest.specsWith runConnAssert
-    ReadWriteTest.specsWith runConnAssert
-    PersistentTest.filterOrSpecs runConnAssert
-    RawSqlTest.specsWith runConnAssert
-    UpsertTest.specsWith
-        runConnAssert
-        UpsertTest.Don'tUpdateNull
-        UpsertTest.UpsertPreserveOldKey
+          (Just
+              $ runMigrationSilent MigrationOnlyTest.migrateAll1
+              >> runMigrationSilent MigrationOnlyTest.migrateAll2
+          )
+      PersistentTest.specsWith runConnAssert
+      ReadWriteTest.specsWith runConnAssert
+      PersistentTest.filterOrSpecs runConnAssert
+      RawSqlTest.specsWith runConnAssert
+      UpsertTest.specsWith
+          runConnAssert
+          UpsertTest.Don'tUpdateNull
+          UpsertTest.UpsertPreserveOldKey
 
-    MpsNoPrefixTest.specsWith runConnAssert
-    MpsCustomPrefixTest.specsWith runConnAssert
-    EmptyEntityTest.specsWith runConnAssert (Just (runMigrationSilent EmptyEntityTest.migration))
-    CompositeTest.specsWith runConnAssert
-    TreeTest.specsWith runConnAssert
-    PersistUniqueTest.specsWith runConnAssert
-    PrimaryTest.specsWith runConnAssert
-    CustomPersistFieldTest.specsWith runConnAssert
-    CustomPrimaryKeyReferenceTest.specsWith runConnAssert
-    MigrationColumnLengthTest.specsWith runConnAssert
-    EquivalentTypeTestPostgres.specs
-    TransactionLevelTest.specsWith runConnAssert
-    LongIdentifierTest.specsWith runConnAssertUseConf -- Have at least one test use the conf variant of connecting to Postgres, to improve test coverage.
-    JSONTest.specs
-    CustomConstraintTest.specs
-    UpsertWhere.specs
-    PgIntervalTest.specs
-    ArrayAggTest.specs
-    GeneratedColumnTestSQL.specsWith runConnAssert
+      MpsNoPrefixTest.specsWith runConnAssert
+      MpsCustomPrefixTest.specsWith runConnAssert
+      EmptyEntityTest.specsWith runConnAssert (Just (runMigrationSilent EmptyEntityTest.migration))
+      CompositeTest.specsWith runConnAssert
+      TreeTest.specsWith runConnAssert
+      PersistUniqueTest.specsWith runConnAssert
+      PrimaryTest.specsWith runConnAssert
+      CustomPersistFieldTest.specsWith runConnAssert
+      CustomPrimaryKeyReferenceTest.specsWith runConnAssert
+      MigrationColumnLengthTest.specsWith runConnAssert
+      EquivalentTypeTestPostgres.specs
+      TransactionLevelTest.specsWith runConnAssert
+      LongIdentifierTest.specsWith runConnAssertUseConf -- Have at least one test use the conf variant of connecting to Postgres, to improve test coverage.
+      JSONTest.specs
+      CustomConstraintTest.specs
+      UpsertWhere.specs
+      PgIntervalTest.specs
+      ArrayAggTest.specs
+      GeneratedColumnTestSQL.specsWith runConnAssert
diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 9a565ce05..16d4af46a 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -78,7 +78,7 @@ fieldTypeFromTypeable = go (typeRep @t)
                     tyName = T.pack $ tyConName tyCon
                     modName = T.pack $ tyConModule tyCon
                 in
-                    FTTypeCon (Just modName) tyName
+                    FTTypeCon Nothing tyName
             App trA trB ->
                 FTApp (go trA) (go trB)
             Fun _ _ ->
diff --git a/persistent/Database/Persist/Sql/Migration.hs b/persistent/Database/Persist/Sql/Migration.hs
index 6e2ecd090..8238035ad 100644
--- a/persistent/Database/Persist/Sql/Migration.hs
+++ b/persistent/Database/Persist/Sql/Migration.hs
@@ -15,6 +15,7 @@ module Database.Persist.Sql.Migration
   , reportError
   , addMigrations
   , addMigration
+  , runSqlCommand
   ) where
 
 
@@ -209,3 +210,9 @@ addMigrations
     :: CautiousMigration
     -> Migration
 addMigrations = lift . tell
+
+-- | Run an action against the database during a migration.
+--
+-- @since 2.13.0.0
+runSqlCommand :: SqlPersistT IO () -> Migration
+runSqlCommand = lift . lift
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 928bae68f..4f4b098db 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -46,6 +46,7 @@ module Database.Persist.TH
     , setImplicitIdDef
       -- * Various other TH functions
     , mkMigrate
+    , migrateModels
     , mkSave
     , mkDeleteCascade
     , mkEntityDefList
@@ -116,9 +117,9 @@ import Database.Persist.Quasi
 import Database.Persist.Sql
        (Migration, PersistFieldSql, SqlBackend, migrate, sqlType)
 
+import Database.Persist.EntityDef.Internal (EntityDef(..))
 import Database.Persist.ImplicitIdDef (autoIncrementingInteger)
 import Database.Persist.ImplicitIdDef.Internal
-import Database.Persist.EntityDef.Internal (EntityDef(..))
 import Database.Persist.Types.Base (toEmbedEntityDef)
 
 -- | Converts a quasi-quoted syntax into a list of entity definitions, to be
@@ -477,8 +478,8 @@ mkPersist mps ents' = do
 
 setDefaultIdFields :: MkPersistSettings -> EntityDef -> EntityDef
 setDefaultIdFields mps ed
-    | defaultIdType ed =
-        ed -- setEntityId (setToMpsDefault (mpsImplicitIdDef mps) (getEntityId ed)) ed
+    | defaultIdType ed || fieldIsImplicitIdColumn (getEntityId ed) =
+        setEntityId (setToMpsDefault (mpsImplicitIdDef mps) (getEntityId ed)) ed
     | otherwise =
         ed
   where
@@ -499,6 +500,8 @@ setDefaultIdFields mps ed
                             old
                         Just def ->
                             FieldAttrDefault def : old
+            , fieldIsImplicitIdColumn =
+                True
             }
 
 -- | Implement special preprocessing on EntityDef as necessary for 'mkPersist'.
@@ -1078,8 +1081,29 @@ keyFields mps entDef =
         Just pdef ->
             map primaryKeyVar (compositeFields pdef)
         Nothing ->
-            pure . idKeyVar $ ftToType $ fieldType $ entityId entDef
+            pure . idKeyVar $
+                -- TODO: Okay, so my problem is right here.
+                --
+                -- The 'defaultIdType' function asks if the field's type is
+                -- defined as ${ModelName}Id. If it is, then we peek through to
+                -- the underlying type.
+                if defaultIdType entDef
+                then
+                 -- backendKeyType is the behavior-preserving original code.
+                    -- backendKeyType
+                -- This is the somewhat naive variant - just grab the ID type
+                -- and convert it! But this is loopy - it recurses and is sad.
+                -- We want to "see through" the type alias.
+                    -- ftToType $ fieldType $ entityId entDef
+                -- SO let's just copy the type.
+                    getImplicitIdType mps
+                else ftToType $ fieldType $ entityId entDef
   where
+    backendKeyType =
+        ConT ''BackendKey `AppT`
+            if mpsGeneric mps
+            then backendT
+            else mpsBackend mps
     idKeyVar ft =
         ( unKeyName entDef
         , notStrict
@@ -1722,6 +1746,11 @@ derivePersistFieldJSON s = do
             ]
         ]
 
+migrateModels :: [EntityDef] -> Migration
+migrateModels eds =
+    forM_ eds $ \ed ->
+        migrate eds ed
+
 -- | 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
@@ -1795,8 +1824,11 @@ liftAndFixKeys entityMap EntityDef{..} =
     |]
 
 liftAndFixKey :: EntityMap -> FieldDef -> Q Exp
-liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fh) =
-    [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg fh|]
+liftAndFixKey entityMap fd@(FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fieldIsImplicitIdColumn)
+    | not fieldIsImplicitIdColumn =
+        [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg fieldIsImplicitIdColumn|]
+    | otherwise =
+        [|FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fieldIsImplicitIdColumn|]
   where
     (fieldRef', sqlTyp') =
         fromMaybe (fieldRef, lift sqlTyp) $
diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal
index 739def1a5..35fbe6d42 100644
--- a/persistent/persistent.cabal
+++ b/persistent/persistent.cabal
@@ -163,6 +163,7 @@ test-suite test
         Database.Persist.TH.SharedPrimaryKeySpec
         Database.Persist.TH.SharedPrimaryKeyImportedSpec
         Database.Persist.TH.OverloadedLabelSpec
+        Database.Persist.TH.ImplicitIdColSpec
     default-language: Haskell2010
 
 source-repository head
diff --git a/persistent/test/Database/Persist/THSpec.hs b/persistent/test/Database/Persist/THSpec.hs
index cf923a02f..89fe8e805 100644
--- a/persistent/test/Database/Persist/THSpec.hs
+++ b/persistent/test/Database/Persist/THSpec.hs
@@ -46,6 +46,7 @@ import Database.Persist.EntityDef.Internal
 import qualified Database.Persist.TH.SharedPrimaryKeySpec as SharedPrimaryKeySpec
 import qualified Database.Persist.TH.SharedPrimaryKeyImportedSpec as SharedPrimaryKeyImportedSpec
 import qualified Database.Persist.TH.OverloadedLabelSpec as OverloadedLabelSpec
+import qualified Database.Persist.TH.ImplicitIdColSpec as ImplicitIdColSpec
 
 share [mkPersist sqlSettings { mpsGeneric = False, mpsDeriveInstances = [''Generic] }, mkDeleteCascade sqlSettings { mpsGeneric = False }] [persistUpperCase|
 
@@ -139,6 +140,7 @@ spec = do
     OverloadedLabelSpec.spec
     SharedPrimaryKeySpec.spec
     SharedPrimaryKeyImportedSpec.spec
+    ImplicitIdColSpec.spec
     describe "TestDefaultKeyCol" $ do
         let FieldDef{..} =
                 entityId (entityDef (Proxy @TestDefaultKeyCol))
diff --git a/persistent/test/main.hs b/persistent/test/main.hs
index e40cd06b6..99c5d22ea 100644
--- a/persistent/test/main.hs
+++ b/persistent/test/main.hs
@@ -102,6 +102,7 @@ main = hspec $ do
                         , fieldCascade = noCascade
                         , fieldComments = Nothing
                         , fieldGenerated = Nothing
+                        , fieldIsImplicitIdColumn = False
                         }
         it "works if it has a name, type, and cascade" $ do
             subject ["asdf", "Int", "OnDeleteCascade", "OnUpdateCascade"]
@@ -117,6 +118,7 @@ main = hspec $ do
                         , fieldCascade = FieldCascade (Just Cascade) (Just Cascade)
                         , fieldComments = Nothing
                         , fieldGenerated = Nothing
+                        , fieldIsImplicitIdColumn = False
                         }
         it "never tries to make a refernece" $ do
             subject ["asdf", "UserId", "OnDeleteCascade"]
@@ -132,6 +134,7 @@ main = hspec $ do
                         , fieldCascade = FieldCascade Nothing (Just Cascade)
                         , fieldComments = Nothing
                         , fieldGenerated = Nothing
+                        , fieldIsImplicitIdColumn = False
                         }
 
     describe "parseLine" $ do

From cdb7cf2494faa858c4d6ffd89697dd1f8a261e30 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 16:30:05 -0600
Subject: [PATCH 11/19] it works

---
 .../Database/Persist/TH/ImplicitIdColSpec.hs  | 57 +++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 persistent/test/Database/Persist/TH/ImplicitIdColSpec.hs

diff --git a/persistent/test/Database/Persist/TH/ImplicitIdColSpec.hs b/persistent/test/Database/Persist/TH/ImplicitIdColSpec.hs
new file mode 100644
index 000000000..2909f6693
--- /dev/null
+++ b/persistent/test/Database/Persist/TH/ImplicitIdColSpec.hs
@@ -0,0 +1,57 @@
+{-# 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.ImplicitIdColSpec where
+
+import TemplateTestImports
+
+import Data.Text (Text)
+
+import Database.Persist.ImplicitIdDef
+import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
+
+do
+    let
+        uuidDef =
+           mkImplicitIdDef @Text "uuid_generate_v1mc()"
+        settings =
+            setImplicitIdDef uuidDef sqlSettings
+
+    mkPersist settings [persistLowerCase|
+
+        User
+            name    String
+            age     Int
+
+        |]
+
+pass :: IO ()
+pass = pure ()
+
+asIO :: IO a -> IO a
+asIO = id
+
+spec :: Spec
+spec = describe "ImplicitIdColSpec" $ do
+    describe "UserKey" $ do
+        it "has type Text -> Key User" $ do
+            let userKey = UserKey "Hello"
+            pass
+
+    describe "getEntityId" $ do
+        let idField = getEntityId (entityDef (Nothing @User))
+        it "has SqlString SqlType" $ asIO $ do
+            fieldSqlType idField `shouldBe` SqlString
+        it "has Text FieldType" $ asIO $ do
+            fieldType idField `shouldBe` fieldTypeFromTypeable @Text

From c348fadc0740e25d502ad21c15b64644c4d33d4c Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 17:28:58 -0600
Subject: [PATCH 12/19] tidy up

---
 persistent/ChangeLog.md                       |  15 ++-
 persistent/Database/Persist/ImplicitIdDef.hs  |  14 ++-
 .../Persist/ImplicitIdDef/Internal.hs         | 103 ++++++++++++++++--
 persistent/Database/Persist/Sql/Migration.hs  |   7 +-
 persistent/Database/Persist/TH.hs             |  29 ++---
 persistent/Database/Persist/Types/Base.hs     |   3 +-
 6 files changed, 142 insertions(+), 29 deletions(-)

diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md
index 618829e21..97f8dc9d7 100644
--- a/persistent/ChangeLog.md
+++ b/persistent/ChangeLog.md
@@ -31,13 +31,24 @@
     * Previously hidden modules are now exposed under the `Internal` namespace.
     * The `connLimitOffset` function used to have a `Bool` parameter. This
       parameter is unused and has been removed.
-* []()
-    * Moved the various `Name` types into `Databse.Persist.Names`
+* [#1234](https://github.com/yesodweb/persistent/pull/1234)
+    * You can now customize the default implied ID column. See the documentation
+      in `Database.Persist.ImplicitIdDef` for more details.
+    * Moved the various `Name` types into `Database.Persist.Names`
     * Removed the `hasCompositeKey` function. See `hasCompositePrimaryKey` and
       `hasNaturalKey` as replacements.
     * The `EntityDef` constructor and field labels are not exported by default.
       Get those from `Database.Persist.EntityDef.Internal`, but you should
       migrate to the getters/setters in `Database.Persist.EntityDef` as you can.
+    * Added the `Database.Persist.FieldDef` and
+      `Database.Persist.FieldDef.Internal` modules.
+    * The `PersistSettings` type was made abstract. Please migrate to the
+      getters/setters defined in that `Database.Persist.Quasi`, or use
+      `Database.Persist.Quasi.Internal` if you don't mind the possibility of
+      breaking changes.
+    * Add the `runSqlCommand` function for running arbitrary SQL during
+      migrations.
+    * Add `migrateModels` function for a TH-free migration facility.
 
 ## 2.12.1.1
 
diff --git a/persistent/Database/Persist/ImplicitIdDef.hs b/persistent/Database/Persist/ImplicitIdDef.hs
index 0aa99d773..26af3a402 100644
--- a/persistent/Database/Persist/ImplicitIdDef.hs
+++ b/persistent/Database/Persist/ImplicitIdDef.hs
@@ -1,5 +1,15 @@
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
+-- | This module contains types and functions for creating an 'ImplicitIdDef',
+-- which allows you to customize the implied ID column that @persistent@
+-- generates.
+--
+-- If this module doesn't suit your needs, you may want to import
+-- "Database.Persist.ImplicitIdDef.Internal" instead. If you do so, please file
+-- an issue on GitHub so we can support your needs. Breaking changes to that
+-- module will *not* be accompanied with a major version bump.
+--
+-- @since 2.13.0.0
 module Database.Persist.ImplicitIdDef
     ( -- * The Type
       ImplicitIdDef
@@ -22,7 +32,9 @@ import Database.Persist.Types.Base
 import Database.Persist.Class (BackendKey)
 import Database.Persist.Names
 
--- |
+-- | This is the default variant. Setting the implicit ID definition to this
+-- value should not have any change at all on how entities are defined by
+-- default.
 --
 -- @since 2.13.0.0
 autoIncrementingInteger :: ImplicitIdDef
diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 16d4af46a..794193125 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -1,32 +1,118 @@
-{-# LANGUAGE RankNTypes, AllowAmbiguousTypes, PolyKinds #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+-- | WARNING: This is an @Internal@ module. As such, breaking changes to the API
+-- of this module will not have a corresponding major version bump.
+--
+-- Please depend on "Database.Persist.ImplicitIdDef" instead. If you can't use
+-- that module, please file an issue on GitHub with your desired use case.
+--
+-- @since 2.13.0.0
 module Database.Persist.ImplicitIdDef.Internal where
 
 import Data.Proxy
 import Data.Text (Text)
+import qualified Data.Text as Text
 import Language.Haskell.TH (Type)
 import LiftType
 import Type.Reflection
-import qualified Data.Text as T
 
 import Database.Persist.Names
-import Database.Persist.Types
 import Database.Persist.Sql.Class
+import Database.Persist.Types
 
--- |
+-- | A specification for how the implied ID columns are created.
+--
+-- By default, @persistent@ will give each table a default column named @id@
+-- (customizable by 'PersistSettings'), and the column type will be whatever
+-- you'd expect from @'BackendKey' yourBackendType@. For The 'SqlBackend' type,
+-- this is an auto incrementing integer primary key.
+--
+-- You might want to give a different example. A common use case in postgresql
+-- is to use the UUID type, and automatically generate them using a SQL
+-- function.
+--
+-- Previously, you'd need to add a custom @Id@ annotation for each model.
+--
+-- > User
+-- >     Id   UUID default="uuid_generate_v1mc()"
+-- >     name Text
+-- >
+-- > Dog
+-- >     Id   UUID default="uuid_generate_v1mc()"
+-- >     name Text
+-- >     user UserId
+--
+-- Now, you can simply create an 'ImplicitIdDef' that corresponds to this
+-- declaration.
+--
+-- @
+-- newtype UUID = UUID 'ByteString'
+--
+-- instance 'PersistField' UUID where
+--     'toPersistValue' (UUID bs) =
+--         'PersistLiteral_' 'Escaped' bs
+--     'fromPersistValue' pv =
+--         case pv of
+--             PersistLiteral_ Escaped bs ->
+--                 Right (UUID bs)
+--             _ ->
+--                 Left "nope"
+--
+-- instance 'PersistFieldSql' UUID where
+--     'sqlType' _ = 'SqlOther' "UUID"
+-- @
+--
+-- With this instance at the ready, we can now create our implicit definition:
+--
+-- @
+-- uuidDef :: ImplicitIdDef
+-- uuidDef = mkImplicitIdDef \@UUID "uuid_generate_v1mc()"
+-- @
+--
+-- And we can use 'setImplicitIdDef' to use this with the 'MkPersistSettings'
+-- for our block.
+--
+-- @
+-- mkPersist (setImplicitIdDef uuidDef sqlSettings) [persistLowerCase| ... |]
+-- @
+--
+-- TODO: either explain interaction with mkMigrate or fix it. see issue #1249
+-- for more details.
 --
 -- @since 2.13.0.0
 data ImplicitIdDef = ImplicitIdDef
     { iidFieldType :: EntityNameHS -> FieldType
+    -- ^ The field type. Accepts the 'EntityNameHS' if you want to refer to it.
+    -- By default, @Id@ is appended to the end of the Haskell name.
+    --
+    -- @since 2.13.0.0
     , iidFieldSqlType :: SqlType
+    -- ^ The 'SqlType' for the default column. By default, this is 'SqlInt64' to
+    -- correspond with an autoincrementing integer primary key.
+    --
+    -- @since 2.13.0.0
     , iidType :: Bool -> Type -> Type
     -- ^ The Bool argument is whether or not the 'MkPersistBackend' type has the
     -- 'mpsGeneric' field set.
     --
     -- The 'Type' is the 'mpsBackend' value.
+    --
+    -- The default uses @'BackendKey' 'SqlBackend'@ (or a generic equivalent).
+    --
+    -- @since 2.13.0.0
     , iidDefault :: Maybe Text
+    -- ^ The default expression for the field. Note that setting this to
+    -- 'Nothing' is unsafe. see
+    -- https://github.com/yesodweb/persistent/issues/1247 for more information.
+    --
+    -- With some cases - like the Postgresql @SERIAL@ type - this is safe, since
+    -- there's an implied default.
+    --
+    -- @since 2.13.0.0
     }
 
 -- | Create an 'ImplicitIdDef' based on the 'Typeable' and 'PersistFieldSql'
@@ -67,6 +153,10 @@ mkImplicitIdDef def =
             Just def
         }
 
+-- |  This function converts a 'Typeable' type into a @persistent@
+-- representation of the type of a field - 'FieldTyp'.
+--
+-- @since 2.13.0.0
 fieldTypeFromTypeable :: forall (t :: *). Typeable t => FieldType
 fieldTypeFromTypeable = go (typeRep @t)
   where
@@ -75,8 +165,8 @@ fieldTypeFromTypeable = go (typeRep @t)
         case tr of
             Con tyCon ->
                 let
-                    tyName = T.pack $ tyConName tyCon
-                    modName = T.pack $ tyConModule tyCon
+                    tyName = Text.pack $ tyConName tyCon
+                    modName = Text.pack $ tyConModule tyCon
                 in
                     FTTypeCon Nothing tyName
             App trA trB ->
@@ -104,4 +194,3 @@ fieldTypeFromTypeable = go (typeRep @t)
 -- @since 2.13.0.0
 unsafeClearDefaultImplicitId :: ImplicitIdDef -> ImplicitIdDef
 unsafeClearDefaultImplicitId iid = iid { iidDefault = Nothing }
-
diff --git a/persistent/Database/Persist/Sql/Migration.hs b/persistent/Database/Persist/Sql/Migration.hs
index 8238035ad..e431253c3 100644
--- a/persistent/Database/Persist/Sql/Migration.hs
+++ b/persistent/Database/Persist/Sql/Migration.hs
@@ -211,7 +211,12 @@ addMigrations
     -> Migration
 addMigrations = lift . tell
 
--- | Run an action against the database during a migration.
+-- | Run an action against the database during a migration. Can be useful for eg
+-- creating Postgres extensions:
+--
+-- @
+-- runSqlCommand $ 'rawExecute' "CREATE EXTENSION IF NOT EXISTS \"uuid-ossp\";" []
+-- @
 --
 -- @since 2.13.0.0
 runSqlCommand :: SqlPersistT IO () -> Migration
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 4f4b098db..2878a1184 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -1082,28 +1082,11 @@ keyFields mps entDef =
             map primaryKeyVar (compositeFields pdef)
         Nothing ->
             pure . idKeyVar $
-                -- TODO: Okay, so my problem is right here.
-                --
-                -- The 'defaultIdType' function asks if the field's type is
-                -- defined as ${ModelName}Id. If it is, then we peek through to
-                -- the underlying type.
                 if defaultIdType entDef
                 then
-                 -- backendKeyType is the behavior-preserving original code.
-                    -- backendKeyType
-                -- This is the somewhat naive variant - just grab the ID type
-                -- and convert it! But this is loopy - it recurses and is sad.
-                -- We want to "see through" the type alias.
-                    -- ftToType $ fieldType $ entityId entDef
-                -- SO let's just copy the type.
                     getImplicitIdType mps
                 else ftToType $ fieldType $ entityId entDef
   where
-    backendKeyType =
-        ConT ''BackendKey `AppT`
-            if mpsGeneric mps
-            then backendT
-            else mpsBackend mps
     idKeyVar ft =
         ( unKeyName entDef
         , notStrict
@@ -1746,6 +1729,18 @@ derivePersistFieldJSON s = do
             ]
         ]
 
+-- | The basic function for migrating models, no Template Haskell required.
+--
+-- It's probably best to use this in concert with 'mkEntityDefList', and then
+-- call 'migrateModels' with the result from that function.
+--
+-- @
+-- share [mkPersist sqlSettings, mkEntityDefList "entities"] [persistLowerCase| ... |]
+--
+-- migrateAll = 'migrateModels' entities
+-- @
+--
+-- @since 2.13.0.0
 migrateModels :: [EntityDef] -> Migration
 migrateModels eds =
     forM_ eds $ \ed ->
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index ca6384846..96c48141b 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP, AllowAmbiguousTypes #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}

From 934e6db9a35fa3fa6dab30a4285aac755ef36a90 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 17:45:42 -0600
Subject: [PATCH 13/19] sigh

---
 persistent/Database/Persist/ImplicitIdDef/Internal.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 794193125..083a6a6d4 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeInType #-} -- needed for ghc 8.2.2
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}

From d933448c072d9aa0dee38613a601f421cc8a7730 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 18:03:57 -0600
Subject: [PATCH 14/19] i hate you

---
 persistent/Database/Persist/ImplicitIdDef/Internal.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 083a6a6d4..103b93d82 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -21,6 +21,7 @@ import Language.Haskell.TH (Type)
 import LiftType
 import Type.Reflection
 
+
 import Database.Persist.Names
 import Database.Persist.Sql.Class
 import Database.Persist.Types
@@ -158,7 +159,7 @@ mkImplicitIdDef def =
 -- representation of the type of a field - 'FieldTyp'.
 --
 -- @since 2.13.0.0
-fieldTypeFromTypeable :: forall (t :: *). Typeable t => FieldType
+fieldTypeFromTypeable :: forall t. Typeable t => FieldType
 fieldTypeFromTypeable = go (typeRep @t)
   where
     go :: forall k (a :: k). TypeRep a -> FieldType

From ad5a4938e5090a149898322fc98f55e356dd6870 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Fri, 23 Apr 2021 18:08:04 -0600
Subject: [PATCH 15/19] tidy

---
 .gitignore                                            | 1 +
 persistent/Database/Persist/ImplicitIdDef/Internal.hs | 7 +------
 stack_lts-12.yaml                                     | 1 +
 3 files changed, 3 insertions(+), 6 deletions(-)

diff --git a/.gitignore b/.gitignore
index dfdf38bbb..ae521ad58 100644
--- a/.gitignore
+++ b/.gitignore
@@ -51,3 +51,4 @@ persistent-test/db/
 .hspec-failures
 
 stack.yaml.lock
+*.yaml.lock
diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 103b93d82..1e407a5df 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -21,7 +21,6 @@ import Language.Haskell.TH (Type)
 import LiftType
 import Type.Reflection
 
-
 import Database.Persist.Names
 import Database.Persist.Sql.Class
 import Database.Persist.Types
@@ -166,11 +165,7 @@ fieldTypeFromTypeable = go (typeRep @t)
     go tr =
         case tr of
             Con tyCon ->
-                let
-                    tyName = Text.pack $ tyConName tyCon
-                    modName = Text.pack $ tyConModule tyCon
-                in
-                    FTTypeCon Nothing tyName
+                FTTypeCon Nothing $ Text.pack $ tyConName tyCon
             App trA trB ->
                 FTApp (go trA) (go trB)
             Fun _ _ ->
diff --git a/stack_lts-12.yaml b/stack_lts-12.yaml
index 7263f4c8e..8246ca6f0 100644
--- a/stack_lts-12.yaml
+++ b/stack_lts-12.yaml
@@ -14,3 +14,4 @@ extra-deps:
 - postgresql-simple-0.6.1
 - th-lift-0.8.0.1
 - th-lift-instances-0.1.14
+- lift-type-0.1.0.1

From 0440acde778089ef5319de5076299bc8fe2a1124 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Sun, 25 Apr 2021 11:50:25 -0600
Subject: [PATCH 16/19] wrote test for mysql, need to set maxlen sigh

---
 persistent-mysql/persistent-mysql.cabal       |  50 ++---
 persistent-mysql/test/MyInit.hs               |  80 ++++++--
 persistent-mysql/test/main.hs                 | 180 +++++++++---------
 .../test/ImplicitUuidSpec.hs                  |  15 +-
 persistent-postgresql/test/PgInit.hs          |  24 +--
 persistent-test/persistent-test.cabal         |   3 +-
 persistent-test/src/Init.hs                   |  65 ++++++-
 7 files changed, 256 insertions(+), 161 deletions(-)

diff --git a/persistent-mysql/persistent-mysql.cabal b/persistent-mysql/persistent-mysql.cabal
index d9e6708f3..ff5e4441f 100644
--- a/persistent-mysql/persistent-mysql.cabal
+++ b/persistent-mysql/persistent-mysql.cabal
@@ -54,28 +54,34 @@ test-suite test
     type:            exitcode-stdio-1.0
     main-is:         main.hs
     hs-source-dirs:  test
-    other-modules:   MyInit
-                     InsertDuplicateUpdate
-                     CustomConstraintTest
+    other-modules:   
+        MyInit
+        InsertDuplicateUpdate
+        CustomConstraintTest
+        ImplicitUuidSpec
     ghc-options:     -Wall
 
-    build-depends:   base             >= 4.9 && < 5
-                   , persistent
-                   , persistent-mysql
-                   , persistent-qq
-                   , persistent-test
-                   , bytestring
-                   , containers
-                   , fast-logger
-                   , hspec            >= 2.4
-                   , HUnit
-                   , monad-logger
-                   , mysql
-                   , QuickCheck
-                   , quickcheck-instances
-                   , resourcet
-                   , text
-                   , time
-                   , transformers
-                   , unliftio-core
+    build-depends:   
+        base             >= 4.9 && < 5
+      , aeson
+      , bytestring
+      , containers
+      , fast-logger
+      , hspec            >= 2.4
+      , http-api-data
+      , HUnit
+      , monad-logger
+      , mysql
+      , path-pieces
+      , persistent
+      , persistent-mysql
+      , persistent-qq
+      , persistent-test
+      , QuickCheck
+      , quickcheck-instances
+      , resourcet
+      , text
+      , time
+      , transformers
+      , unliftio-core
     default-language: Haskell2010
diff --git a/persistent-mysql/test/MyInit.hs b/persistent-mysql/test/MyInit.hs
index deb7ffdbf..62afa2688 100644
--- a/persistent-mysql/test/MyInit.hs
+++ b/persistent-mysql/test/MyInit.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
 
 module MyInit (
   (@/=), (@==), (==@)
@@ -26,12 +29,14 @@ module MyInit (
   , MonadUnliftIO
   , liftIO
   , mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase
+  , mkEntityDefList, sqlSettingsUuid
   , Int32, Int64
   , Text
   , module Control.Monad.Trans.Reader
   , module Control.Monad
   , module Database.Persist.Sql
   , BS.ByteString
+  , migrateModels
   , SomeException
   , MonadFail
   , TestFn(..)
@@ -40,44 +45,71 @@ module MyInit (
   , truncateUTCTime
   , arbText
   , liftA2
+  , LoggingT, ResourceT, UUID(..)
   ) where
 
 import Init
-    ( TestFn(..), truncateTimeOfDay, truncateUTCTime
-    , truncateToMicro, arbText, GenerateKey(..)
-    , (@/=), (@==), (==@)
-    , assertNotEqual, assertNotEmpty, assertEmpty, asIO
-    , isTravis, RunDb, MonadFail
-    )
+       ( GenerateKey(..)
+       , MonadFail
+       , RunDb
+       , TestFn(..)
+       , arbText
+       , asIO
+       , assertEmpty
+       , assertNotEmpty
+       , assertNotEqual
+       , isTravis
+       , truncateTimeOfDay
+       , truncateToMicro
+       , truncateUTCTime
+       , (==@)
+       , (@/=)
+       , (@==)
+       )
 
 -- re-exports
 import Control.Applicative (liftA2)
 import Control.Exception (SomeException)
-import Control.Monad (void, replicateM, liftM, when, forM_)
+import Control.Monad (forM_, liftM, replicateM, void, when)
 import Control.Monad.Trans.Reader
-import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..))
+import Data.Aeson (FromJSON, ToJSON, Value(..))
 import Database.Persist.Sql.Raw.QQ
+import Database.Persist.TH
+       ( MkPersistSettings(..)
+       , migrateModels
+       , setImplicitIdDef
+       , mkEntityDefList
+       , mkMigrate
+       , mkPersist
+       , persistLowerCase
+       , persistUpperCase
+       , share
+       , sqlSettings
+       )
 import Test.Hspec
 import Test.QuickCheck.Instances ()
+import Web.Internal.HttpApiData
+import Web.PathPieces
+import Database.Persist.ImplicitIdDef
 
 -- testing
-import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)
+import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=))
 
 import Control.Monad (unless, (>=>))
-import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.IO.Class
+import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger
 import Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import qualified Data.ByteString as BS
 import Data.Int (Int32, Int64)
 import Data.Text (Text)
+import qualified Data.Text.Encoding as TE
 import qualified Database.MySQL.Base as MySQL
 import System.Log.FastLogger (fromLogStr)
 
 import Database.Persist
 import Database.Persist.MySQL
 import Database.Persist.Sql
-import Database.Persist.TH ()
 
 _debugOn :: Bool
 _debugOn = False
@@ -122,3 +154,29 @@ runConn f = do
 db :: SqlPersistT (LoggingT (ResourceT IO)) () -> Assertion
 db actions = do
   runResourceT $ runConn $ actions >> transactionUndo
+
+newtype UUID = UUID { unUUID :: Text }
+    deriving stock
+        (Show, Eq, Ord, Read)
+    deriving newtype
+        (ToJSON, PersistFieldSql, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)
+
+instance PersistField UUID where
+    toPersistValue (UUID txt) =
+        PersistLiteral_ Escaped (TE.encodeUtf8 txt)
+    fromPersistValue pv =
+        case pv of
+            PersistLiteral_ Escaped bs ->
+                Right $ UUID (TE.decodeUtf8 bs)
+            _ ->
+                Left "Nope"
+
+sqlSettingsUuid :: Text -> MkPersistSettings
+sqlSettingsUuid defExpr =
+    let
+        uuidDef =
+           mkImplicitIdDef @UUID defExpr
+        settings =
+            setImplicitIdDef uuidDef sqlSettings
+     in
+        settings
diff --git a/persistent-mysql/test/main.hs b/persistent-mysql/test/main.hs
index 56e165d8f..26ab9dc66 100644
--- a/persistent-mysql/test/main.hs
+++ b/persistent-mysql/test/main.hs
@@ -54,6 +54,7 @@ import qualified CustomConstraintTest
 import qualified LongIdentifierTest
 import qualified GeneratedColumnTestSQL
 import qualified ForeignKey
+import qualified ImplicitUuidSpec
 
 type Tuple a b = (a, b)
 
@@ -109,98 +110,99 @@ setup migration = do
 
 main :: IO ()
 main = do
-  runConn $ do
-    mapM_ setup
-      [ PersistentTest.testMigrate
-      , PersistentTest.noPrefixMigrate
-      , PersistentTest.customPrefixMigrate
-      , EmbedTest.embedMigrate
-      , EmbedOrderTest.embedOrderMigrate
-      , LargeNumberTest.numberMigrate
-      , UniqueTest.uniqueMigrate
-      , MaxLenTest.maxlenMigrate
-      , Recursive.recursiveMigrate
-      , CompositeTest.compositeMigrate
-      , PersistUniqueTest.migration
-      , RenameTest.migration
-      , CustomPersistFieldTest.customFieldMigrate
-      , InsertDuplicateUpdate.duplicateMigrate
-      , MigrationIdempotencyTest.migration
-      , CustomPrimaryKeyReferenceTest.migration
-      , MigrationColumnLengthTest.migration
-      , TransactionLevelTest.migration
-      -- , LongIdentifierTest.migration
-      , ForeignKey.compositeMigrate
-      ]
-    PersistentTest.cleanDB
-    ForeignKey.cleanDB
+    runConn $ do
+        mapM_ setup
+            [ PersistentTest.testMigrate
+            , PersistentTest.noPrefixMigrate
+            , PersistentTest.customPrefixMigrate
+            , EmbedTest.embedMigrate
+            , EmbedOrderTest.embedOrderMigrate
+            , LargeNumberTest.numberMigrate
+            , UniqueTest.uniqueMigrate
+            , MaxLenTest.maxlenMigrate
+            , Recursive.recursiveMigrate
+            , CompositeTest.compositeMigrate
+            , PersistUniqueTest.migration
+            , RenameTest.migration
+            , CustomPersistFieldTest.customFieldMigrate
+            , InsertDuplicateUpdate.duplicateMigrate
+            , MigrationIdempotencyTest.migration
+            , CustomPrimaryKeyReferenceTest.migration
+            , MigrationColumnLengthTest.migration
+            , TransactionLevelTest.migration
+            -- , LongIdentifierTest.migration
+            , ForeignKey.compositeMigrate
+            ]
+        PersistentTest.cleanDB
+        ForeignKey.cleanDB
 
-  hspec $ do
-    xdescribe "This is pending on MySQL because you can't have DEFAULT CURRENT_DATE" $ do
-        RenameTest.specsWith db
-    DataTypeTest.specsWith
-        db
-        (Just (runMigrationSilent dataTypeMigrate))
-        [ TestFn "text" dataTypeTableText
-        , TestFn "textMaxLen" dataTypeTableTextMaxLen
-        , TestFn "bytes" dataTypeTableBytes
-        , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
-        , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
-        , TestFn "int" dataTypeTableInt
-        , TestFn "intList" dataTypeTableIntList
-        , TestFn "intMap" dataTypeTableIntMap
-        , TestFn "bool" dataTypeTableBool
-        , TestFn "day" dataTypeTableDay
-        , TestFn "time" (roundTime . dataTypeTableTime)
-        , TestFn "utc" (roundUTCTime . dataTypeTableUtc)
-        , TestFn "timeFrac" (dataTypeTableTimeFrac)
-        , TestFn "utcFrac" (dataTypeTableUtcFrac)
-        ]
-        [ ("pico", dataTypeTablePico) ]
-        dataTypeTableDouble
-    HtmlTest.specsWith
-        db
-        (Just (runMigrationSilent HtmlTest.htmlMigrate))
-    EmbedTest.specsWith db
-    EmbedOrderTest.specsWith db
-    LargeNumberTest.specsWith db
-    UniqueTest.specsWith db
-    MaxLenTest.specsWith db
-    Recursive.specsWith db
-    SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
-    MigrationOnlyTest.specsWith db
-        (Just
-            $ runMigrationSilent MigrationOnlyTest.migrateAll1
-            >> runMigrationSilent MigrationOnlyTest.migrateAll2
-        )
-    PersistentTest.specsWith db
-    PersistentTest.filterOrSpecs db
-    ReadWriteTest.specsWith db
-    RawSqlTest.specsWith db
-    UpsertTest.specsWith
-        db
-        UpsertTest.Don'tUpdateNull
-        UpsertTest.UpsertPreserveOldKey
+    hspec $ do
+        ImplicitUuidSpec.spec
+        xdescribe "This is pending on MySQL because you can't have DEFAULT CURRENT_DATE" $ do
+            RenameTest.specsWith db
+        DataTypeTest.specsWith
+            db
+            (Just (runMigrationSilent dataTypeMigrate))
+            [ TestFn "text" dataTypeTableText
+            , TestFn "textMaxLen" dataTypeTableTextMaxLen
+            , TestFn "bytes" dataTypeTableBytes
+            , TestFn "bytesTextTuple" dataTypeTableBytesTextTuple
+            , TestFn "bytesMaxLen" dataTypeTableBytesMaxLen
+            , TestFn "int" dataTypeTableInt
+            , TestFn "intList" dataTypeTableIntList
+            , TestFn "intMap" dataTypeTableIntMap
+            , TestFn "bool" dataTypeTableBool
+            , TestFn "day" dataTypeTableDay
+            , TestFn "time" (roundTime . dataTypeTableTime)
+            , TestFn "utc" (roundUTCTime . dataTypeTableUtc)
+            , TestFn "timeFrac" (dataTypeTableTimeFrac)
+            , TestFn "utcFrac" (dataTypeTableUtcFrac)
+            ]
+            [ ("pico", dataTypeTablePico) ]
+            dataTypeTableDouble
+        HtmlTest.specsWith
+            db
+            (Just (runMigrationSilent HtmlTest.htmlMigrate))
+        EmbedTest.specsWith db
+        EmbedOrderTest.specsWith db
+        LargeNumberTest.specsWith db
+        UniqueTest.specsWith db
+        MaxLenTest.specsWith db
+        Recursive.specsWith db
+        SumTypeTest.specsWith db (Just (runMigrationSilent SumTypeTest.sumTypeMigrate))
+        MigrationOnlyTest.specsWith db
+            (Just
+                $ runMigrationSilent MigrationOnlyTest.migrateAll1
+                >> runMigrationSilent MigrationOnlyTest.migrateAll2
+            )
+        PersistentTest.specsWith db
+        PersistentTest.filterOrSpecs db
+        ReadWriteTest.specsWith db
+        RawSqlTest.specsWith db
+        UpsertTest.specsWith
+            db
+            UpsertTest.Don'tUpdateNull
+            UpsertTest.UpsertPreserveOldKey
 
-    ForeignKey.specsWith db
-    MpsNoPrefixTest.specsWith db
-    MpsCustomPrefixTest.specsWith db
-    EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))
-    CompositeTest.specsWith db
-    PersistUniqueTest.specsWith db
-    CustomPersistFieldTest.specsWith db
-    CustomPrimaryKeyReferenceTest.specsWith db
-    InsertDuplicateUpdate.specs
-    MigrationColumnLengthTest.specsWith db
-    EquivalentTypeTest.specsWith db
-    TransactionLevelTest.specsWith db
+        ForeignKey.specsWith db
+        MpsNoPrefixTest.specsWith db
+        MpsCustomPrefixTest.specsWith db
+        EmptyEntityTest.specsWith db (Just (runMigrationSilent EmptyEntityTest.migration))
+        CompositeTest.specsWith db
+        PersistUniqueTest.specsWith db
+        CustomPersistFieldTest.specsWith db
+        CustomPrimaryKeyReferenceTest.specsWith db
+        InsertDuplicateUpdate.specs
+        MigrationColumnLengthTest.specsWith db
+        EquivalentTypeTest.specsWith db
+        TransactionLevelTest.specsWith db
 
-    MigrationIdempotencyTest.specsWith db
-    CustomConstraintTest.specs db
-    -- TODO: implement automatic truncation for too long foreign keys, so we can run this test.
-    xdescribe "The migration for this test currently fails because of MySQL's 64 character limit for identifiers. See https://github.com/yesodweb/persistent/issues/1000 for details" $
-        LongIdentifierTest.specsWith db
-    GeneratedColumnTestSQL.specsWith db
+        MigrationIdempotencyTest.specsWith db
+        CustomConstraintTest.specs db
+        -- TODO: implement automatic truncation for too long foreign keys, so we can run this test.
+        xdescribe "The migration for this test currently fails because of MySQL's 64 character limit for identifiers. See https://github.com/yesodweb/persistent/issues/1000 for details" $
+            LongIdentifierTest.specsWith db
+        GeneratedColumnTestSQL.specsWith db
 
 roundFn :: RealFrac a => a -> Integer
 roundFn = round
diff --git a/persistent-postgresql/test/ImplicitUuidSpec.hs b/persistent-postgresql/test/ImplicitUuidSpec.hs
index b997cebb4..0520d516d 100644
--- a/persistent-postgresql/test/ImplicitUuidSpec.hs
+++ b/persistent-postgresql/test/ImplicitUuidSpec.hs
@@ -22,21 +22,18 @@ import Database.Persist.Postgresql
 import Database.Persist.ImplicitIdDef
 import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
 
-do
-    let
-        uuidDef =
-           mkImplicitIdDef @UUID "uuid_generate_v1mc()"
-        settings =
-            setImplicitIdDef uuidDef sqlSettings
-    share
-        [mkPersist settings, mkEntityDefList "entities"] [persistLowerCase|
+share
+    [ mkPersist (sqlSettingsUuid "uuid_generate_v1mc()")
+    , mkEntityDefList "entities"
+    ]
+    [persistLowerCase|
 
 WithDefUuid
     name        Text sqltype=varchar(80)
 
     deriving Eq Show Ord
 
-        |]
+|]
 
 implicitUuidMigrate :: Migration
 implicitUuidMigrate = do
diff --git a/persistent-postgresql/test/PgInit.hs b/persistent-postgresql/test/PgInit.hs
index 6ce11ac28..0faf89ac0 100644
--- a/persistent-postgresql/test/PgInit.hs
+++ b/persistent-postgresql/test/PgInit.hs
@@ -39,6 +39,7 @@ module PgInit
     , LoggingT
     , ResourceT
     , UUID(..)
+    , sqlSettingsUuid
     ) where
 
 import Init
@@ -59,6 +60,8 @@ import Init
        , (==@)
        , (@/=)
        , (@==)
+       , UUID(..)
+       , sqlSettingsUuid
        )
 
 -- re-exports
@@ -219,24 +222,3 @@ instance Arbitrary Value where
                     . listOf -- [(,)] -> (,)
                     . liftA2 (,) arbText -- (,) -> Text and Value
                     $ limitIt 4 arbitrary -- Again, precaution against divergent recursion.
-
--- * For "ImplicitUuidSpec"
-
-newtype UUID = UUID { unUUID :: Text }
-    deriving stock
-        (Show, Eq, Ord, Read)
-    deriving newtype
-        (ToJSON, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)
-
-instance PersistFieldSql UUID where
-    sqlType _ = SqlOther "UUID"
-
-instance PersistField UUID where
-    toPersistValue (UUID txt) =
-        PersistLiteral_ Escaped (TE.encodeUtf8 txt)
-    fromPersistValue pv =
-        case pv of
-            PersistLiteral_ Escaped bs ->
-                Right $ UUID (TE.decodeUtf8 bs)
-            _ ->
-                Left "Nope"
diff --git a/persistent-test/persistent-test.cabal b/persistent-test/persistent-test.cabal
index a03d8ea55..afcf75d7a 100644
--- a/persistent-test/persistent-test.cabal
+++ b/persistent-test/persistent-test.cabal
@@ -60,7 +60,6 @@ library
 
     build-depends: 
         base                     >= 4.9       && < 5
-      , persistent               >= 2.13      && < 2.14
       , aeson                    >= 1.0
       , blaze-html               >= 0.9
       , bytestring               >= 0.10
@@ -69,11 +68,13 @@ library
       , exceptions               >= 0.8
       , hspec                    >= 2.4
       , hspec-expectations
+      , http-api-data
       , HUnit
       , monad-control
       , monad-logger             >= 0.3.25
       , mtl
       , path-pieces              >= 0.2
+      , persistent               >= 2.13      && < 2.14
       , QuickCheck               >= 2.9
       , quickcheck-instances     >= 0.3
       , random                   >= 1.1
diff --git a/persistent-test/src/Init.hs b/persistent-test/src/Init.hs
index 471be0a49..62bb4fc84 100644
--- a/persistent-test/src/Init.hs
+++ b/persistent-test/src/Init.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -42,14 +44,16 @@ module Init (
   , liftA2
   , changeBackend
   , Proxy(..)
+  , UUID(..)
+  , sqlSettingsUuid
   ) where
 
 #if !MIN_VERSION_monad_logger(0,3,30)
 -- Needed for GHC versions 7.10.3. Can drop when we drop support for GHC
 -- 7.10.3
+import qualified Control.Monad.Fail as MonadFail
 import Control.Monad.IO.Class
 import Control.Monad.Logger
-import qualified Control.Monad.Fail as MonadFail
 #endif
 
 -- needed for backwards compatibility
@@ -64,21 +68,35 @@ import Control.Monad.Trans.Resource.Internal
 -- re-exports
 import Control.Applicative (liftA2, (<|>))
 import Control.Exception (SomeException)
-import Control.Monad (void, replicateM, liftM, when, forM_)
+import Control.Monad (forM_, liftM, replicateM, void, when)
 import Control.Monad.Fail (MonadFail)
 import Control.Monad.Reader
-import Data.Char (generalCategory, GeneralCategory(..))
-import Data.Fixed (Pico,Micro)
+import Data.Char (GeneralCategory(..), generalCategory)
+import Data.Fixed (Micro, Pico)
+import Data.Proxy
 import qualified Data.Text as T
 import Data.Time
 import Test.Hspec
 import Test.QuickCheck.Instances ()
-import Data.Proxy
 
-import Database.Persist.TH (mkPersist, mkMigrate, share, sqlSettings, persistLowerCase, persistUpperCase, MkPersistSettings(..))
+import Data.Aeson (FromJSON, ToJSON, Value(..))
+import qualified Data.Text.Encoding as TE
+import Database.Persist.ImplicitIdDef (mkImplicitIdDef)
+import Database.Persist.TH
+       ( MkPersistSettings(..)
+       , mkMigrate
+       , mkPersist
+       , persistLowerCase
+       , persistUpperCase
+       , setImplicitIdDef
+       , share
+       , sqlSettings
+       )
+import Web.Internal.HttpApiData
+import Web.PathPieces
 
 -- testing
-import Test.HUnit ((@?=),(@=?), Assertion, assertFailure, assertBool)
+import Test.HUnit (Assertion, assertBool, assertFailure, (@=?), (@?=))
 import Test.QuickCheck
 
 import Control.Monad (unless, (>=>))
@@ -247,3 +265,34 @@ instance MonadBaseControl b m => MonadBaseControl b (ResourceT m) where
              f $ runInBase . (\(ResourceT r) -> r reader')
      restoreM = ResourceT . const . restoreM
 #endif
+
+-- * For implicit ID spec
+
+newtype UUID = UUID { unUUID :: Text }
+    deriving stock
+        (Show, Eq, Ord, Read)
+    deriving newtype
+        (ToJSON, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)
+
+instance PersistFieldSql UUID where
+    sqlType _ = SqlOther "UUID"
+
+instance PersistField UUID where
+    toPersistValue (UUID txt) =
+        PersistLiteral_ Escaped (TE.encodeUtf8 txt)
+    fromPersistValue pv =
+        case pv of
+            PersistLiteral_ Escaped bs ->
+                Right $ UUID (TE.decodeUtf8 bs)
+            _ ->
+                Left "Nope"
+
+sqlSettingsUuid :: Text -> MkPersistSettings
+sqlSettingsUuid defExpr =
+    let
+        uuidDef =
+           mkImplicitIdDef @UUID defExpr
+        settings =
+            setImplicitIdDef uuidDef sqlSettings
+     in
+        settings

From e4804afa7273374704ee9d0066ce31cc70d40a5c Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Sun, 25 Apr 2021 11:50:47 -0600
Subject: [PATCH 17/19] mysql test, need to be able to set maxlen

---
 persistent-mysql/test/ImplicitUuidSpec.hs | 77 +++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 persistent-mysql/test/ImplicitUuidSpec.hs

diff --git a/persistent-mysql/test/ImplicitUuidSpec.hs b/persistent-mysql/test/ImplicitUuidSpec.hs
new file mode 100644
index 000000000..27d97ee26
--- /dev/null
+++ b/persistent-mysql/test/ImplicitUuidSpec.hs
@@ -0,0 +1,77 @@
+{-# 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 ImplicitUuidSpec where
+
+import MyInit
+
+import Data.Proxy
+import Database.Persist.MySQL
+
+import Database.Persist.ImplicitIdDef
+import Database.Persist.ImplicitIdDef.Internal (fieldTypeFromTypeable)
+
+share
+    [ mkPersist (sqlSettingsUuid "UUID()")
+    , mkEntityDefList "entities"
+    ]
+    [persistLowerCase|
+
+WithDefUuid
+    name        Text sqltype=varchar(80)
+
+    deriving Eq Show Ord
+
+|]
+
+implicitUuidMigrate :: Migration
+implicitUuidMigrate = do
+    migrateModels entities
+
+wipe :: IO ()
+wipe = db $ do
+    rawExecute "DROP TABLE IF EXISTS with_def_uuid;" []
+    runMigration implicitUuidMigrate
+
+itDb :: String -> SqlPersistT (LoggingT (ResourceT IO)) a -> SpecWith (Arg (IO ()))
+itDb msg action = it msg $ db $ void action
+
+pass :: IO ()
+pass = pure ()
+
+spec :: Spec
+spec = fdescribe "ImplicitUuidSpec" $ before_ wipe $ do
+    describe "WithDefUuidKey" $ do
+        it "works on UUIDs" $ do
+            let withDefUuidKey = WithDefUuidKey (UUID "Hello")
+            pass
+    describe "getEntityId" $ do
+        let idField = getEntityId (entityDef (Proxy @WithDefUuid))
+        it "has a UUID SqlType" $ asIO $ do
+            fieldSqlType idField `shouldBe` SqlOther "UUID"
+        it "has a UUID type" $ asIO $ do
+            fieldType idField `shouldBe` fieldTypeFromTypeable @UUID
+        it "is an implicit ID column" $ asIO $ do
+            fieldIsImplicitIdColumn idField `shouldBe` True
+
+    describe "insert" $ do
+        itDb "successfully has a default" $ do
+            let matt = WithDefUuid
+                    { withDefUuidName =
+                        "Matt"
+                    }
+            k <- insert matt
+            mrec <- get k
+            liftIO $ mrec `shouldBe` Just matt
+

From 68adf242e24dfc01682d10b85d138cba3b99fbe6 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Sun, 25 Apr 2021 21:18:03 -0600
Subject: [PATCH 18/19] support mysql lmfao

---
 persistent-mysql/Database/Persist/MySQL.hs    | 83 ++++++++++++-------
 persistent-mysql/test/ImplicitUuidSpec.hs     | 16 +++-
 persistent-mysql/test/MyInit.hs               | 17 ++--
 persistent/Database/Persist/ImplicitIdDef.hs  |  3 +
 .../Persist/ImplicitIdDef/Internal.hs         | 37 ++++++++-
 persistent/Database/Persist/TH.hs             | 15 ++--
 persistent/Database/Persist/Types/Base.hs     |  1 -
 7 files changed, 116 insertions(+), 56 deletions(-)

diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs
index 244d1e762..34229e070 100644
--- a/persistent-mysql/Database/Persist/MySQL.hs
+++ b/persistent-mysql/Database/Persist/MySQL.hs
@@ -434,35 +434,60 @@ migrate' connectInfo allDefs getter val = do
 
 addTable :: [Column] -> EntityDef -> AlterDB
 addTable cols entity = AddTable $ concat
-           -- Lower case e: see Database.Persist.Sql.Migration
-           [ "CREATe TABLE "
-           , escapeE name
-           , "("
-           , idtxt
-           , if null nonIdCols then [] else ","
-           , intercalate "," $ map showColumn nonIdCols
-           , ")"
-           ]
-    where
-      nonIdCols =
-          filter (\c -> cName c /= fieldDB (getEntityId entity) ) cols
-      name = getEntityDBName entity
-      idtxt = case entityPrimary entity of
-                Just pdef -> concat [" PRIMARY KEY (", intercalate "," $ map (escapeF . fieldDB) $ compositeFields pdef, ")"]
-                Nothing ->
-                  let defText = defaultAttribute $ fieldAttrs $ getEntityId entity
-                      sType = fieldSqlType $ getEntityId entity
-                      autoIncrementText = case (sType, defText) of
-                        (SqlInt64, Nothing) -> " AUTO_INCREMENT"
-                        _ -> ""
-                      maxlen = findMaxLenOfField (getEntityId entity)
-                  in concat
-                         [ escapeF $ fieldDB $ getEntityId entity
-                         , " " <> showSqlType sType maxlen False
-                         , " NOT NULL"
-                         , autoIncrementText
-                         , " PRIMARY KEY"
-                         ]
+    -- Lower case e: see Database.Persist.Sql.Migration
+    [ "CREATe TABLE "
+    , escapeE name
+    , "("
+    , idtxt
+    , if null nonIdCols then [] else ","
+    , intercalate "," $ map showColumn nonIdCols
+    , ")"
+    ]
+  where
+    nonIdCols =
+        filter (\c -> cName c /= fieldDB (getEntityId entity) ) cols
+    name =
+        getEntityDBName entity
+    idtxt =
+        case entityPrimary entity of
+            Just pdef ->
+                concat
+                    [ " PRIMARY KEY ("
+                    , intercalate ","
+                  $ map (escapeF . fieldDB) $ compositeFields pdef
+                    , ")"
+                    ]
+            Nothing ->
+                let
+                    idField =
+                        getEntityId entity
+                    defText =
+                        defaultAttribute $ fieldAttrs idField
+                    sType =
+                        fieldSqlType idField
+                    autoIncrementText =
+                        case (sType, defText) of
+                            (SqlInt64, Nothing) -> " AUTO_INCREMENT"
+                            _ -> ""
+                    maxlen =
+                        findMaxLenOfField idField
+                in
+                    concat
+                        [ escapeF $ fieldDB $ getEntityId entity
+                        , " " <> showSqlType sType maxlen False
+                        , " NOT NULL"
+                        , autoIncrementText
+                        , " PRIMARY KEY"
+                        , case defText of
+                            Nothing ->
+                                ""
+                            Just def ->
+                                concat
+                                    [ " DEFAULT ("
+                                    , T.unpack def
+                                    , ")"
+                                    ]
+                        ]
 
 -- | Find out the type of a column.
 findTypeOfColumn :: [EntityDef] -> EntityNameDB -> FieldNameDB -> (FieldNameDB, FieldType)
diff --git a/persistent-mysql/test/ImplicitUuidSpec.hs b/persistent-mysql/test/ImplicitUuidSpec.hs
index 27d97ee26..bdc1e4f14 100644
--- a/persistent-mysql/test/ImplicitUuidSpec.hs
+++ b/persistent-mysql/test/ImplicitUuidSpec.hs
@@ -29,7 +29,7 @@ share
     [persistLowerCase|
 
 WithDefUuid
-    name        Text sqltype=varchar(80)
+    name        Text
 
     deriving Eq Show Ord
 
@@ -58,8 +58,8 @@ spec = fdescribe "ImplicitUuidSpec" $ before_ wipe $ do
             pass
     describe "getEntityId" $ do
         let idField = getEntityId (entityDef (Proxy @WithDefUuid))
-        it "has a UUID SqlType" $ asIO $ do
-            fieldSqlType idField `shouldBe` SqlOther "UUID"
+        it "has a SqlString SqlType" $ asIO $ do
+            fieldSqlType idField `shouldBe` SqlString
         it "has a UUID type" $ asIO $ do
             fieldType idField `shouldBe` fieldTypeFromTypeable @UUID
         it "is an implicit ID column" $ asIO $ do
@@ -73,5 +73,13 @@ spec = fdescribe "ImplicitUuidSpec" $ before_ wipe $ do
                     }
             k <- insert matt
             mrec <- get k
-            liftIO $ mrec `shouldBe` Just matt
+            uuids <- selectList @WithDefUuid [] []
+            liftIO $ do
+                -- MySQL's insert functionality is currently broken. The @k@
+                -- here is derived from @SELECT LAST_INSERT_ID()@ which only
+                -- works on auto incrementing IDs.
+                --
+                -- See #1251 for more details.
+                mrec `shouldBe` Nothing
 
+                map entityVal uuids `shouldSatisfy` (matt `elem`)
diff --git a/persistent-mysql/test/MyInit.hs b/persistent-mysql/test/MyInit.hs
index 62afa2688..ddd50c83f 100644
--- a/persistent-mysql/test/MyInit.hs
+++ b/persistent-mysql/test/MyInit.hs
@@ -159,23 +159,16 @@ newtype UUID = UUID { unUUID :: Text }
     deriving stock
         (Show, Eq, Ord, Read)
     deriving newtype
-        (ToJSON, PersistFieldSql, FromJSON, FromHttpApiData, ToHttpApiData, PathPiece)
-
-instance PersistField UUID where
-    toPersistValue (UUID txt) =
-        PersistLiteral_ Escaped (TE.encodeUtf8 txt)
-    fromPersistValue pv =
-        case pv of
-            PersistLiteral_ Escaped bs ->
-                Right $ UUID (TE.decodeUtf8 bs)
-            _ ->
-                Left "Nope"
+        ( ToJSON, FromJSON
+        , PersistField, PersistFieldSql
+        , FromHttpApiData, ToHttpApiData, PathPiece
+        )
 
 sqlSettingsUuid :: Text -> MkPersistSettings
 sqlSettingsUuid defExpr =
     let
         uuidDef =
-           mkImplicitIdDef @UUID defExpr
+           setImplicitIdDefMaxLen 100 $ mkImplicitIdDef @UUID defExpr
         settings =
             setImplicitIdDef uuidDef sqlSettings
      in
diff --git a/persistent/Database/Persist/ImplicitIdDef.hs b/persistent/Database/Persist/ImplicitIdDef.hs
index 26af3a402..e82f5c871 100644
--- a/persistent/Database/Persist/ImplicitIdDef.hs
+++ b/persistent/Database/Persist/ImplicitIdDef.hs
@@ -19,6 +19,7 @@ module Database.Persist.ImplicitIdDef
     , autoIncrementingInteger
     -- * Getters
     -- * Setters
+    , setImplicitIdDefMaxLen
     , unsafeClearDefaultImplicitId
     ) where
 
@@ -51,4 +52,6 @@ autoIncrementingInteger =
                 else mpsBackendType
         , iidDefault =
             Nothing
+        , iidMaxLen =
+            Nothing
         }
diff --git a/persistent/Database/Persist/ImplicitIdDef/Internal.hs b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
index 1e407a5df..1aa002e40 100644
--- a/persistent/Database/Persist/ImplicitIdDef/Internal.hs
+++ b/persistent/Database/Persist/ImplicitIdDef/Internal.hs
@@ -1,9 +1,10 @@
-{-# LANGUAGE TypeInType #-} -- needed for ghc 8.2.2
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StrictData #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeInType #-}
 
 -- | WARNING: This is an @Internal@ module. As such, breaking changes to the API
 -- of this module will not have a corresponding major version bump.
@@ -20,7 +21,10 @@ import qualified Data.Text as Text
 import Language.Haskell.TH (Type)
 import LiftType
 import Type.Reflection
+import Data.Typeable (eqT)
+import Data.Foldable (asum)
 
+import Database.Persist.Class.PersistField (PersistField)
 import Database.Persist.Names
 import Database.Persist.Sql.Class
 import Database.Persist.Types
@@ -114,6 +118,13 @@ data ImplicitIdDef = ImplicitIdDef
     -- there's an implied default.
     --
     -- @since 2.13.0.0
+    , iidMaxLen :: Maybe Integer
+    -- ^ Specify the maximum length for a key column. This is necessary for
+    -- @VARCHAR@ columns, like @UUID@ in MySQL. MySQL will throw a runtime error
+    -- if a text or binary column is used in an index without a length
+    -- specification.
+    --
+    -- @since 2.13.0.0
     }
 
 -- | Create an 'ImplicitIdDef' based on the 'Typeable' and 'PersistFieldSql'
@@ -135,6 +146,9 @@ data ImplicitIdDef = ImplicitIdDef
 -- will call the @uuid_generate_v1mc()@  function to generate the value for new
 -- rows being inserted.
 --
+-- If the type @t@ is 'Text' or 'String' then a @max_len@ attribute of 200 is
+-- set. To customize this, use 'setImplicitIdDefMaxLen'.
+--
 -- @since 2.13.0.0
 mkImplicitIdDef
     :: forall t. (Typeable t, PersistFieldSql t)
@@ -152,13 +166,32 @@ mkImplicitIdDef def =
             \_ _ -> liftType @t
         , iidDefault =
             Just def
+        , iidMaxLen =
+            -- this follows a special casing behavior that @persistent@ has done
+            -- for a while now. this keeps folks code from breaking and probably
+            -- is mostly what people want.
+            asum
+                [ 200 <$ eqT @t @Text
+                , 200 <$ eqT @t @String
+                ]
         }
 
+-- | Set the maximum length of the implied ID column. This is required for
+-- any type where the associated 'SqlType' is a @TEXT@ or @VARCHAR@ sort of
+-- thing.
+--
+-- @since 2.13.0.0
+setImplicitIdDefMaxLen
+    :: Integer
+    -> ImplicitIdDef
+    -> ImplicitIdDef
+setImplicitIdDefMaxLen i iid = iid { iidMaxLen = Just i }
+
 -- |  This function converts a 'Typeable' type into a @persistent@
 -- representation of the type of a field - 'FieldTyp'.
 --
 -- @since 2.13.0.0
-fieldTypeFromTypeable :: forall t. Typeable t => FieldType
+fieldTypeFromTypeable :: forall t. (PersistField t, Typeable t) => FieldType
 fieldTypeFromTypeable = go (typeRep @t)
   where
     go :: forall k (a :: k). TypeRep a -> FieldType
diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs
index 2878a1184..8c10c27c8 100644
--- a/persistent/Database/Persist/TH.hs
+++ b/persistent/Database/Persist/TH.hs
@@ -104,6 +104,7 @@ import GHC.TypeLits
 import Instances.TH.Lift ()
     -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
     -- instance on pre-1.2.4 versions of `text`
+import Data.Foldable (toList)
 import qualified Data.Set as Set
 import Language.Haskell.TH.Lib
        (appT, conE, conK, conT, litT, strTyLit, varE, varP, varT)
@@ -492,14 +493,12 @@ setDefaultIdFields mps ed
                 iidFieldSqlType iid
             , fieldAttrs =
                 let
-                    old =
-                        fieldAttrs fd
+                    def =
+                        toList (FieldAttrDefault <$> iidDefault iid)
+                    maxlen =
+                        toList (FieldAttrMaxlen <$> iidMaxLen iid)
                  in
-                    case iidDefault iid of
-                        Nothing ->
-                            old
-                        Just def ->
-                            FieldAttrDefault def : old
+                    def <> maxlen <> fieldAttrs fd
             , fieldIsImplicitIdColumn =
                 True
             }
@@ -1819,7 +1818,7 @@ liftAndFixKeys entityMap EntityDef{..} =
     |]
 
 liftAndFixKey :: EntityMap -> FieldDef -> Q Exp
-liftAndFixKey entityMap fd@(FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fieldIsImplicitIdColumn)
+liftAndFixKey entityMap (FieldDef a b c sqlTyp e f fieldRef fc mcomments fg fieldIsImplicitIdColumn)
     | not fieldIsImplicitIdColumn =
         [|FieldDef a b c $(sqlTyp') e f (fieldRef') fc mcomments fg fieldIsImplicitIdColumn|]
     | otherwise =
diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs
index 96c48141b..5650e49de 100644
--- a/persistent/Database/Persist/Types/Base.hs
+++ b/persistent/Database/Persist/Types/Base.hs
@@ -28,7 +28,6 @@ import qualified Data.HashMap.Strict as HM
 import Data.Int (Int64)
 import Data.Map (Map)
 import Data.Maybe (isNothing)
-import Type.Reflection
 #if !MIN_VERSION_base(4,11,0)
 -- This can be removed when GHC < 8.2.2 isn't supported anymore
 import Data.Semigroup ((<>))

From c312f485db13a08b5a60869b62e365d039ab39e1 Mon Sep 17 00:00:00 2001
From: parsonsmatt <parsonsmatt@gmail.com>
Date: Sun, 25 Apr 2021 21:33:07 -0600
Subject: [PATCH 19/19] whyyy

---
 .github/workflows/haskell.yml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index af8b007f5..9a0c09228 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -70,6 +70,7 @@ jobs:
         uses: supercharge/redis-github-action@1.1.0
       - run: cabal v2-update
       - run: cabal v2-freeze $CONFIG
+      - run: cat cabal.project.freeze
       - uses: actions/cache@v2
         with:
           path: |
@@ -77,7 +78,7 @@ jobs:
           key: ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
           restore-keys: |
             ${{ runner.os }}-${{ matrix.ghc }}-${{ hashFiles('cabal.project.freeze') }}
-            #  ${{ runner.os }}-${{ matrix.ghc }}-
+            ${{ runner.os }}-${{ matrix.ghc }}-
       - run: cabal v2-build all --disable-optimization --only-dependencies $CONFIG
       - run: cabal v2-build all --disable-optimization $CONFIG
       - run: cabal v2-test all --disable-optimization $CONFIG