From 17cbadb34b0995acfbbe706544c2a8036a5ab5b4 Mon Sep 17 00:00:00 2001
From: Haisheng W - M <haisheng@mercury.com>
Date: Wed, 17 May 2023 21:42:39 -0700
Subject: [PATCH] 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 ()