Avoid parse error occurred when the field name generated by TH matches any of Haskell keywords

persistent/ChangeLog.md

@@ -1,10 +1,12 @@
 # Changelog for persistent
 
-## unreleased
+## 2.14.4.5
 
 * [#1460] https://github.com/yesodweb/persistent/pull/1468
     * Remove extraneous `map toPersistValue` call in the `mkInsertValues`
       function, as it evaluates to `id`.
+* [#1476](https://github.com/yesodweb/persistent/pull/1476)
+    * Fix `mkRecordName` to suffix `_` if the field name matches any of Haskell keywords.
 
 ## 2.14.4.4
 

persistent/Database/Persist/TH.hs

@@ -3100,7 +3100,7 @@ mkEntityLensName mps entDef fieldDef =
 
 mkRecordName :: MkPersistSettings -> Maybe Text -> EntityNameHS -> FieldNameHS -> Name
 mkRecordName mps prefix entNameHS fieldNameHS =
-    mkName $ T.unpack $ fromMaybe "" prefix <> lowerFirst recName
+    mkName $ T.unpack . avoidKeyword $ fromMaybe "" prefix <> lowerFirst recName
   where
     recName :: Text
     recName
@@ -3115,6 +3115,17 @@ mkRecordName mps prefix entNameHS fieldNameHS =
     fieldNameText =
         unFieldNameHS fieldNameHS
 
+    avoidKeyword :: Text -> Text
+    avoidKeyword name = if name `Set.member` haskellKeywords then name ++ "_" else name
+
+haskellKeywords :: Set.Set Text
+haskellKeywords = Set.fromList
+    ["case","class","data","default","deriving","do","else"
+    ,"if","import","in","infix","infixl","infixr","instance","let","module"
+    ,"newtype","of","then","type","where","_"
+    ,"foreign"
+    ]
+
 -- | Construct a list of TH Names for the typeclasses of an EntityDef's `entityDerives`
 mkEntityDefDeriveNames :: MkPersistSettings -> UnboundEntityDef -> [Name]
 mkEntityDefDeriveNames mps entDef =

persistent/persistent.cabal

@@ -1,5 +1,5 @@
 name:            persistent
-version:         2.14.4.4
+version:         2.14.4.5
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>

persistent/test/Database/Persist/TH/NoFieldSelectorsSpec.hs

@@ -25,6 +25,7 @@ User
     name Text
     Primary ident
     team TeamId
+    type Text
 
 Team
     name Text