From 99f05c19b58483c389b8ba0c0b443d916f667c8f Mon Sep 17 00:00:00 2001 From: Haisheng W - M Date: Wed, 17 May 2023 21:42:39 -0700 Subject: [PATCH 1/2] Always create SymbolToField for "id" - given there is always a {EntityName}Id type --- persistent/Database/Persist/TH.hs | 6 +-- .../Persist/TH/OverloadedLabelSpec.hs | 38 ++++++++++++------- 2 files changed, 25 insertions(+), 19 deletions(-) diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs index 189261d7b..acad2989f 100644 --- a/persistent/Database/Persist/TH.hs +++ b/persistent/Database/Persist/TH.hs @@ -2980,11 +2980,7 @@ mkSymbolToFieldInstances mps entityMap (fixEntityDef -> ed) = do mkEntityFieldConstr fieldHaskellName mkInstance fieldNameT fieldTypeT entityFieldConstr - mkey <- - case unboundPrimarySpec ed of - NaturalKey _ -> - pure [] - _ -> do + mkey <- do let fieldHaskellName = FieldNameHS "Id" diff --git a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs b/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs index b81453160..363375ef5 100644 --- a/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs +++ b/persistent/test/Database/Persist/TH/OverloadedLabelSpec.hs @@ -1,23 +1,23 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE PartialTypeSignatures #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wname-shadowing -Werror=name-shadowing #-} module Database.Persist.TH.OverloadedLabelSpec where -import TemplateTestImports +import TemplateTestImports mkPersist sqlSettings [persistUpperCase| @@ -33,6 +33,10 @@ Dog Organization name String +Student + userId UserId + departmentName String + Primary userId |] spec :: Spec @@ -60,5 +64,11 @@ spec = describe "OverloadedLabels" $ do compiles + it "works for Primary labels" $ do + let StudentId = #id + studentId = #id :: EntityField Student StudentId + + compiles + compiles :: IO () compiles = pure () From 04728c26afe210be5d7975c6ac4e5388d67279d3 Mon Sep 17 00:00:00 2001 From: Haisheng W - M Date: Wed, 28 Jun 2023 10:45:59 -0700 Subject: [PATCH 2/2] Update changelog --- persistent/ChangeLog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/persistent/ChangeLog.md b/persistent/ChangeLog.md index 2de90fae7..3c9c0d788 100644 --- a/persistent/ChangeLog.md +++ b/persistent/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for persistent +## Unreleased + +* [1497](https://github.com/yesodweb/persistent/pull/1497) + * Always generates `SymbolToField "id"` instance + ## 2.14.5.1 * [#1496](https://github.com/yesodweb/persistent/pull/1496)