Removing duplication from TH output

[danbroooks]

Before submitting your PR, check that you've:

• Documented new APIs with Haddock markup
• Added @since declarations to the Haddock

After submitting your PR:

• Update the Changelog.md file with a link to your PR
• Bumped the version number if there isn't an (unreleased) on the Changelog
• Check that CI passes (or if it fails, for reasons unrelated to your change, like CI timeouts)

---

I'm submitting this draft PR for some initial feedback, as I think I have found a potential optimisation which drops some duplication from the resulting Haskell output. The FieldDefs are accessible already via persistFieldDef so I thought it might bring down the total code output by making that call to get at the field defs when building up the EntityDef, rather than inlining the definitions. I'm not sure if there are implications to this so would appreciate some feedback if this is going to have negative effects, but AFAICT this is a reasonable change to make, though there may be some reason why this isn't done like this currently. I'm not sure on how much of a difference this will make to improved compile times but every little helps I suppose, and I think this will have an impact on a real world project where the are a large total number of fields.

I'm not majorly keen on the implementation of fieldDefReferences, where it conditionally looks up the persistFieldDef function, specifically having to write error, there might be a nicer way to do this with TH but was unable to figure it out, so resorted to the implementation currently.

Below is the diff of the dump-splices files of the persist-template tests before and after this change

diff --git a/persistent-template/OverloadedLabelTest.dump-splices b/persistent-template/OverloadedLabelTest.dump-splices
index e157c29b..026b74a5 100644
--- a/persistent-template/OverloadedLabelTest.dump-splices
+++ b/persistent-template/OverloadedLabelTest.dump-splices
@@ -534,55 +534,36 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "name")))
-                             (FieldNameDB (Data.Text.pack "name")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (Data.Text.pack "age")))
-                             (FieldNameDB (Data.Text.pack "age")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "Int")))
-                           SqlInt64)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef UserName, persistFieldDef UserAge])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (User x_aKxA x_aKxB)
-        = [SomePersistField x_aKxA, SomePersistField x_aKxB]
-      fromPersistValues [x1_aKxD, x2_aKxE]
+      toPersistFields (User x_aKro x_aKrp)
+        = [SomePersistField x_aKro, SomePersistField x_aKrp]
+      fromPersistValues [x1_aKrr, x2_aKrs]
         = User
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "User")) (Data.Text.pack "name"))
                  . fromPersistValue)
-                x1_aKxD
+                x1_aKrr
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "User")) (Data.Text.pack "age"))
                  . fromPersistValue)
-                x2_aKxE
-      fromPersistValues x_aKxC
+                x2_aKrs
+      fromPersistValues x_aKrq
         = (Left
              $ (mappend (Data.Text.pack "User: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_aKxC))
+                 (Data.Text.pack $ show x_aKrq))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (User _name_aKxF _age_aKxG) = []
+      persistUniqueKeys (User _name_aKrt _age_aKru) = []
       persistFieldDef UserId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "Id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -621,15 +602,15 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
       persistIdField = UserId
       fieldLens UserId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aKxH) key_aKxI -> (Entity key_aKxI) value_aKxH)
+            (\ (Entity _ value_aKrv) key_aKrw -> (Entity key_aKrw) value_aKrv)
       fieldLens UserName
         = (lensPTH (userName . entityVal))
-            (\ (Entity key_aKxJ value_aKxK) x_aKxL
-               -> (Entity key_aKxJ) value_aKxK {userName = x_aKxL})
+            (\ (Entity key_aKrx value_aKry) x_aKrz
+               -> (Entity key_aKrx) value_aKry {userName = x_aKrz})
       fieldLens UserAge
         = (lensPTH (userAge . entityVal))
-            (\ (Entity key_aKxJ value_aKxK) x_aKxL
-               -> (Entity key_aKxJ) value_aKxK {userAge = x_aKxL})
+            (\ (Entity key_aKrx value_aKry) x_aKrz
+               -> (Entity key_aKrx) value_aKry {userAge = x_aKrz})
     instance ToBackendKey SqlBackend User where
       toBackendKey = unUserKey
       fromBackendKey = UserKey
@@ -679,73 +660,43 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "userId")))
-                             (FieldNameDB (Data.Text.pack "userId")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "UserId")))
-                           (sqlType (Data.Proxy.Proxy :: Data.Proxy.Proxy GHC.Int.Int64)))
-                          [])
-                         True)
-                        ((ForeignRef (EntityNameHS (Data.Text.pack "User")))
-                           ((FTTypeCon (Just (Data.Text.pack "Data.Int")))
-                              (Data.Text.pack "Int64"))))
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (Data.Text.pack "name")))
-                             (FieldNameDB (Data.Text.pack "name")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (Data.Text.pack "age")))
-                             (FieldNameDB (Data.Text.pack "age")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "Int")))
-                           SqlInt64)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef DogUserId, persistFieldDef DogName,
+                   persistFieldDef DogAge])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Dog x_aKxM x_aKxN x_aKxO)
-        = [SomePersistField x_aKxM, SomePersistField x_aKxN,
-           SomePersistField x_aKxO]
-      fromPersistValues [x1_aKxQ, x2_aKxR, x3_aKxS]
+      toPersistFields (Dog x_aKrA x_aKrB x_aKrC)
+        = [SomePersistField x_aKrA, SomePersistField x_aKrB,
+           SomePersistField x_aKrC]
+      fromPersistValues [x1_aKrE, x2_aKrF, x3_aKrG]
         = Dog
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "Dog")) (Data.Text.pack "userId"))
                  . fromPersistValue)
-                x1_aKxQ
+                x1_aKrE
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "Dog")) (Data.Text.pack "name"))
                  . fromPersistValue)
-                x2_aKxR
+                x2_aKrF
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "Dog")) (Data.Text.pack "age"))
                  . fromPersistValue)
-                x3_aKxS
-      fromPersistValues x_aKxP
+                x3_aKrG
+      fromPersistValues x_aKrD
         = (Left
              $ (mappend (Data.Text.pack "Dog: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_aKxP))
+                 (Data.Text.pack $ show x_aKrD))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Dog _userId_aKxT _name_aKxU _age_aKxV) = []
+      persistUniqueKeys (Dog _userId_aKrH _name_aKrI _age_aKrJ) = []
       persistFieldDef DogId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "Id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -797,19 +748,19 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
       persistIdField = DogId
       fieldLens DogId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aKxW) key_aKxX -> (Entity key_aKxX) value_aKxW)
+            (\ (Entity _ value_aKrK) key_aKrL -> (Entity key_aKrL) value_aKrK)
       fieldLens DogUserId
         = (lensPTH (dogUserId . entityVal))
-            (\ (Entity key_aKxY value_aKxZ) x_aKy0
-               -> (Entity key_aKxY) value_aKxZ {dogUserId = x_aKy0})
+            (\ (Entity key_aKrM value_aKrN) x_aKrO
+               -> (Entity key_aKrM) value_aKrN {dogUserId = x_aKrO})
       fieldLens DogName
         = (lensPTH (dogName . entityVal))
-            (\ (Entity key_aKxY value_aKxZ) x_aKy0
-               -> (Entity key_aKxY) value_aKxZ {dogName = x_aKy0})
+            (\ (Entity key_aKrM value_aKrN) x_aKrO
+               -> (Entity key_aKrM) value_aKrN {dogName = x_aKrO})
       fieldLens DogAge
         = (lensPTH (dogAge . entityVal))
-            (\ (Entity key_aKxY value_aKxZ) x_aKy0
-               -> (Entity key_aKxY) value_aKxZ {dogAge = x_aKy0})
+            (\ (Entity key_aKrM value_aKrN) x_aKrO
+               -> (Entity key_aKrM) value_aKrN {dogAge = x_aKrO})
     instance ToBackendKey SqlBackend Dog where
       toBackendKey = unDogKey
       fromBackendKey = DogKey
@@ -856,41 +807,32 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "name")))
-                             (FieldNameDB (Data.Text.pack "name")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef OrganizationName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Organization x_aKy1) = [SomePersistField x_aKy1]
-      fromPersistValues [x1_aKy3]
+      toPersistFields (Organization x_aKrP) = [SomePersistField x_aKrP]
+      fromPersistValues [x1_aKrR]
         = Organization
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "Organization"))
                     (Data.Text.pack "name"))
                  . fromPersistValue)
-                x1_aKy3
-      fromPersistValues x_aKy2
+                x1_aKrR
+      fromPersistValues x_aKrQ
         = (Left
              $ (mappend
                   (Data.Text.pack "Organization: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_aKy2))
+                 (Data.Text.pack $ show x_aKrQ))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Organization _name_aKy4) = []
+      persistUniqueKeys (Organization _name_aKrS) = []
       persistFieldDef OrganizationId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "Id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -918,11 +860,11 @@ test/OverloadedLabelTest.hs:(20,1)-(34,2): Splicing declarations
       persistIdField = OrganizationId
       fieldLens OrganizationId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aKy5) key_aKy6 -> (Entity key_aKy6) value_aKy5)
+            (\ (Entity _ value_aKrT) key_aKrU -> (Entity key_aKrU) value_aKrT)
       fieldLens OrganizationName
         = (lensPTH (organizationName . entityVal))
-            (\ (Entity key_aKy7 value_aKy8) x_aKy9
-               -> (Entity key_aKy7) value_aKy8 {organizationName = x_aKy9})
+            (\ (Entity key_aKrV value_aKrW) x_aKrX
+               -> (Entity key_aKrV) value_aKrW {organizationName = x_aKrX})
     instance ToBackendKey SqlBackend Organization where
       toBackendKey = unOrganizationKey
       fromBackendKey = OrganizationKey
diff --git a/persistent-template/SharedPrimaryKeyTest.dump-splices b/persistent-template/SharedPrimaryKeyTest.dump-splices
index 3287710d..6ebf4076 100644
--- a/persistent-template/SharedPrimaryKeyTest.dump-splices
+++ b/persistent-template/SharedPrimaryKeyTest.dump-splices
@@ -293,39 +293,30 @@ test/SharedPrimaryKeyTest.hs:(25,1)-(39,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "name")))
-                             (FieldNameDB (Data.Text.pack "name")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef UserName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (User x_at3K) = [SomePersistField x_at3K]
-      fromPersistValues [x1_at3M]
+      toPersistFields (User x_at3O) = [SomePersistField x_at3O]
+      fromPersistValues [x1_at3Q]
         = User
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "user")) (Data.Text.pack "name"))
                  . fromPersistValue)
-                x1_at3M
-      fromPersistValues x_at3L
+                x1_at3Q
+      fromPersistValues x_at3P
         = (Left
              $ (mappend (Data.Text.pack "User: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_at3L))
+                 (Data.Text.pack $ show x_at3P))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (User _name_at3N) = []
+      persistUniqueKeys (User _name_at3R) = []
       persistFieldDef UserId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "Id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -353,11 +344,11 @@ test/SharedPrimaryKeyTest.hs:(25,1)-(39,2): Splicing declarations
       persistIdField = UserId
       fieldLens UserId
         = (lensPTH entityKey)
-            (\ (Entity _ value_at3O) key_at3P -> (Entity key_at3P) value_at3O)
+            (\ (Entity _ value_at3S) key_at3T -> (Entity key_at3T) value_at3S)
       fieldLens UserName
         = (lensPTH (userName . entityVal))
-            (\ (Entity key_at3Q value_at3R) x_at3S
-               -> (Entity key_at3Q) value_at3R {userName = x_at3S})
+            (\ (Entity key_at3U value_at3V) x_at3W
+               -> (Entity key_at3U) value_at3V {userName = x_at3W})
     instance ToBackendKey SqlBackend User where
       toBackendKey = unUserKey
       fromBackendKey = UserKey
@@ -403,40 +394,31 @@ test/SharedPrimaryKeyTest.hs:(25,1)-(39,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "email")))
-                             (FieldNameDB (Data.Text.pack "email")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef ProfileEmail])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Profile x_at3T) = [SomePersistField x_at3T]
-      fromPersistValues [x1_at3V]
+      toPersistFields (Profile x_at3X) = [SomePersistField x_at3X]
+      fromPersistValues [x1_at3Z]
         = Profile
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "profile")) (Data.Text.pack "email"))
                  . fromPersistValue)
-                x1_at3V
-      fromPersistValues x_at3U
+                x1_at3Z
+      fromPersistValues x_at3Y
         = (Left
              $ (mappend
                   (Data.Text.pack "Profile: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_at3U))
+                 (Data.Text.pack $ show x_at3Y))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Profile _email_at3W) = []
+      persistUniqueKeys (Profile _email_at40) = []
       persistFieldDef ProfileId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -465,11 +447,11 @@ test/SharedPrimaryKeyTest.hs:(25,1)-(39,2): Splicing declarations
       persistIdField = ProfileId
       fieldLens ProfileId
         = (lensPTH entityKey)
-            (\ (Entity _ value_at3X) key_at3Y -> (Entity key_at3Y) value_at3X)
+            (\ (Entity _ value_at41) key_at42 -> (Entity key_at42) value_at41)
       fieldLens ProfileEmail
         = (lensPTH (profileEmail . entityVal))
-            (\ (Entity key_at3Z value_at40) x_at41
-               -> (Entity key_at3Z) value_at40 {profileEmail = x_at41})
+            (\ (Entity key_at43 value_at44) x_at45
+               -> (Entity key_at43) value_at44 {profileEmail = x_at45})
     instance GHC.TypeLits.TypeError (NoUniqueKeysError User) =>
              OnlyOneUniqueKey User where
       onlyUniqueP _ = error "impossible"
diff --git a/persistent-template/SharedPrimaryKeyTestImported.dump-splices b/persistent-template/SharedPrimaryKeyTestImported.dump-splices
index 537c26fd..57dbdcf3 100644
--- a/persistent-template/SharedPrimaryKeyTestImported.dump-splices
+++ b/persistent-template/SharedPrimaryKeyTestImported.dump-splices
@@ -162,40 +162,31 @@ test/SharedPrimaryKeyTestImported.hs:(27,1)-(33,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (Data.Text.pack "email")))
-                             (FieldNameDB (Data.Text.pack "email")))
-                            ((FTTypeCon Nothing) (Data.Text.pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef ProfileEmail])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Profile x_aFye) = [SomePersistField x_aFye]
-      fromPersistValues [x1_aFyg]
+      toPersistFields (Profile x_aFu6) = [SomePersistField x_aFu6]
+      fromPersistValues [x1_aFu8]
         = Profile
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (Data.Text.pack "profile")) (Data.Text.pack "email"))
                  . fromPersistValue)
-                x1_aFyg
-      fromPersistValues x_aFyf
+                x1_aFu8
+      fromPersistValues x_aFu7
         = (Left
              $ (mappend
                   (Data.Text.pack "Profile: fromPersistValues failed on: "))
-                 (Data.Text.pack $ show x_aFyf))
+                 (Data.Text.pack $ show x_aFu7))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Profile _email_aFyh) = []
+      persistUniqueKeys (Profile _email_aFu9) = []
       persistFieldDef ProfileId
         = (((((((((FieldDef (FieldNameHS (Data.Text.pack "id")))
                     (FieldNameDB (Data.Text.pack "id")))
@@ -222,11 +213,11 @@ test/SharedPrimaryKeyTestImported.hs:(27,1)-(33,2): Splicing declarations
       persistIdField = ProfileId
       fieldLens ProfileId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aFyi) key_aFyj -> (Entity key_aFyj) value_aFyi)
+            (\ (Entity _ value_aFua) key_aFub -> (Entity key_aFub) value_aFua)
       fieldLens ProfileEmail
         = (lensPTH (profileEmail . entityVal))
-            (\ (Entity key_aFyk value_aFyl) x_aFym
-               -> (Entity key_aFyk) value_aFyl {profileEmail = x_aFym})
+            (\ (Entity key_aFuc value_aFud) x_aFue
+               -> (Entity key_aFuc) value_aFud {profileEmail = x_aFue})
     instance GHC.TypeLits.TypeError (NoUniqueKeysError Profile) =>
              OnlyOneUniqueKey Profile where
       onlyUniqueP _ = error "impossible"
diff --git a/persistent-template/main.dump-splices b/persistent-template/main.dump-splices
index 2a9d4539..156e251f 100644
--- a/persistent-template/main.dump-splices
+++ b/persistent-template/main.dump-splices
@@ -736,91 +736,49 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [pack "json"])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "age")))
-                             (FieldNameDB (pack "age")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [FieldAttrMaybe])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "foo")))
-                             (FieldNameDB (pack "foo")))
-                            ((FTTypeCon Nothing) (pack "Foo")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "address")))
-                             (FieldNameDB (pack "address")))
-                            ((FTTypeCon Nothing) (pack "Address")))
-                           SqlString)
-                          [])
-                         True)
-                        (EmbedRef
-                           ((EmbedEntityDef (EntityNameHS (pack "Address")))
-                              [((EmbedFieldDef (FieldNameDB (pack "street"))) Nothing) Nothing,
-                               ((EmbedFieldDef (FieldNameDB (pack "city"))) Nothing) Nothing,
-                               ((EmbedFieldDef (FieldNameDB (pack "zip"))) Nothing) Nothing])))
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef PersonName, persistFieldDef PersonAge,
+                   persistFieldDef PersonFoo, persistFieldDef PersonAddress])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Person x_aX4X x_aX4Y x_aX4Z x_aX50)
-        = [SomePersistField x_aX4X, SomePersistField x_aX4Y,
-           SomePersistField x_aX4Z, SomePersistField x_aX50]
-      fromPersistValues [x1_aX52, x2_aX53, x3_aX54, x4_aX55]
+      toPersistFields (Person x_aWR4 x_aWR5 x_aWR6 x_aWR7)
+        = [SomePersistField x_aWR4, SomePersistField x_aWR5,
+           SomePersistField x_aWR6, SomePersistField x_aWR7]
+      fromPersistValues [x1_aWR9, x2_aWRa, x3_aWRb, x4_aWRc]
         = Person
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Person")) (pack "name"))
                  . fromPersistValue)
-                x1_aX52
+                x1_aWR9
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Person")) (pack "age"))
                  . fromPersistValue)
-                x2_aX53
+                x2_aWRa
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Person")) (pack "foo"))
                  . fromPersistValue)
-                x3_aX54
+                x3_aWRb
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Person")) (pack "address"))
                  . fromPersistValue)
-                x4_aX55
-      fromPersistValues x_aX51
+                x4_aWRc
+      fromPersistValues x_aWR8
         = (Left
              $ (mappend (pack "Person: fromPersistValues failed on: "))
-                 (pack $ show x_aX51))
+                 (pack $ show x_aWR8))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
       persistUniqueKeys
-        (Person _name_aX56 _age_aX57 _foo_aX58 _address_aX59)
+        (Person _name_aWRd _age_aWRe _foo_aWRf _address_aWRg)
         = []
       persistFieldDef PersonId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
@@ -885,23 +843,23 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
       persistIdField = PersonId
       fieldLens PersonId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aX5a) key_aX5b -> (Entity key_aX5b) value_aX5a)
+            (\ (Entity _ value_aWRh) key_aWRi -> (Entity key_aWRi) value_aWRh)
       fieldLens PersonName
         = (lensPTH (personName . entityVal))
-            (\ (Entity key_aX5c value_aX5d) x_aX5e
-               -> (Entity key_aX5c) value_aX5d {personName = x_aX5e})
+            (\ (Entity key_aWRj value_aWRk) x_aWRl
+               -> (Entity key_aWRj) value_aWRk {personName = x_aWRl})
       fieldLens PersonAge
         = (lensPTH (personAge . entityVal))
-            (\ (Entity key_aX5c value_aX5d) x_aX5e
-               -> (Entity key_aX5c) value_aX5d {personAge = x_aX5e})
+            (\ (Entity key_aWRj value_aWRk) x_aWRl
+               -> (Entity key_aWRj) value_aWRk {personAge = x_aWRl})
       fieldLens PersonFoo
         = (lensPTH (personFoo . entityVal))
-            (\ (Entity key_aX5c value_aX5d) x_aX5e
-               -> (Entity key_aX5c) value_aX5d {personFoo = x_aX5e})
+            (\ (Entity key_aWRj value_aWRk) x_aWRl
+               -> (Entity key_aWRj) value_aWRk {personFoo = x_aWRl})
       fieldLens PersonAddress
         = (lensPTH (personAddress . entityVal))
-            (\ (Entity key_aX5c value_aX5d) x_aX5e
-               -> (Entity key_aX5c) value_aX5d {personAddress = x_aX5e})
+            (\ (Entity key_aWRj value_aWRk) x_aWRl
+               -> (Entity key_aWRj) value_aWRk {personAddress = x_aWRl})
     instance ToBackendKey SqlBackend Person where
       toBackendKey = unPersonKey
       fromBackendKey = PersonKey
@@ -950,42 +908,32 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "person")))
-                             (FieldNameDB (pack "person")))
-                            ((FTTypeCon Nothing) (pack "PersonId")))
-                           (sqlType (Proxy :: Proxy Int64)))
-                          [])
-                         True)
-                        ((ForeignRef (EntityNameHS (pack "Person")))
-                           ((FTTypeCon (Just (pack "Data.Int"))) (pack "Int64"))))
-                       ((FieldCascade Nothing) (Just Cascade)))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasSimpleCascadeRefPerson])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasSimpleCascadeRef x_aX5f)
-        = [SomePersistField x_aX5f]
-      fromPersistValues [x1_aX5h]
+      toPersistFields (HasSimpleCascadeRef x_aWRm)
+        = [SomePersistField x_aWRm]
+      fromPersistValues [x1_aWRo]
         = HasSimpleCascadeRef
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "HasSimpleCascadeRef")) (pack "person"))
                  . fromPersistValue)
-                x1_aX5h
-      fromPersistValues x_aX5g
+                x1_aWRo
+      fromPersistValues x_aWRn
         = (Left
              $ (mappend
                   (pack "HasSimpleCascadeRef: fromPersistValues failed on: "))
-                 (pack $ show x_aX5g))
+                 (pack $ show x_aWRn))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (HasSimpleCascadeRef _person_aX5i) = []
+      persistUniqueKeys (HasSimpleCascadeRef _person_aWRp) = []
       persistFieldDef HasSimpleCascadeRefId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -1013,12 +961,12 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
       persistIdField = HasSimpleCascadeRefId
       fieldLens HasSimpleCascadeRefId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aX5j) key_aX5k -> (Entity key_aX5k) value_aX5j)
+            (\ (Entity _ value_aWRq) key_aWRr -> (Entity key_aWRr) value_aWRq)
       fieldLens HasSimpleCascadeRefPerson
         = (lensPTH (hasSimpleCascadeRefPerson . entityVal))
-            (\ (Entity key_aX5l value_aX5m) x_aX5n
-               -> (Entity key_aX5l)
-                    value_aX5m {hasSimpleCascadeRefPerson = x_aX5n})
+            (\ (Entity key_aWRs value_aWRt) x_aWRu
+               -> (Entity key_aWRs)
+                    value_aWRt {hasSimpleCascadeRefPerson = x_aWRu})
     instance ToBackendKey SqlBackend HasSimpleCascadeRef where
       toBackendKey = unHasSimpleCascadeRefKey
       fromBackendKey = HasSimpleCascadeRefKey
@@ -1070,71 +1018,43 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [pack "json"])
-                  [(((((((((FieldDef (FieldNameHS (pack "street")))
-                             (FieldNameDB (pack "street")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "city")))
-                             (FieldNameDB (pack "city")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "zip")))
-                             (FieldNameDB (pack "zip")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [FieldAttrMaybe])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef AddressStreet, persistFieldDef AddressCity,
+                   persistFieldDef AddressZip])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Address x_aX5o x_aX5p x_aX5q)
-        = [SomePersistField x_aX5o, SomePersistField x_aX5p,
-           SomePersistField x_aX5q]
-      fromPersistValues [x1_aX5s, x2_aX5t, x3_aX5u]
+      toPersistFields (Address x_aWRv x_aWRw x_aWRx)
+        = [SomePersistField x_aWRv, SomePersistField x_aWRw,
+           SomePersistField x_aWRx]
+      fromPersistValues [x1_aWRz, x2_aWRA, x3_aWRB]
         = Address
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Address")) (pack "street"))
                  . fromPersistValue)
-                x1_aX5s
+                x1_aWRz
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Address")) (pack "city"))
                  . fromPersistValue)
-                x2_aX5t
+                x2_aWRA
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "Address")) (pack "zip"))
                  . fromPersistValue)
-                x3_aX5u
-      fromPersistValues x_aX5r
+                x3_aWRB
+      fromPersistValues x_aWRy
         = (Left
              $ (mappend (pack "Address: fromPersistValues failed on: "))
-                 (pack $ show x_aX5r))
+                 (pack $ show x_aWRy))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Address _street_aX5v _city_aX5w _zip_aX5x) = []
+      persistUniqueKeys (Address _street_aWRC _city_aWRD _zip_aWRE) = []
       persistFieldDef AddressId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -1183,19 +1103,19 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
       persistIdField = AddressId
       fieldLens AddressId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aX5y) key_aX5z -> (Entity key_aX5z) value_aX5y)
+            (\ (Entity _ value_aWRF) key_aWRG -> (Entity key_aWRG) value_aWRF)
       fieldLens AddressStreet
         = (lensPTH (addressStreet . entityVal))
-            (\ (Entity key_aX5A value_aX5B) x_aX5C
-               -> (Entity key_aX5A) value_aX5B {addressStreet = x_aX5C})
+            (\ (Entity key_aWRH value_aWRI) x_aWRJ
+               -> (Entity key_aWRH) value_aWRI {addressStreet = x_aWRJ})
       fieldLens AddressCity
         = (lensPTH (addressCity . entityVal))
-            (\ (Entity key_aX5A value_aX5B) x_aX5C
-               -> (Entity key_aX5A) value_aX5B {addressCity = x_aX5C})
+            (\ (Entity key_aWRH value_aWRI) x_aWRJ
+               -> (Entity key_aWRH) value_aWRI {addressCity = x_aWRJ})
       fieldLens AddressZip
         = (lensPTH (addressZip . entityVal))
-            (\ (Entity key_aX5A value_aX5B) x_aX5C
-               -> (Entity key_aX5A) value_aX5B {addressZip = x_aX5C})
+            (\ (Entity key_aWRH value_aWRI) x_aWRJ
+               -> (Entity key_aWRH) value_aWRI {addressZip = x_aWRJ})
     instance ToBackendKey SqlBackend Address where
       toBackendKey = unAddressKey
       fromBackendKey = AddressKey
@@ -1242,39 +1162,30 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "foo")))
-                             (FieldNameDB (pack "foo")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef NoJsonFoo])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (NoJson x_aX5D) = [SomePersistField x_aX5D]
-      fromPersistValues [x1_aX5F]
+      toPersistFields (NoJson x_aWRK) = [SomePersistField x_aWRK]
+      fromPersistValues [x1_aWRM]
         = NoJson
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "NoJson")) (pack "foo"))
                  . fromPersistValue)
-                x1_aX5F
-      fromPersistValues x_aX5E
+                x1_aWRM
+      fromPersistValues x_aWRL
         = (Left
              $ (mappend (pack "NoJson: fromPersistValues failed on: "))
-                 (pack $ show x_aX5E))
+                 (pack $ show x_aWRL))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (NoJson _foo_aX5G) = []
+      persistUniqueKeys (NoJson _foo_aWRN) = []
       persistFieldDef NoJsonId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -1301,40 +1212,40 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
       persistIdField = NoJsonId
       fieldLens NoJsonId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aX5H) key_aX5I -> (Entity key_aX5I) value_aX5H)
+            (\ (Entity _ value_aWRO) key_aWRP -> (Entity key_aWRP) value_aWRO)
       fieldLens NoJsonFoo
         = (lensPTH (noJsonFoo . entityVal))
-            (\ (Entity key_aX5J value_aX5K) x_aX5L
-               -> (Entity key_aX5J) value_aX5K {noJsonFoo = x_aX5L})
+            (\ (Entity key_aWRQ value_aWRR) x_aWRS
+               -> (Entity key_aWRQ) value_aWRR {noJsonFoo = x_aWRS})
     instance ToBackendKey SqlBackend NoJson where
       toBackendKey = unNoJsonKey
       fromBackendKey = NoJsonKey
     instance ToJSON Person where
-      toJSON (Person name_aX5N age_aX5O foo_aX5P address_aX5Q)
+      toJSON (Person name_aWRU age_aWRV foo_aWRW address_aWRX)
         = object
-            [(pack "name" .= name_aX5N), (pack "age" .= age_aX5O),
-             (pack "foo" .= foo_aX5P), (pack "address" .= address_aX5Q)]
+            [(pack "name" .= name_aWRU), (pack "age" .= age_aWRV),
+             (pack "foo" .= foo_aWRW), (pack "address" .= address_aWRX)]
     instance FromJSON Person where
-      parseJSON (Object obj_aX5M)
-        = ((((pure Person <*> (obj_aX5M .: pack "name"))
-               <*> (obj_aX5M .:? pack "age"))
-              <*> (obj_aX5M .: pack "foo"))
-             <*> (obj_aX5M .: pack "address"))
+      parseJSON (Object obj_aWRT)
+        = ((((pure Person <*> (obj_aWRT .: pack "name"))
+               <*> (obj_aWRT .:? pack "age"))
+              <*> (obj_aWRT .: pack "foo"))
+             <*> (obj_aWRT .: pack "address"))
       parseJSON _ = GHC.Base.mzero
     instance ToJSON (Entity Person) where
       toJSON = entityIdToJSON
     instance FromJSON (Entity Person) where
       parseJSON = entityIdFromJSON
     instance ToJSON Address where
-      toJSON (Address street_aX5S city_aX5T zip_aX5U)
+      toJSON (Address street_aWRZ city_aWS0 zip_aWS1)
         = object
-            [(pack "street" .= street_aX5S), (pack "city" .= city_aX5T),
-             (pack "zip" .= zip_aX5U)]
+            [(pack "street" .= street_aWRZ), (pack "city" .= city_aWS0),
+             (pack "zip" .= zip_aWS1)]
     instance FromJSON Address where
-      parseJSON (Object obj_aX5R)
-        = (((pure Address <*> (obj_aX5R .: pack "street"))
-              <*> (obj_aX5R .: pack "city"))
-             <*> (obj_aX5R .:? pack "zip"))
+      parseJSON (Object obj_aWRY)
+        = (((pure Address <*> (obj_aWRY .: pack "street"))
+              <*> (obj_aWRY .: pack "city"))
+             <*> (obj_aWRY .:? pack "zip"))
       parseJSON _ = GHC.Base.mzero
     instance ToJSON (Entity Address) where
       toJSON = entityIdToJSON
@@ -1385,22 +1296,22 @@ test/main.hs:(52,1)-(73,2): Splicing declarations
     instance (PersistQuery backend,
               PersistEntityBackend Person ~ BaseBackend backend) =>
              DeleteCascade Person backend where
-      deleteCascade key_aX5V
+      deleteCascade key_aWS2
         = do deleteCascadeWhere
-               [((Filter HasSimpleCascadeRefPerson) (FilterValue key_aX5V)) Eq]
-             delete key_aX5V
+               [((Filter HasSimpleCascadeRefPerson) (FilterValue key_aWS2)) Eq]
+             delete key_aWS2
     instance (PersistQuery backend,
               PersistEntityBackend HasSimpleCascadeRef ~ BaseBackend backend) =>
              DeleteCascade HasSimpleCascadeRef backend where
-      deleteCascade key_aX5W = do delete key_aX5W
+      deleteCascade key_aWS3 = do delete key_aWS3
     instance (PersistQuery backend,
               PersistEntityBackend Address ~ BaseBackend backend) =>
              DeleteCascade Address backend where
-      deleteCascade key_aX5X = do delete key_aX5X
+      deleteCascade key_aWS4 = do delete key_aWS4
     instance (PersistQuery backend,
               PersistEntityBackend NoJson ~ BaseBackend backend) =>
              DeleteCascade NoJson backend where
-      deleteCascade key_aX5Y = do delete key_aX5Y
+      deleteCascade key_aWS5 = do delete key_aWS5
 test/main.hs:(75,41)-(108,2): Splicing expression
     template-haskell-2.14.0.0:Language.Haskell.TH.Quote.quoteExp
       persistLowerCase
@@ -2577,21 +2488,21 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
           typ ~ Int => HasPrimaryDefUserId |
           typ ~ String => HasPrimaryDefName
       keyToValues record = [toPersistValue (unHasPrimaryDefKey record)]
-      keyFromValues [x1_aZL0]
+      keyFromValues [x1_aZwP]
         = HasPrimaryDefKey
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_primary_def")) (pack "userId"))
                  . fromPersistValue)
-                x1_aZL0
-      keyFromValues x_aZKZ
+                x1_aZwP
+      keyFromValues x_aZwO
         = (Left
              $ (mappend (pack "HasPrimaryDef: keyFromValues failed on: "))
-                 (pack $ show x_aZKZ))
+                 (pack $ show x_aZwO))
       keyFromRecordM
         = Just
-            (\ record_aZL6
-               -> HasPrimaryDefKey (hasPrimaryDefUserId record_aZL6))
+            (\ record_aZwV
+               -> HasPrimaryDefKey (hasPrimaryDefUserId record_aZwV))
       entityDef _
         = ((((((((((EntityDef (EntityNameHS (pack "HasPrimaryDef")))
                      (EntityNameDB (pack "has_primary_def")))
@@ -2618,55 +2529,37 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "userId")))
-                             (FieldNameDB (pack "user_id")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasPrimaryDefUserId,
+                   persistFieldDef HasPrimaryDefName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasPrimaryDef x_aZKS x_aZKT)
-        = [SomePersistField x_aZKS, SomePersistField x_aZKT]
-      fromPersistValues [x1_aZKV, x2_aZKW]
+      toPersistFields (HasPrimaryDef x_aZwH x_aZwI)
+        = [SomePersistField x_aZwH, SomePersistField x_aZwI]
+      fromPersistValues [x1_aZwK, x2_aZwL]
         = HasPrimaryDef
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_primary_def")) (pack "userId"))
                  . fromPersistValue)
-                x1_aZKV
+                x1_aZwK
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_primary_def")) (pack "name"))
                  . fromPersistValue)
-                x2_aZKW
-      fromPersistValues x_aZKU
+                x2_aZwL
+      fromPersistValues x_aZwJ
         = (Left
              $ (mappend (pack "HasPrimaryDef: fromPersistValues failed on: "))
-                 (pack $ show x_aZKU))
+                 (pack $ show x_aZwJ))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (HasPrimaryDef _userId_aZKX _name_aZKY) = []
+      persistUniqueKeys (HasPrimaryDef _userId_aZwM _name_aZwN) = []
       persistFieldDef HasPrimaryDefId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -2715,15 +2608,15 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = HasPrimaryDefId
       fieldLens HasPrimaryDefId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZL1) key_aZL2 -> (Entity key_aZL2) value_aZL1)
+            (\ (Entity _ value_aZwQ) key_aZwR -> (Entity key_aZwR) value_aZwQ)
       fieldLens HasPrimaryDefUserId
         = (lensPTH (hasPrimaryDefUserId . entityVal))
-            (\ (Entity key_aZL3 value_aZL4) x_aZL5
-               -> (Entity key_aZL3) value_aZL4 {hasPrimaryDefUserId = x_aZL5})
+            (\ (Entity key_aZwS value_aZwT) x_aZwU
+               -> (Entity key_aZwS) value_aZwT {hasPrimaryDefUserId = x_aZwU})
       fieldLens HasPrimaryDefName
         = (lensPTH (hasPrimaryDefName . entityVal))
-            (\ (Entity key_aZL3 value_aZL4) x_aZL5
-               -> (Entity key_aZL3) value_aZL4 {hasPrimaryDefName = x_aZL5})
+            (\ (Entity key_aZwS value_aZwT) x_aZwU
+               -> (Entity key_aZwS) value_aZwT {hasPrimaryDefName = x_aZwU})
     data HasMultipleColPrimaryDef
       = HasMultipleColPrimaryDef {hasMultipleColPrimaryDefFoobar :: !Int,
                                   hasMultipleColPrimaryDefBarbaz :: !String}
@@ -2746,31 +2639,31 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       keyToValues record
         = [toPersistValue (hasMultipleColPrimaryDefKeyfoobar record),
            toPersistValue (hasMultipleColPrimaryDefKeybarbaz record)]
-      keyFromValues [x1_aZLh, x2_aZLi]
+      keyFromValues [x1_aZx6, x2_aZx7]
         = HasMultipleColPrimaryDefKey
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_multiple_col_primary_def"))
                     (pack "foobar"))
                  . fromPersistValue)
-                x1_aZLh
+                x1_aZx6
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_multiple_col_primary_def"))
                     (pack "barbaz"))
                  . fromPersistValue)
-                x2_aZLi
-      keyFromValues x_aZLg
+                x2_aZx7
+      keyFromValues x_aZx5
         = (Left
              $ (mappend
                   (pack "HasMultipleColPrimaryDef: keyFromValues failed on: "))
-                 (pack $ show x_aZLg))
+                 (pack $ show x_aZx5))
       keyFromRecordM
         = Just
-            (\ record_aZLo
+            (\ record_aZxd
                -> (HasMultipleColPrimaryDefKey
-                     (hasMultipleColPrimaryDefFoobar record_aZLo))
-                    (hasMultipleColPrimaryDefBarbaz record_aZLo))
+                     (hasMultipleColPrimaryDefFoobar record_aZxd))
+                    (hasMultipleColPrimaryDefBarbaz record_aZxd))
       entityDef _
         = ((((((((((EntityDef
                       (EntityNameHS (pack "HasMultipleColPrimaryDef")))
@@ -2808,59 +2701,41 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "foobar")))
-                             (FieldNameDB (pack "foobar")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "barbaz")))
-                             (FieldNameDB (pack "barbaz")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasMultipleColPrimaryDefFoobar,
+                   persistFieldDef HasMultipleColPrimaryDefBarbaz])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasMultipleColPrimaryDef x_aZL7 x_aZL8)
-        = [SomePersistField x_aZL7, SomePersistField x_aZL8]
-      fromPersistValues [x1_aZLa, x2_aZLb]
+      toPersistFields (HasMultipleColPrimaryDef x_aZwW x_aZwX)
+        = [SomePersistField x_aZwW, SomePersistField x_aZwX]
+      fromPersistValues [x1_aZwZ, x2_aZx0]
         = HasMultipleColPrimaryDef
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_multiple_col_primary_def"))
                     (pack "foobar"))
                  . fromPersistValue)
-                x1_aZLa
+                x1_aZwZ
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_multiple_col_primary_def"))
                     (pack "barbaz"))
                  . fromPersistValue)
-                x2_aZLb
-      fromPersistValues x_aZL9
+                x2_aZx0
+      fromPersistValues x_aZwY
         = (Left
              $ (mappend
                   (pack "HasMultipleColPrimaryDef: fromPersistValues failed on: "))
-                 (pack $ show x_aZL9))
+                 (pack $ show x_aZwY))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
       persistUniqueKeys
-        (HasMultipleColPrimaryDef _foobar_aZLc _barbaz_aZLd)
+        (HasMultipleColPrimaryDef _foobar_aZx1 _barbaz_aZx2)
         = []
       persistFieldDef HasMultipleColPrimaryDefId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
@@ -2920,24 +2795,24 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = HasMultipleColPrimaryDefId
       fieldLens HasMultipleColPrimaryDefId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZLj) key_aZLk -> (Entity key_aZLk) value_aZLj)
+            (\ (Entity _ value_aZx8) key_aZx9 -> (Entity key_aZx9) value_aZx8)
       fieldLens HasMultipleColPrimaryDefFoobar
         = (lensPTH (hasMultipleColPrimaryDefFoobar . entityVal))
-            (\ (Entity key_aZLl value_aZLm) x_aZLn
-               -> (Entity key_aZLl)
-                    value_aZLm {hasMultipleColPrimaryDefFoobar = x_aZLn})
+            (\ (Entity key_aZxa value_aZxb) x_aZxc
+               -> (Entity key_aZxa)
+                    value_aZxb {hasMultipleColPrimaryDefFoobar = x_aZxc})
       fieldLens HasMultipleColPrimaryDefBarbaz
         = (lensPTH (hasMultipleColPrimaryDefBarbaz . entityVal))
-            (\ (Entity key_aZLl value_aZLm) x_aZLn
-               -> (Entity key_aZLl)
-                    value_aZLm {hasMultipleColPrimaryDefBarbaz = x_aZLn})
+            (\ (Entity key_aZxa value_aZxb) x_aZxc
+               -> (Entity key_aZxa)
+                    value_aZxb {hasMultipleColPrimaryDefBarbaz = x_aZxc})
     instance PersistField (Key HasMultipleColPrimaryDef) where
       toPersistValue = (PersistList . keyToValues)
-      fromPersistValue (PersistList l_aZLe) = keyFromValues l_aZLe
-      fromPersistValue got_aZLf
+      fromPersistValue (PersistList l_aZx3) = keyFromValues l_aZx3
+      fromPersistValue got_aZx4
         = (error
              $ ("fromPersistValue: expected PersistList, got: "
-                  `mappend` show got_aZLf))
+                  `mappend` show got_aZx4))
     instance PersistFieldSql (Key HasMultipleColPrimaryDef) where
       sqlType _ = SqlString
     instance ToJSON (Key HasMultipleColPrimaryDef)
@@ -2982,39 +2857,30 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasIdDefName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasIdDef x_aZLp) = [SomePersistField x_aZLp]
-      fromPersistValues [x1_aZLr]
+      toPersistFields (HasIdDef x_aZxe) = [SomePersistField x_aZxe]
+      fromPersistValues [x1_aZxg]
         = HasIdDef
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_id_def")) (pack "name"))
                  . fromPersistValue)
-                x1_aZLr
-      fromPersistValues x_aZLq
+                x1_aZxg
+      fromPersistValues x_aZxf
         = (Left
              $ (mappend (pack "HasIdDef: fromPersistValues failed on: "))
-                 (pack $ show x_aZLq))
+                 (pack $ show x_aZxf))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (HasIdDef _name_aZLs) = []
+      persistUniqueKeys (HasIdDef _name_aZxh) = []
       persistFieldDef HasIdDefId
         = (((((((((FieldDef (FieldNameHS (pack "id")))
                     (FieldNameDB (pack "id")))
@@ -3041,11 +2907,11 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = HasIdDefId
       fieldLens HasIdDefId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZLt) key_aZLu -> (Entity key_aZLu) value_aZLt)
+            (\ (Entity _ value_aZxi) key_aZxj -> (Entity key_aZxj) value_aZxi)
       fieldLens HasIdDefName
         = (lensPTH (hasIdDefName . entityVal))
-            (\ (Entity key_aZLv value_aZLw) x_aZLx
-               -> (Entity key_aZLv) value_aZLw {hasIdDefName = x_aZLx})
+            (\ (Entity key_aZxk value_aZxl) x_aZxm
+               -> (Entity key_aZxk) value_aZxl {hasIdDefName = x_aZxm})
     data HasDefaultId = HasDefaultId {hasDefaultIdName :: !String}
     type HasDefaultIdId = Key HasDefaultId
     instance PersistEntity HasDefaultId where
@@ -3087,39 +2953,30 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasDefaultIdName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasDefaultId x_aZLy) = [SomePersistField x_aZLy]
-      fromPersistValues [x1_aZLA]
+      toPersistFields (HasDefaultId x_aZxn) = [SomePersistField x_aZxn]
+      fromPersistValues [x1_aZxp]
         = HasDefaultId
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_default_id")) (pack "name"))
                  . fromPersistValue)
-                x1_aZLA
-      fromPersistValues x_aZLz
+                x1_aZxp
+      fromPersistValues x_aZxo
         = (Left
              $ (mappend (pack "HasDefaultId: fromPersistValues failed on: "))
-                 (pack $ show x_aZLz))
+                 (pack $ show x_aZxo))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (HasDefaultId _name_aZLB) = []
+      persistUniqueKeys (HasDefaultId _name_aZxq) = []
       persistFieldDef HasDefaultIdId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -3146,11 +3003,11 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = HasDefaultIdId
       fieldLens HasDefaultIdId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZLC) key_aZLD -> (Entity key_aZLD) value_aZLC)
+            (\ (Entity _ value_aZxr) key_aZxs -> (Entity key_aZxs) value_aZxr)
       fieldLens HasDefaultIdName
         = (lensPTH (hasDefaultIdName . entityVal))
-            (\ (Entity key_aZLE value_aZLF) x_aZLG
-               -> (Entity key_aZLE) value_aZLF {hasDefaultIdName = x_aZLG})
+            (\ (Entity key_aZxt value_aZxu) x_aZxv
+               -> (Entity key_aZxt) value_aZxu {hasDefaultIdName = x_aZxv})
     instance ToBackendKey SqlBackend HasDefaultId where
       toBackendKey = unHasDefaultIdKey
       fromBackendKey = HasDefaultIdKey
@@ -3196,39 +3053,30 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef HasCustomSqlIdName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (HasCustomSqlId x_aZLH) = [SomePersistField x_aZLH]
-      fromPersistValues [x1_aZLJ]
+      toPersistFields (HasCustomSqlId x_aZxw) = [SomePersistField x_aZxw]
+      fromPersistValues [x1_aZxy]
         = HasCustomSqlId
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "has_custom_sql_id")) (pack "name"))
                  . fromPersistValue)
-                x1_aZLJ
-      fromPersistValues x_aZLI
+                x1_aZxy
+      fromPersistValues x_aZxx
         = (Left
              $ (mappend (pack "HasCustomSqlId: fromPersistValues failed on: "))
-                 (pack $ show x_aZLI))
+                 (pack $ show x_aZxx))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (HasCustomSqlId _name_aZLK) = []
+      persistUniqueKeys (HasCustomSqlId _name_aZxz) = []
       persistFieldDef HasCustomSqlIdId
         = (((((((((FieldDef (FieldNameHS (pack "id")))
                     (FieldNameDB (pack "my_id")))
@@ -3255,11 +3103,11 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = HasCustomSqlIdId
       fieldLens HasCustomSqlIdId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZLL) key_aZLM -> (Entity key_aZLM) value_aZLL)
+            (\ (Entity _ value_aZxA) key_aZxB -> (Entity key_aZxB) value_aZxA)
       fieldLens HasCustomSqlIdName
         = (lensPTH (hasCustomSqlIdName . entityVal))
-            (\ (Entity key_aZLN value_aZLO) x_aZLP
-               -> (Entity key_aZLN) value_aZLO {hasCustomSqlIdName = x_aZLP})
+            (\ (Entity key_aZxC value_aZxD) x_aZxE
+               -> (Entity key_aZxC) value_aZxD {hasCustomSqlIdName = x_aZxE})
     data SharedPrimaryKey
       = SharedPrimaryKey {sharedPrimaryKeyName :: !String}
     type SharedPrimaryKeyId = Key SharedPrimaryKey
@@ -3304,41 +3152,32 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef SharedPrimaryKeyName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (SharedPrimaryKey x_aZLQ)
-        = [SomePersistField x_aZLQ]
-      fromPersistValues [x1_aZLS]
+      toPersistFields (SharedPrimaryKey x_aZxF)
+        = [SomePersistField x_aZxF]
+      fromPersistValues [x1_aZxH]
         = SharedPrimaryKey
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "shared_primary_key")) (pack "name"))
                  . fromPersistValue)
-                x1_aZLS
-      fromPersistValues x_aZLR
+                x1_aZxH
+      fromPersistValues x_aZxG
         = (Left
              $ (mappend
                   (pack "SharedPrimaryKey: fromPersistValues failed on: "))
-                 (pack $ show x_aZLR))
+                 (pack $ show x_aZxG))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (SharedPrimaryKey _name_aZLT) = []
+      persistUniqueKeys (SharedPrimaryKey _name_aZxI) = []
       persistFieldDef SharedPrimaryKeyId
         = (((((((((FieldDef (FieldNameHS (pack "id")))
                     (FieldNameDB (pack "id")))
@@ -3367,11 +3206,11 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = SharedPrimaryKeyId
       fieldLens SharedPrimaryKeyId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZLU) key_aZLV -> (Entity key_aZLV) value_aZLU)
+            (\ (Entity _ value_aZxJ) key_aZxK -> (Entity key_aZxK) value_aZxJ)
       fieldLens SharedPrimaryKeyName
         = (lensPTH (sharedPrimaryKeyName . entityVal))
-            (\ (Entity key_aZLW value_aZLX) x_aZLY
-               -> (Entity key_aZLW) value_aZLX {sharedPrimaryKeyName = x_aZLY})
+            (\ (Entity key_aZxL value_aZxM) x_aZxN
+               -> (Entity key_aZxL) value_aZxM {sharedPrimaryKeyName = x_aZxN})
     data SharedPrimaryKeyWithCascade
       = SharedPrimaryKeyWithCascade {sharedPrimaryKeyWithCascadeName :: !String}
     type SharedPrimaryKeyWithCascadeId =
@@ -3420,43 +3259,34 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef SharedPrimaryKeyWithCascadeName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (SharedPrimaryKeyWithCascade x_aZLZ)
-        = [SomePersistField x_aZLZ]
-      fromPersistValues [x1_aZM1]
+      toPersistFields (SharedPrimaryKeyWithCascade x_aZxO)
+        = [SomePersistField x_aZxO]
+      fromPersistValues [x1_aZxQ]
         = SharedPrimaryKeyWithCascade
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "shared_primary_key_with_cascade"))
                     (pack "name"))
                  . fromPersistValue)
-                x1_aZM1
-      fromPersistValues x_aZM0
+                x1_aZxQ
+      fromPersistValues x_aZxP
         = (Left
              $ (mappend
                   (pack
                      "SharedPrimaryKeyWithCascade: fromPersistValues failed on: "))
-                 (pack $ show x_aZM0))
+                 (pack $ show x_aZxP))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (SharedPrimaryKeyWithCascade _name_aZM2) = []
+      persistUniqueKeys (SharedPrimaryKeyWithCascade _name_aZxR) = []
       persistFieldDef SharedPrimaryKeyWithCascadeId
         = (((((((((FieldDef (FieldNameHS (pack "id")))
                     (FieldNameDB (pack "id")))
@@ -3485,12 +3315,12 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = SharedPrimaryKeyWithCascadeId
       fieldLens SharedPrimaryKeyWithCascadeId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZM3) key_aZM4 -> (Entity key_aZM4) value_aZM3)
+            (\ (Entity _ value_aZxS) key_aZxT -> (Entity key_aZxT) value_aZxS)
       fieldLens SharedPrimaryKeyWithCascadeName
         = (lensPTH (sharedPrimaryKeyWithCascadeName . entityVal))
-            (\ (Entity key_aZM5 value_aZM6) x_aZM7
-               -> (Entity key_aZM5)
-                    value_aZM6 {sharedPrimaryKeyWithCascadeName = x_aZM7})
+            (\ (Entity key_aZxU value_aZxV) x_aZxW
+               -> (Entity key_aZxU)
+                    value_aZxV {sharedPrimaryKeyWithCascadeName = x_aZxW})
     data SharedPrimaryKeyWithCascadeAndCustomName
       = SharedPrimaryKeyWithCascadeAndCustomName {sharedPrimaryKeyWithCascadeAndCustomNameName :: !String}
     type SharedPrimaryKeyWithCascadeAndCustomNameId =
@@ -3542,25 +3372,16 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "String")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef SharedPrimaryKeyWithCascadeAndCustomNameName])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (SharedPrimaryKeyWithCascadeAndCustomName x_aZM8)
-        = [SomePersistField x_aZM8]
-      fromPersistValues [x1_aZMa]
+      toPersistFields (SharedPrimaryKeyWithCascadeAndCustomName x_aZxX)
+        = [SomePersistField x_aZxX]
+      fromPersistValues [x1_aZxZ]
         = SharedPrimaryKeyWithCascadeAndCustomName
             <$>
               (Database.Persist.TH.mapLeft
@@ -3568,19 +3389,19 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
                      (pack "shared_primary_key_with_cascade_and_custom_name"))
                     (pack "name"))
                  . fromPersistValue)
-                x1_aZMa
-      fromPersistValues x_aZM9
+                x1_aZxZ
+      fromPersistValues x_aZxY
         = (Left
              $ (mappend
                   (pack
                      "SharedPrimaryKeyWithCascadeAndCustomName: fromPersistValues failed on: "))
-                 (pack $ show x_aZM9))
+                 (pack $ show x_aZxY))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
       persistUniqueKeys
-        (SharedPrimaryKeyWithCascadeAndCustomName _name_aZMb)
+        (SharedPrimaryKeyWithCascadeAndCustomName _name_aZy0)
         = []
       persistFieldDef SharedPrimaryKeyWithCascadeAndCustomNameId
         = (((((((((FieldDef (FieldNameHS (pack "id")))
@@ -3611,13 +3432,13 @@ test/main.hs:(75,1)-(108,2): Splicing declarations
       persistIdField = SharedPrimaryKeyWithCascadeAndCustomNameId
       fieldLens SharedPrimaryKeyWithCascadeAndCustomNameId
         = (lensPTH entityKey)
-            (\ (Entity _ value_aZMc) key_aZMd -> (Entity key_aZMd) value_aZMc)
+            (\ (Entity _ value_aZy1) key_aZy2 -> (Entity key_aZy2) value_aZy1)
       fieldLens SharedPrimaryKeyWithCascadeAndCustomNameName
         = (lensPTH
              (sharedPrimaryKeyWithCascadeAndCustomNameName . entityVal))
-            (\ (Entity key_aZMe value_aZMf) x_aZMg
-               -> (Entity key_aZMe)
-                    value_aZMf {sharedPrimaryKeyWithCascadeAndCustomNameName = x_aZMg})
+            (\ (Entity key_aZy3 value_aZy4) x_aZy5
+               -> (Entity key_aZy3)
+                    value_aZy4 {sharedPrimaryKeyWithCascadeAndCustomNameName = x_aZy5})
     instance GHC.TypeLits.TypeError (NoUniqueKeysError HasPrimaryDef) =>
              OnlyOneUniqueKey HasPrimaryDef where
       onlyUniqueP _ = error "impossible"
@@ -4305,75 +4126,43 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [pack "json"])
-                  [(((((((((FieldDef (FieldNameHS (pack "name")))
-                             (FieldNameDB (pack "name")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "age")))
-                             (FieldNameDB (pack "age")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [FieldAttrMaybe])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "address")))
-                             (FieldNameDB (pack "address")))
-                            ((FTTypeCon Nothing) (pack "Laddress")))
-                           SqlString)
-                          [])
-                         True)
-                        (EmbedRef
-                           ((EmbedEntityDef (EntityNameHS (pack "Laddress")))
-                              [((EmbedFieldDef (FieldNameDB (pack "street"))) Nothing) Nothing,
-                               ((EmbedFieldDef (FieldNameDB (pack "city"))) Nothing) Nothing,
-                               ((EmbedFieldDef (FieldNameDB (pack "zip"))) Nothing) Nothing])))
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef LpersonName, persistFieldDef LpersonAge,
+                   persistFieldDef LpersonAddress])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Lperson x_a12Us x_a12Ut x_a12Uu)
-        = [SomePersistField x_a12Us, SomePersistField x_a12Ut,
-           SomePersistField x_a12Uu]
-      fromPersistValues [x1_a12Uw, x2_a12Ux, x3_a12Uy]
+      toPersistFields (Lperson x_a12Gh x_a12Gi x_a12Gj)
+        = [SomePersistField x_a12Gh, SomePersistField x_a12Gi,
+           SomePersistField x_a12Gj]
+      fromPersistValues [x1_a12Gl, x2_a12Gm, x3_a12Gn]
         = Lperson
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "lperson")) (pack "name"))
                  . fromPersistValue)
-                x1_a12Uw
+                x1_a12Gl
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "lperson")) (pack "age"))
                  . fromPersistValue)
-                x2_a12Ux
+                x2_a12Gm
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "lperson")) (pack "address"))
                  . fromPersistValue)
-                x3_a12Uy
-      fromPersistValues x_a12Uv
+                x3_a12Gn
+      fromPersistValues x_a12Gk
         = (Left
              $ (mappend (pack "Lperson: fromPersistValues failed on: "))
-                 (pack $ show x_a12Uv))
+                 (pack $ show x_a12Gk))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Lperson _name_a12Uz _age_a12UA _address_a12UB)
+      persistUniqueKeys (Lperson _name_a12Go _age_a12Gp _address_a12Gq)
         = []
       persistFieldDef LpersonId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
@@ -4427,43 +4216,43 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
       persistIdField = LpersonId
       fieldLens LpersonId
         = (lensPTH entityKey)
-            (\ (Entity _ value_a12UC) key_a12UD
-               -> (Entity key_a12UD) value_a12UC)
+            (\ (Entity _ value_a12Gr) key_a12Gs
+               -> (Entity key_a12Gs) value_a12Gr)
       fieldLens LpersonName
         = (lensPTH (_lpersonName . entityVal))
-            (\ (Entity key_a12UE value_a12UF) x_a12UG
-               -> (Entity key_a12UE) value_a12UF {_lpersonName = x_a12UG})
+            (\ (Entity key_a12Gt value_a12Gu) x_a12Gv
+               -> (Entity key_a12Gt) value_a12Gu {_lpersonName = x_a12Gv})
       fieldLens LpersonAge
         = (lensPTH (_lpersonAge . entityVal))
-            (\ (Entity key_a12UE value_a12UF) x_a12UG
-               -> (Entity key_a12UE) value_a12UF {_lpersonAge = x_a12UG})
+            (\ (Entity key_a12Gt value_a12Gu) x_a12Gv
+               -> (Entity key_a12Gt) value_a12Gu {_lpersonAge = x_a12Gv})
       fieldLens LpersonAddress
         = (lensPTH (_lpersonAddress . entityVal))
-            (\ (Entity key_a12UE value_a12UF) x_a12UG
-               -> (Entity key_a12UE) value_a12UF {_lpersonAddress = x_a12UG})
+            (\ (Entity key_a12Gt value_a12Gu) x_a12Gv
+               -> (Entity key_a12Gt) value_a12Gu {_lpersonAddress = x_a12Gv})
     lpersonName ::
       forall f. Functor f => (Text -> f Text) -> Lperson -> f Lperson
-    lpersonName f_a12UJ a_a12UK
-      = (fmap setter_a12UI) (f_a12UJ needle_a12UH)
+    lpersonName f_a12Gy a_a12Gz
+      = (fmap setter_a12Gx) (f_a12Gy needle_a12Gw)
       where
-          needle_a12UH = _lpersonName a_a12UK
-          setter_a12UI y_a12UL = a_a12UK {_lpersonName = y_a12UL}
+          needle_a12Gw = _lpersonName a_a12Gz
+          setter_a12Gx y_a12GA = a_a12Gz {_lpersonName = y_a12GA}
     lpersonAge ::
       forall f.
       Functor f => (Maybe Int -> f (Maybe Int)) -> Lperson -> f Lperson
-    lpersonAge f_a12UO a_a12UP
-      = (fmap setter_a12UN) (f_a12UO needle_a12UM)
+    lpersonAge f_a12GD a_a12GE
+      = (fmap setter_a12GC) (f_a12GD needle_a12GB)
       where
-          needle_a12UM = _lpersonAge a_a12UP
-          setter_a12UN y_a12UQ = a_a12UP {_lpersonAge = y_a12UQ}
+          needle_a12GB = _lpersonAge a_a12GE
+          setter_a12GC y_a12GF = a_a12GE {_lpersonAge = y_a12GF}
     lpersonAddress ::
       forall f.
       Functor f => (Laddress -> f Laddress) -> Lperson -> f Lperson
-    lpersonAddress f_a12UT a_a12UU
-      = (fmap setter_a12US) (f_a12UT needle_a12UR)
+    lpersonAddress f_a12GI a_a12GJ
+      = (fmap setter_a12GH) (f_a12GI needle_a12GG)
       where
-          needle_a12UR = _lpersonAddress a_a12UU
-          setter_a12US y_a12UV = a_a12UU {_lpersonAddress = y_a12UV}
+          needle_a12GG = _lpersonAddress a_a12GJ
+          setter_a12GH y_a12GK = a_a12GJ {_lpersonAddress = y_a12GK}
     instance ToBackendKey SqlBackend Lperson where
       toBackendKey = unLpersonKey
       fromBackendKey = LpersonKey
@@ -4514,71 +4303,43 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [pack "json"])
-                  [(((((((((FieldDef (FieldNameHS (pack "street")))
-                             (FieldNameDB (pack "street")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "city")))
-                             (FieldNameDB (pack "city")))
-                            ((FTTypeCon Nothing) (pack "Text")))
-                           SqlString)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing,
-                   (((((((((FieldDef (FieldNameHS (pack "zip")))
-                             (FieldNameDB (pack "zip")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [FieldAttrMaybe])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef LaddressStreet, persistFieldDef LaddressCity,
+                   persistFieldDef LaddressZip])
                  [])
                 [])
                [pack "Show", pack "Eq"])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (Laddress x_a12UW x_a12UX x_a12UY)
-        = [SomePersistField x_a12UW, SomePersistField x_a12UX,
-           SomePersistField x_a12UY]
-      fromPersistValues [x1_a12V0, x2_a12V1, x3_a12V2]
+      toPersistFields (Laddress x_a12GL x_a12GM x_a12GN)
+        = [SomePersistField x_a12GL, SomePersistField x_a12GM,
+           SomePersistField x_a12GN]
+      fromPersistValues [x1_a12GP, x2_a12GQ, x3_a12GR]
         = Laddress
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "laddress")) (pack "street"))
                  . fromPersistValue)
-                x1_a12V0
+                x1_a12GP
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "laddress")) (pack "city"))
                  . fromPersistValue)
-                x2_a12V1
+                x2_a12GQ
             <*>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "laddress")) (pack "zip"))
                  . fromPersistValue)
-                x3_a12V2
-      fromPersistValues x_a12UZ
+                x3_a12GR
+      fromPersistValues x_a12GO
         = (Left
              $ (mappend (pack "Laddress: fromPersistValues failed on: "))
-                 (pack $ show x_a12UZ))
+                 (pack $ show x_a12GO))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (Laddress _street_a12V3 _city_a12V4 _zip_a12V5)
+      persistUniqueKeys (Laddress _street_a12GS _city_a12GT _zip_a12GU)
         = []
       persistFieldDef LaddressId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
@@ -4628,42 +4389,42 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
       persistIdField = LaddressId
       fieldLens LaddressId
         = (lensPTH entityKey)
-            (\ (Entity _ value_a12V6) key_a12V7
-               -> (Entity key_a12V7) value_a12V6)
+            (\ (Entity _ value_a12GV) key_a12GW
+               -> (Entity key_a12GW) value_a12GV)
       fieldLens LaddressStreet
         = (lensPTH (_laddressStreet . entityVal))
-            (\ (Entity key_a12V8 value_a12V9) x_a12Va
-               -> (Entity key_a12V8) value_a12V9 {_laddressStreet = x_a12Va})
+            (\ (Entity key_a12GX value_a12GY) x_a12GZ
+               -> (Entity key_a12GX) value_a12GY {_laddressStreet = x_a12GZ})
       fieldLens LaddressCity
         = (lensPTH (_laddressCity . entityVal))
-            (\ (Entity key_a12V8 value_a12V9) x_a12Va
-               -> (Entity key_a12V8) value_a12V9 {_laddressCity = x_a12Va})
+            (\ (Entity key_a12GX value_a12GY) x_a12GZ
+               -> (Entity key_a12GX) value_a12GY {_laddressCity = x_a12GZ})
       fieldLens LaddressZip
         = (lensPTH (_laddressZip . entityVal))
-            (\ (Entity key_a12V8 value_a12V9) x_a12Va
-               -> (Entity key_a12V8) value_a12V9 {_laddressZip = x_a12Va})
+            (\ (Entity key_a12GX value_a12GY) x_a12GZ
+               -> (Entity key_a12GX) value_a12GY {_laddressZip = x_a12GZ})
     laddressStreet ::
       forall f. Functor f => (Text -> f Text) -> Laddress -> f Laddress
-    laddressStreet f_a12Vd a_a12Ve
-      = (fmap setter_a12Vc) (f_a12Vd needle_a12Vb)
+    laddressStreet f_a12H2 a_a12H3
+      = (fmap setter_a12H1) (f_a12H2 needle_a12H0)
       where
-          needle_a12Vb = _laddressStreet a_a12Ve
-          setter_a12Vc y_a12Vf = a_a12Ve {_laddressStreet = y_a12Vf}
+          needle_a12H0 = _laddressStreet a_a12H3
+          setter_a12H1 y_a12H4 = a_a12H3 {_laddressStreet = y_a12H4}
     laddressCity ::
       forall f. Functor f => (Text -> f Text) -> Laddress -> f Laddress
-    laddressCity f_a12Vi a_a12Vj
-      = (fmap setter_a12Vh) (f_a12Vi needle_a12Vg)
+    laddressCity f_a12H7 a_a12H8
+      = (fmap setter_a12H6) (f_a12H7 needle_a12H5)
       where
-          needle_a12Vg = _laddressCity a_a12Vj
-          setter_a12Vh y_a12Vk = a_a12Vj {_laddressCity = y_a12Vk}
+          needle_a12H5 = _laddressCity a_a12H8
+          setter_a12H6 y_a12H9 = a_a12H8 {_laddressCity = y_a12H9}
     laddressZip ::
       forall f.
       Functor f => (Maybe Int -> f (Maybe Int)) -> Laddress -> f Laddress
-    laddressZip f_a12Vn a_a12Vo
-      = (fmap setter_a12Vm) (f_a12Vn needle_a12Vl)
+    laddressZip f_a12Hc a_a12Hd
+      = (fmap setter_a12Hb) (f_a12Hc needle_a12Ha)
       where
-          needle_a12Vl = _laddressZip a_a12Vo
-          setter_a12Vm y_a12Vp = a_a12Vo {_laddressZip = y_a12Vp}
+          needle_a12Ha = _laddressZip a_a12Hd
+          setter_a12Hb y_a12He = a_a12Hd {_laddressZip = y_a12He}
     instance ToBackendKey SqlBackend Laddress where
       toBackendKey = unLaddressKey
       fromBackendKey = LaddressKey
@@ -4691,21 +4452,21 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
           typ ~ Int => CustomPrimaryKeyAnInt
       keyToValues record
         = [toPersistValue (unCustomPrimaryKeyKey record)]
-      keyFromValues [x1_a12Vv]
+      keyFromValues [x1_a12Hk]
         = CustomPrimaryKeyKey
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "custom_primary_key")) (pack "anInt"))
                  . fromPersistValue)
-                x1_a12Vv
-      keyFromValues x_a12Vu
+                x1_a12Hk
+      keyFromValues x_a12Hj
         = (Left
              $ (mappend (pack "CustomPrimaryKey: keyFromValues failed on: "))
-                 (pack $ show x_a12Vu))
+                 (pack $ show x_a12Hj))
       keyFromRecordM
         = Just
-            (\ record_a12VG
-               -> CustomPrimaryKeyKey (_customPrimaryKeyAnInt record_a12VG))
+            (\ record_a12Hv
+               -> CustomPrimaryKeyKey (_customPrimaryKeyAnInt record_a12Hv))
       entityDef _
         = ((((((((((EntityDef (EntityNameHS (pack "CustomPrimaryKey")))
                      (EntityNameDB (pack "custom_primary_key")))
@@ -4732,41 +4493,32 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
                         Nothing)
                        Nothing))
                    [])
-                  [(((((((((FieldDef (FieldNameHS (pack "anInt")))
-                             (FieldNameDB (pack "an_int")))
-                            ((FTTypeCon Nothing) (pack "Int")))
-                           SqlInt64)
-                          [])
-                         True)
-                        NoReference)
-                       ((FieldCascade Nothing) Nothing))
-                      Nothing)
-                     Nothing])
+                  [persistFieldDef CustomPrimaryKeyAnInt])
                  [])
                 [])
                [])
               (containers-0.6.0.1:Data.Map.Internal.fromList []))
              False)
             Nothing
-      toPersistFields (CustomPrimaryKey x_a12Vq)
-        = [SomePersistField x_a12Vq]
-      fromPersistValues [x1_a12Vs]
+      toPersistFields (CustomPrimaryKey x_a12Hf)
+        = [SomePersistField x_a12Hf]
+      fromPersistValues [x1_a12Hh]
         = CustomPrimaryKey
             <$>
               (Database.Persist.TH.mapLeft
                  ((fieldError (pack "custom_primary_key")) (pack "anInt"))
                  . fromPersistValue)
-                x1_a12Vs
-      fromPersistValues x_a12Vr
+                x1_a12Hh
+      fromPersistValues x_a12Hg
         = (Left
              $ (mappend
                   (pack "CustomPrimaryKey: fromPersistValues failed on: "))
-                 (pack $ show x_a12Vr))
+                 (pack $ show x_a12Hg))
       persistUniqueToFieldNames _
         = error "Degenerate case, should never happen"
       persistUniqueToValues _
         = error "Degenerate case, should never happen"
-      persistUniqueKeys (CustomPrimaryKey _anInt_a12Vt) = []
+      persistUniqueKeys (CustomPrimaryKey _anInt_a12Hi) = []
       persistFieldDef CustomPrimaryKeyId
         = (((((((((FieldDef (FieldNameHS (pack "Id")))
                     (FieldNameDB (pack "id")))
@@ -4804,47 +4556,47 @@ test/main.hs:(110,1)-(124,2): Splicing declarations
       persistIdField = CustomPrimaryKeyId
       fieldLens CustomPrimaryKeyId
         = (lensPTH entityKey)
-            (\ (Entity _ value_a12Vw) key_a12Vx
-               -> (Entity key_a12Vx) value_a12Vw)
+            (\ (Entity _ value_a12Hl) key_a12Hm
+               -> (Entity key_a12Hm) value_a12Hl)
       fieldLens CustomPrimaryKeyAnInt
         = (lensPTH (_customPrimaryKeyAnInt . entityVal))
-            (\ (Entity key_a12Vy value_a12Vz) x_a12VA
-               -> (Entity key_a12Vy)
-                    value_a12Vz {_customPrimaryKeyAnInt = x_a12VA})
+            (\ (Entity key_a12Hn value_a12Ho) x_a12Hp
+               -> (Entity key_a12Hn)
+                    value_a12Ho {_customPrimaryKeyAnInt = x_a12Hp})
     customPrimaryKeyAnInt ::
       forall f.
       Functor f =>
       (Int -> f Int) -> CustomPrimaryKey -> f CustomPrimaryKey
-    customPrimaryKeyAnInt f_a12VD a_a12VE
-      = (fmap setter_a12VC) (f_a12VD needle_a12VB)
+    customPrimaryKeyAnInt f_a12Hs a_a12Ht
+      = (fmap setter_a12Hr) (f_a12Hs needle_a12Hq)
       where
-          needle_a12VB = _customPrimaryKeyAnInt a_a12VE
-          setter_a12VC y_a12VF = a_a12VE {_customPrimaryKeyAnInt = y_a12VF}
+          needle_a12Hq = _customPrimaryKeyAnInt a_a12Ht
+          setter_a12Hr y_a12Hu = a_a12Ht {_customPrimaryKeyAnInt = y_a12Hu}
     instance ToJSON Lperson where
-      toJSON (Lperson name_a12VI age_a12VJ address_a12VK)
+      toJSON (Lperson name_a12Hx age_a12Hy address_a12Hz)
         = object
-            [(pack "name" .= name_a12VI), (pack "age" .= age_a12VJ),
-             (pack "address" .= address_a12VK)]
+            [(pack "name" .= name_a12Hx), (pack "age" .= age_a12Hy),
+             (pack "address" .= address_a12Hz)]
     instance FromJSON Lperson where
-      parseJSON (Object obj_a12VH)
-        = (((pure Lperson <*> (obj_a12VH .: pack "name"))
-              <*> (obj_a12VH .:? pack "age"))
-             <*> (obj_a12VH .: pack "address"))
+      parseJSON (Object obj_a12Hw)
+        = (((pure Lperson <*> (obj_a12Hw .: pack "name"))
+              <*> (obj_a12Hw .:? pack "age"))
+             <*> (obj_a12Hw .: pack "address"))
       parseJSON _ = GHC.Base.mzero
     instance ToJSON (Entity Lperson) where
       toJSON = entityIdToJSON
     instance FromJSON (Entity Lperson) where
       parseJSON = entityIdFromJSON
     instance ToJSON Laddress where
-      toJSON (Laddress street_a12VM city_a12VN zip_a12VO)
+      toJSON (Laddress street_a12HB city_a12HC zip_a12HD)
         = object
-            [(pack "street" .= street_a12VM), (pack "city" .= city_a12VN),
-             (pack "zip" .= zip_a12VO)]
+            [(pack "street" .= street_a12HB), (pack "city" .= city_a12HC),
+             (pack "zip" .= zip_a12HD)]
     instance FromJSON Laddress where
-      parseJSON (Object obj_a12VL)
-        = (((pure Laddress <*> (obj_a12VL .: pack "street"))
-              <*> (obj_a12VL .: pack "city"))
-             <*> (obj_a12VL .:? pack "zip"))
+      parseJSON (Object obj_a12HA)
+        = (((pure Laddress <*> (obj_a12HA .: pack "street"))
+              <*> (obj_a12HA .: pack "city"))
+             <*> (obj_a12HA .:? pack "zip"))
       parseJSON _ = GHC.Base.mzero
     instance ToJSON (Entity Laddress) where
       toJSON = entityIdToJSON

[danbroooks]

I guess CI has answered some of my questions, back to the drawing board I guess :)

[danbroooks]

Unfortunately when mpsGeneric is set it means that the generated entities have a type variable (obviously) that is not resolvable in other situations, this results in this error (from the HtmlTest, which makes use of mpsGeneric):

src/HtmlTest.hs:14:1: error:
    • Could not deduce (PersistStoreWrite backend2)
        arising from a use of ‘persistFieldDef’
      from the context: PersistStore backend
        bound by the instance declaration at src/HtmlTest.hs:(14,1)-(18,2)
      The type variable ‘backend2’ is ambiguous
      These potential instances exist:
        instance PersistStoreWrite SqlBackend
          -- Defined in ‘persistent-2.12.0.0:Database.Persist.Sql.Orphan.PersistStore’
        instance PersistStoreWrite SqlWriteBackend
          -- Defined in ‘persistent-2.12.0.0:Database.Persist.Sql.Orphan.PersistStore’
    • In the expression: persistFieldDef HtmlTableHtml
      In the fifth argument of ‘EntityDef’, namely
        ‘[persistFieldDef HtmlTableHtml]’
      In the expression:
        ((((((((((EntityDef (EntityNameHS (T.pack "HtmlTable")))
                   (EntityNameDB (T.pack "html_table")))
                  ((((((((((FieldDef (FieldNameHS (T.pack "Id")))
                             (FieldNameDB (T.pack "id")))
                            ((FTTypeCon Nothing) (T.pack "HtmlTableId")))
                           (sqlType (Proxy :: Proxy Int64)))
                          [])
                         True)
                        ((ForeignRef (EntityNameHS (T.pack "HtmlTable")))
                           ((FTTypeCon (Just (T.pack "Data.Int"))) (T.pack "Int64"))))
                       ((FieldCascade Nothing) Nothing))
                      Nothing)
                     Nothing))
                 [])
                [persistFieldDef HtmlTableHtml])
               [])
              [])
             [])
            (Data.Map.Internal.fromList []))
           False)
          Nothing

As a way of getting CI ✔️ I have switched it to use the original implementation when this option is set, but this sort of defeats the point of this change, if we have to leave the old implementation in place when that option is set. I'm not sure of an alternative way around this, though it might not be such a good idea to use persistFieldDef anyway (it also becomes a bit awkward when using the other TH functions, like mkMigrate).

Another idea I had for this was to maybe generate the FieldDef's as local values, and re-reference them in the various places, I'm not that keen on this however, primarily due to how typically this generated code is usually declared in a module that exports everything (and would expose these generated FieldDef values), this might not be the end of the world though. Feedback on this would be appreciated as well. I may try spiking this approach on this PR at some point. I will leave what I have here for now, as a discussion point/for anyone else interested to take a look. And just keep spiking this idea for the time being.

[parsonsmatt]

I wish we could collect metrics on when features were being used. The *Generic machinery is complicated and I'm not sure that it's actually useful at all.

I suppose we could deprecate it and see if anyone complained 🤔

This feels like it should be fixable with a type annotation. All we want to do is use persistFieldDef at a specific backend type. That function is a class method with the type persistFieldDef :: PersistEntity record => EntityField record typ -> FieldDef. So we would want to annotate it with, like, persistFieldDef (HtmlTableHtml :: EntityField (HtmlTableGeneric backend) ???). Then hopefully backend fixes to the right type variable and we don't need to fool around with ScopedTypeVariables or similar.

[parsonsmatt]

@danbroooks I'm planning on releasing persistent-2.12 this week. Would you like to attempt the fix I mentioned? I think it's good enough as-is - we can merge now and then put a note in to fix this more at some other time.

[danbroooks]

Yeah, I've not had chance to take another look at this yet, my TH skills are not amazing either so you may need to bare with me on adding the type hints like you suggested (I have a feeling there will be an ambiguity issue still here, though happy to be wrong!).

As far as merging it in as it is currently, I would say maybe not, but that is up to you.

[danbroooks]

@parsonsmatt you may want to take a look at this, this latest iteration (5108cec) is maybe a good compromise between a quick fix to get TH improvements into persistent but that is relatively clean (though leaving some code duplication in place), further work could be done after this to clean things up, and I think deprecating mpsGeneric would help in this regard if nothing comes from your issue.

I'm sorry but I was unable to get your typehint suggestion to work, it also adds in some more complication with regards to what the ??? is in EntityField (HtmlTableGeneric backend) ???, as I think it needs to cover each of these references:

https://hackage.haskell.org/package/persistent-2.11.0.4/docs/Database-Persist-Types.html#t:ReferenceDef

So I ended up struggling with it a bit, unfortunately! I think this might be viable still (and there is some existing functionality to do this currently in the TH module I think, but it's not geared up for re-use as it stands currently). I'm willing to keep at it though, but if you like what is in this draft PR as it stands now, I am happy to convert it to a PR for review/merge 👍

[parsonsmatt]

One final change - then I think we can merge this one in :)

[parsonsmatt]

This feels a bit dicey. Why not use the name facility lie 'persistFieldDef ? That gives you a qualified name that should work fine in the context without requiring it to be imported.

eg:

fmap ListE $ forM fieldDefs $ \fieldDef -> do
  ...
    pure $ VarE 'persistFieldDef `AppE` fieldDefConE

[parsonsmatt]

Looks fantastic thanks! Ready to merge?

[danbroooks]

Sure! 🎉