Generate #id labels

persistent/ChangeLog.md

@@ -1,5 +1,10 @@
 # Changelog for persistent
 
+## 2.12.1.1
+
+* [#1229](https://github.com/yesodweb/persistent/pull/1229)
+    * The `#id` labels are now generated for entities.
+
 ## 2.12.1.0
 
 *  [#1226](https://github.com/yesodweb/persistent/pull/1226)

persistent/Database/Persist/Class/PersistUnique.hs

@@ -3,42 +3,42 @@
 {-# LANGUAGE TypeOperators #-}
 
 module Database.Persist.Class.PersistUnique
-  ( PersistUniqueRead(..)
-  , PersistUniqueWrite(..)
-  , OnlyOneUniqueKey(..)
-  , onlyOneUniqueDef
-  , AtLeastOneUniqueKey(..)
-  , atLeastOneUniqueDef
-  , NoUniqueKeysError
-  , MultipleUniqueKeysError
-  , getByValue
-  , getByValueUniques
-  , insertBy
-  , insertUniqueEntity
-  , replaceUnique
-  , checkUnique
-  , checkUniqueUpdateable
-  , onlyUnique
-  , defaultUpsertBy
-  , defaultPutMany
-  , persistUniqueKeyValues
-  )
-  where
+    ( PersistUniqueRead(..)
+    , PersistUniqueWrite(..)
+    , OnlyOneUniqueKey(..)
+    , onlyOneUniqueDef
+    , AtLeastOneUniqueKey(..)
+    , atLeastOneUniqueDef
+    , NoUniqueKeysError
+    , MultipleUniqueKeysError
+    , getByValue
+    , getByValueUniques
+    , insertBy
+    , insertUniqueEntity
+    , replaceUnique
+    , checkUnique
+    , checkUniqueUpdateable
+    , onlyUnique
+    , defaultUpsertBy
+    , defaultPutMany
+    , persistUniqueKeyValues
+    )
+    where
 
 import Control.Monad (liftM)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Function (on)
-import Data.List ((\\), deleteFirstsBy)
+import Data.List (deleteFirstsBy, (\\))
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NEL
 import qualified Data.Map as Map
 import Data.Maybe (catMaybes)
 import GHC.TypeLits (ErrorMessage(..))
 
-import Database.Persist.Types
-import Database.Persist.Class.PersistStore
 import Database.Persist.Class.PersistEntity
+import Database.Persist.Class.PersistStore
+import Database.Persist.Types
 
 -- | Queries against 'Unique' keys (other than the id 'Key').
 --
@@ -419,10 +419,13 @@ insertBy val = do
 -- > +----+-------+-----+
 
 insertUniqueEntity
-    :: forall record backend m. (MonadIO m
-       ,PersistRecordBackend record backend
-       ,PersistUniqueWrite backend)
-    => record -> ReaderT backend m (Maybe (Entity record))
+    :: forall record backend m
+     . ( MonadIO m
+       , PersistRecordBackend record backend
+       , PersistUniqueWrite backend
+       )
+    => record
+    -> ReaderT backend m (Maybe (Entity record))
 insertUniqueEntity datum =
   fmap (\key -> Entity key datum) `liftM` insertUnique datum
 

persistent/Database/Persist/TH.hs

@@ -1955,10 +1955,15 @@ requirePersistentExtensions = requireExtensions requiredExtensions
 
 mkSymbolToFieldInstances :: MkPersistSettings -> EntityDef -> Q [Dec]
 mkSymbolToFieldInstances mps ed = do
-    fmap join $ forM (entityFields ed) $ \fieldDef -> do
-        let fieldNameT =
-                litT $ strTyLit $ T.unpack $ unFieldNameHS $ fieldHaskell fieldDef
-                    :: Q Type
+    fmap join $ forM (keyAndEntityFields ed) $ \fieldDef -> do
+        let fieldNameT :: Q Type
+            fieldNameT =
+                litT $ strTyLit
+                    $ T.unpack $ lowerFirstIfId
+                    $ unFieldNameHS $ fieldHaskell fieldDef
+
+            lowerFirstIfId "Id" = "id"
+            lowerFirstIfId xs = xs
 
             nameG = mkName $ unpack $ unEntityNameHS (entityHaskell ed) ++ "Generic"
 

persistent/persistent.cabal

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

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

@@ -52,5 +52,11 @@ spec = describe "OverloadedLabels" $ do
 
         compiles
 
+    it "works for id labels" $ do
+        let UserId = #id
+            orgId = #id :: EntityField Organization OrganizationId
+
+        compiles
+
 compiles :: Expectation
 compiles = True `shouldBe` True