From 3afe9eb59d33b5c47e0286741218088a72adab5d Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 19 Apr 2021 16:39:46 -0600 Subject: [PATCH 1/3] Generate #id labels --- persistent/Database/Persist/TH.hs | 13 +++++++++---- .../test/Database/Persist/TH/OverloadedLabelSpec.hs | 6 ++++++ 2 files changed, 15 insertions(+), 4 deletions(-) diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs index 9968527ae..67b58068c 100644 --- a/persistent/Database/Persist/TH.hs +++ b/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" diff --git a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs b/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs index c6989e65a..c2a4b4411 100644 --- a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs +++ b/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 From d8946e5a78b6df4f31ea1954b006137f3092b5e8 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 19 Apr 2021 17:12:35 -0600 Subject: [PATCH 2/3] changelog --- persistent/ChangeLog.md | 5 +++++ persistent/persistent.cabal | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 4d1b76097..b845d3817 100644 --- a/persistent/ChangeLog.md +++ b/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) diff --git a/persistent/persistent.cabal b/persistent/persistent.cabal index 2719a7983..073db1d1a 100644 --- a/persistent/persistent.cabal +++ b/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 From 5d8538145514250a2d97e5dc0b07daa562dc46f3 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 19 Apr 2021 17:13:21 -0600 Subject: [PATCH 3/3] format --- .../Database/Persist/Class/PersistUnique.hs | 59 ++++++++++--------- 1 file changed, 31 insertions(+), 28 deletions(-) diff --git a/persistent/Database/Persist/Class/PersistUnique.hs b/persistent/Database/Persist/Class/PersistUnique.hs index f8f8f87b4..fcb0fd1ed 100644 --- a/persistent/Database/Persist/Class/PersistUnique.hs +++ b/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