persistent-template: Use the stock strategy when deriving Show/Read f…

persistent-template/ChangeLog.md

@@ -1,5 +1,28 @@
 ## Unreleased changes
 
+* Always use the "stock" strategy when deriving Show/Read for keys [#1106](https://github.com/yesodweb/persistent/pull/1106)
+	* This fixes a regression from 2.8.0, which started using the `newtype` strategy when deriving `Show`/`Read` for keys
+	* In practice, this means that from 2.8.0–2.8.3.1, for the following schema:
+
+	```
+	Person
+		name Text
+	CustomPrimary
+		anInt Int
+		Primary anInt
+		name Text
+	```
+
+	`PersonKey 1` would show as `"SqlBackendKey {unSqlBackendKey = 1}"`
+	and `CustomPrimaryKey 1` would show as `"1"`
+
+	This was generally poor for debugging and logging, since all tables keys would print the same. For Persistent < 2.8.0 and > 2.8.3.1, they instead will show as:
+
+	`"PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 1}}"`
+	and `"CustomPrimaryKey {unCustomPrimaryKey = 1}"`
+
+	This could be a breaking change if you have used `Show` on a key, wrote that string into some persistent storage like a database, and are trying to `Read` it back again later.
+
 ## 2.8.3.1
 
 * Allow aeson 1.5. [#1085](https://github.com/yesodweb/persistent/pull/1085)

persistent-template/Database/Persist/TH.hs

@@ -876,16 +876,24 @@ mkKeyTypeDec mps t = do
 
     requirePersistentExtensions
 
+    -- Always use StockStrategy for Show/Read. This means e.g. (FooKey 1) shows as ("FooKey 1"), rather than just "1"
+    -- This is much better for debugging/logging purposes
+    -- cf. https://github.com/yesodweb/persistent/issues/1104
+    let alwaysStockStrategyTypeclasses = [''Show, ''Read]
+        deriveClauses = map (\typeclass ->
+            if (not useNewtype || typeclass `elem` alwaysStockStrategyTypeclasses)
+                then DerivClause (Just StockStrategy) [(ConT typeclass)]
+                else DerivClause (Just NewtypeStrategy) [(ConT typeclass)]
+            ) i
+
 #if MIN_VERSION_template_haskell(2,15,0)
-    cxti <- mapM conT i
     let kd = if useNewtype
-               then NewtypeInstD [] Nothing (AppT (ConT k) recordType) Nothing dec [DerivClause (Just NewtypeStrategy) cxti]
-               else DataInstD    [] Nothing (AppT (ConT k) recordType) Nothing [dec] [DerivClause (Just StockStrategy) cxti]
+               then NewtypeInstD [] Nothing (AppT (ConT k) recordType) Nothing dec deriveClauses
+               else DataInstD    [] Nothing (AppT (ConT k) recordType) Nothing [dec] deriveClauses
 #else
-    cxti <- mapM conT i
     let kd = if useNewtype
-               then NewtypeInstD [] k [recordType] Nothing dec [DerivClause (Just NewtypeStrategy) cxti]
-               else DataInstD    [] k [recordType] Nothing [dec] [DerivClause (Just StockStrategy) cxti]
+               then NewtypeInstD [] k [recordType] Nothing dec deriveClauses
+               else DataInstD    [] k [recordType] Nothing [dec] deriveClauses
 #endif
     return (kd, instDecs)
   where
@@ -922,8 +930,9 @@ mkKeyTypeDec mps t = do
 
       instances <- do
         alwaysInstances <-
-          [d|deriving newtype instance Show (BackendKey $(pure backendT)) => Show (Key $(pure recordType))
-             deriving newtype instance Read (BackendKey $(pure backendT)) => Read (Key $(pure recordType))
+          -- See the "Always use StockStrategy" comment above, on why Show/Read use "stock" here
+          [d|deriving stock instance Show (BackendKey $(pure backendT)) => Show (Key $(pure recordType))
+             deriving stock instance Read (BackendKey $(pure backendT)) => Read (Key $(pure recordType))
              deriving newtype instance Eq (BackendKey $(pure backendT)) => Eq (Key $(pure recordType))
              deriving newtype instance Ord (BackendKey $(pure backendT)) => Ord (Key $(pure recordType))
              deriving newtype instance ToHttpApiData (BackendKey $(pure backendT)) => ToHttpApiData (Key $(pure recordType))

persistent-template/test/main.hs

@@ -71,6 +71,9 @@ Laddress json
     city Text
     zip Int Maybe
     deriving Show Eq
+CustomPrimaryKey
+    anInt Int
+    Primary anInt
 |]
 
 arbitraryT :: Gen Text
@@ -110,6 +113,14 @@ main = hspec $ do
         (person1 ^. lpersonAddress) `shouldBe` address1
         (person1 ^. (lpersonAddress . laddressCity)) `shouldBe` city1
         (person1 & ((lpersonAddress . laddressCity) .~ city2)) `shouldBe` person2
+    describe "Derived Show/Read instances" $ do
+        -- This tests confirms https://github.com/yesodweb/persistent/issues/1104 remains fixed
+        it "includes the name of the newtype when showing/reading a Key, i.e. uses the stock strategy when deriving Show/Read" $ do
+            show (PersonKey 0) `shouldBe` "PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 0}}"
+            read (show (PersonKey 0)) `shouldBe` PersonKey 0
+
+            show (CustomPrimaryKeyKey 0) `shouldBe` "CustomPrimaryKeyKey {unCustomPrimaryKeyKey = 0}"
+            read (show (CustomPrimaryKeyKey 0)) `shouldBe` CustomPrimaryKeyKey 0
 
 (&) :: a -> (a -> b) -> b
 x & f = f x