Warn on quoted attributes

persistent-qq/ChangeLog.md

@@ -1,5 +1,9 @@
 # Changelog for persistent-qq
 
+## 2.12.0.7
+* [#1601](https://github.com/yesodweb/persistent/pull/1601)
+  * Adjust a test to avoid deprecated entity definition syntax
+
 ## 2.12.0.6
 
 * Fix test compilation by importing `Control.Monad` explicitly [#1487](https://github.com/yesodweb/persistent/pull/1487)

persistent-qq/persistent-qq.cabal

@@ -1,6 +1,6 @@
 cabal-version:      1.12
 name:               persistent-qq
-version:            2.12.0.6
+version:            2.12.0.7
 synopsis:           Provides a quasi-quoter for raw SQL for persistent
 description:
   Please see README and API docs at <http://www.stackage.org/package/persistent>.

persistent-qq/test/PersistentTestModels.hs

@@ -11,7 +11,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
-
 {-# OPTIONS_GHC -ddump-splices #-}
 
 module PersistentTestModels where
@@ -29,16 +28,17 @@ import PersistTestPetCollarType
 import PersistTestPetType
 
 share
-    [ mkPersist sqlSettings { mpsGeneric = True }
+    [ mkPersist sqlSettings{mpsGeneric = True}
     , mkMigrate "testMigrate"
-    ] [persistUpperCase|
+    ]
+    [persistUpperCase|
 
 -- Dedented comment
   -- Header-level comment
     -- Indented comment
   Person json
     name Text
-    age Int "some ignored -- \" attribute"
+    age Int some="ignored -- \" attribute"
     color Text Maybe -- this is a comment sql=foobarbaz
     PersonNameKey name -- this is a comment sql=foobarbaz
     deriving Show Eq
@@ -112,12 +112,14 @@ share
 
 |]
 
-deriving instance Show (BackendKey backend) => Show (PetGeneric backend)
-deriving instance Eq (BackendKey backend) => Eq (PetGeneric backend)
+deriving instance (Show (BackendKey backend)) => Show (PetGeneric backend)
+deriving instance (Eq (BackendKey backend)) => Eq (PetGeneric backend)
 
-share [ mkPersist sqlSettings { mpsPrefixFields = False, mpsGeneric = True }
-      , mkMigrate "noPrefixMigrate"
-      ] [persistLowerCase|
+share
+    [ mkPersist sqlSettings{mpsPrefixFields = False, mpsGeneric = True}
+    , mkMigrate "noPrefixMigrate"
+    ]
+    [persistLowerCase|
 NoPrefix1
     someFieldName Int
 NoPrefix2
@@ -129,23 +131,27 @@ NoPrefix2
     deriving Show Eq
 |]
 
-deriving instance Show (BackendKey backend) => Show (NoPrefix1Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (NoPrefix1Generic backend)
+deriving instance (Show (BackendKey backend)) => Show (NoPrefix1Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix1Generic backend)
 
-deriving instance Show (BackendKey backend) => Show (NoPrefix2Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (NoPrefix2Generic backend)
+deriving instance (Show (BackendKey backend)) => Show (NoPrefix2Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix2Generic backend)
 
 -- | Reverses the order of the fields of an entity.  Used to test
 -- @??@ placeholders of 'rawSql'.
 newtype ReverseFieldOrder a = RFO {unRFO :: a} deriving (Eq, Show)
-instance ToJSON (Key (ReverseFieldOrder a))   where toJSON = error "ReverseFieldOrder"
-instance FromJSON (Key (ReverseFieldOrder a)) where parseJSON = error "ReverseFieldOrder"
+
+instance ToJSON (Key (ReverseFieldOrder a)) where
+    toJSON = error "ReverseFieldOrder"
+instance FromJSON (Key (ReverseFieldOrder a)) where
+    parseJSON = error "ReverseFieldOrder"
 instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
     type PersistEntityBackend (ReverseFieldOrder a) = PersistEntityBackend a
 
-    newtype Key (ReverseFieldOrder a) = RFOKey { unRFOKey :: BackendKey SqlBackend } deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
+    newtype Key (ReverseFieldOrder a) = RFOKey {unRFOKey :: BackendKey SqlBackend}
+        deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
     keyFromValues = fmap RFOKey . fromPersistValue . head
-    keyToValues   = (:[]) . toPersistValue . unRFOKey
+    keyToValues = (: []) . toPersistValue . unRFOKey
 
     entityDef = revFields . entityDef . unRfoProxy
       where
@@ -158,7 +164,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
     persistFieldDef = persistFieldDef . unEFRFO
     fromPersistValues = fmap RFO . fromPersistValues . reverse
 
-    newtype Unique      (ReverseFieldOrder a)   = URFO  {unURFO  :: Unique      a  }
+    newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a}
     persistUniqueToFieldNames = NEL.reverse . persistUniqueToFieldNames . unURFO
     persistUniqueToValues = reverse . persistUniqueToValues . unURFO
     persistUniqueKeys = map URFO . reverse . persistUniqueKeys . unRFO
@@ -170,11 +176,11 @@ cleanDB
     :: (MonadIO m, PersistQuery backend, PersistStoreWrite (BaseBackend backend))
     => ReaderT backend m ()
 cleanDB = do
-  deleteWhere ([] :: [Filter (PersonGeneric backend)])
-  deleteWhere ([] :: [Filter (Person1Generic backend)])
-  deleteWhere ([] :: [Filter (PetGeneric backend)])
-  deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
-  deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
-  deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
-  deleteWhere ([] :: [Filter (UserPTGeneric backend)])
-  deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
+    deleteWhere ([] :: [Filter (PersonGeneric backend)])
+    deleteWhere ([] :: [Filter (Person1Generic backend)])
+    deleteWhere ([] :: [Filter (PetGeneric backend)])
+    deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
+    deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
+    deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
+    deleteWhere ([] :: [Filter (UserPTGeneric backend)])
+    deleteWhere ([] :: [Filter (EmailPTGeneric backend)])

persistent-sqlite/test1.hs

@@ -1,3 +1,4 @@
+{- FOURMOLU_DISABLE -}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -8,7 +9,7 @@ import Control.Monad.IO.Class
 mkPersist [$persist|
 Person sql=PersonTable
     name String update Eq Ne Desc In
-    age Int update "Asc" Lt "some ignored attribute"
+    age Int update Asc Lt someIgnoredAttribute
     color String null Eq Ne sql=mycolorfield NotIn Ge
     PersonNameKey name
 Pet

persistent-test/ChangeLog.md

@@ -1,5 +1,9 @@
 ## Unreleased changes
 
+# 2.13.2.0
+* [#1601](https://github.com/yesodweb/persistent/pull/1601)
+  * Adjust test data to avoid deprecated entity definition syntax
+
 ## 2.13.1.4
 
 * Support `persistent-2.17`

persistent-test/persistent-test.cabal

@@ -1,5 +1,5 @@
 name:               persistent-test
-version:            2.13.1.4
+version:            2.13.2.0
 license:            MIT
 license-file:       LICENSE
 author:             Michael Snoyman <[email protected]>

persistent-test/src/PersistentTestModels.hs

@@ -1,9 +1,9 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-} -- FIXME
-
+-- FIXME
+{-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -ddump-splices #-}
 
 module PersistentTestModels where
@@ -12,25 +12,27 @@ import Data.Aeson hiding (Key)
 
 import qualified Data.List.NonEmpty as NEL
 import Data.Proxy
-import Test.QuickCheck
+import Data.Text (append)
 import Database.Persist.Sql
 import Database.Persist.TH
 import Init
-import PersistTestPetType
 import PersistTestPetCollarType
-import Data.Text (append)
+import PersistTestPetType
+import Test.QuickCheck
 
 -- just need to ensure this compiles
-import PersistentTestModelsImports()
+import PersistentTestModelsImports ()
 
-share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate"] [persistUpperCase|
+share
+    [mkPersist persistSettings{mpsGeneric = True}, mkMigrate "testMigrate"]
+    [persistUpperCase|
 
 -- Dedented comment
   -- Header-level comment
     -- Indented comment
   Person json
     name Text
-    age Int "some ignored -- \" attribute"
+    age Int some="ignored -- \" attribute"
     color Text Maybe -- this is a comment sql=foobarbaz
     PersonNameKey name -- this is a comment sql=foobarbaz
     deriving Show Eq
@@ -125,20 +127,24 @@ share [mkPersist persistSettings { mpsGeneric = True },  mkMigrate "testMigrate"
 
 |]
 
-deriving instance Show (BackendKey backend) => Show (PetGeneric backend)
-deriving instance Eq (BackendKey backend) => Eq (PetGeneric backend)
-
-deriving instance Show (BackendKey backend) => Show (RelationshipGeneric backend)
-deriving instance Eq (BackendKey backend) => Eq (RelationshipGeneric backend)
-
-share [mkPersist persistSettings {
-          mpsPrefixFields = False
-        , mpsFieldLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
-        , mpsConstraintLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
-        , mpsGeneric = True
-        }
-      , mkMigrate "noPrefixMigrate"
-      ] [persistLowerCase|
+deriving instance (Show (BackendKey backend)) => Show (PetGeneric backend)
+deriving instance (Eq (BackendKey backend)) => Eq (PetGeneric backend)
+
+deriving instance
+    (Show (BackendKey backend)) => Show (RelationshipGeneric backend)
+deriving instance (Eq (BackendKey backend)) => Eq (RelationshipGeneric backend)
+
+share
+    [ mkPersist
+        persistSettings
+            { mpsPrefixFields = False
+            , mpsFieldLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
+            , mpsConstraintLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
+            , mpsGeneric = True
+            }
+    , mkMigrate "noPrefixMigrate"
+    ]
+    [persistLowerCase|
 NoPrefix1
     someFieldName Int
 NoPrefix2
@@ -151,26 +157,29 @@ NoPrefix2
 
 |]
 
-deriving instance Show (BackendKey backend) => Show (NoPrefix1Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (NoPrefix1Generic backend)
-
-deriving instance Show (BackendKey backend) => Show (NoPrefix2Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (NoPrefix2Generic backend)
-
-share [mkPersist persistSettings {
-          mpsFieldLabelModifier = \entity field -> case entity of
-            "CustomPrefix1" -> append "_cp1" field
-            "CustomPrefix2" -> append "_cp2" field
-            _ -> error "should not be called"
-        , mpsConstraintLabelModifier = \entity field -> case entity of
-            "CustomPrefix1" -> append "CP1" field
-            "CustomPrefix2" -> append "CP2" field
-            "CustomPrefixSum" -> append "CP" field
-            _ -> error "should not be called"
-        , mpsGeneric = True
-        }
-      , mkMigrate "customPrefixMigrate"
-      ] [persistLowerCase|
+deriving instance (Show (BackendKey backend)) => Show (NoPrefix1Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix1Generic backend)
+
+deriving instance (Show (BackendKey backend)) => Show (NoPrefix2Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix2Generic backend)
+
+share
+    [ mkPersist
+        persistSettings
+            { mpsFieldLabelModifier = \entity field -> case entity of
+                "CustomPrefix1" -> append "_cp1" field
+                "CustomPrefix2" -> append "_cp2" field
+                _ -> error "should not be called"
+            , mpsConstraintLabelModifier = \entity field -> case entity of
+                "CustomPrefix1" -> append "CP1" field
+                "CustomPrefix2" -> append "CP2" field
+                "CustomPrefixSum" -> append "CP" field
+                _ -> error "should not be called"
+            , mpsGeneric = True
+            }
+    , mkMigrate "customPrefixMigrate"
+    ]
+    [persistLowerCase|
 CustomPrefix1
     customFieldName Int
 CustomPrefix2
@@ -182,15 +191,19 @@ CustomPrefix2
     deriving Show Eq
 |]
 
-deriving instance Show (BackendKey backend) => Show (CustomPrefix1Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (CustomPrefix1Generic backend)
+deriving instance
+    (Show (BackendKey backend)) => Show (CustomPrefix1Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (CustomPrefix1Generic backend)
 
-deriving instance Show (BackendKey backend) => Show (CustomPrefix2Generic backend)
-deriving instance Eq (BackendKey backend) => Eq (CustomPrefix2Generic backend)
+deriving instance
+    (Show (BackendKey backend)) => Show (CustomPrefix2Generic backend)
+deriving instance (Eq (BackendKey backend)) => Eq (CustomPrefix2Generic backend)
 
-share [mkPersist persistSettings { mpsPrefixFields = False, mpsGeneric = False }
-      , mkMigrate "treeMigrate"
-      ] [persistLowerCase|
+share
+    [ mkPersist persistSettings{mpsPrefixFields = False, mpsGeneric = False}
+    , mkMigrate "treeMigrate"
+    ]
+    [persistLowerCase|
 
 Tree sql=trees
   name String
@@ -202,14 +215,18 @@ Tree sql=trees
 -- | Reverses the order of the fields of an entity.  Used to test
 -- @??@ placeholders of 'rawSql'.
 newtype ReverseFieldOrder a = RFO {unRFO :: a} deriving (Eq, Show)
-instance ToJSON (Key (ReverseFieldOrder a))   where toJSON = error "ReverseFieldOrder"
-instance FromJSON (Key (ReverseFieldOrder a)) where parseJSON = error "ReverseFieldOrder"
+
+instance ToJSON (Key (ReverseFieldOrder a)) where
+    toJSON = error "ReverseFieldOrder"
+instance FromJSON (Key (ReverseFieldOrder a)) where
+    parseJSON = error "ReverseFieldOrder"
 instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
     type PersistEntityBackend (ReverseFieldOrder a) = PersistEntityBackend a
 
-    newtype Key (ReverseFieldOrder a) = RFOKey { unRFOKey :: BackendKey SqlBackend } deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
+    newtype Key (ReverseFieldOrder a) = RFOKey {unRFOKey :: BackendKey SqlBackend}
+        deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
     keyFromValues = fmap RFOKey . fromPersistValue . head
-    keyToValues   = (:[]) . toPersistValue . unRFOKey
+    keyToValues = (: []) . toPersistValue . unRFOKey
 
     entityDef = revFields . entityDef . unRfoProxy
       where
@@ -222,7 +239,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
     persistFieldDef = persistFieldDef . unEFRFO
     fromPersistValues = fmap RFO . fromPersistValues . reverse
 
-    newtype Unique      (ReverseFieldOrder a)   = URFO  {unURFO  :: Unique      a  }
+    newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a}
     persistUniqueToFieldNames = NEL.reverse . persistUniqueToFieldNames . unURFO
     persistUniqueToValues = reverse . persistUniqueToValues . unURFO
     persistUniqueKeys = fmap URFO . reverse . persistUniqueKeys . unRFO
@@ -234,13 +251,13 @@ cleanDB
     :: (MonadIO m, PersistQuery backend, PersistStoreWrite (BaseBackend backend))
     => ReaderT backend m ()
 cleanDB = do
-  deleteWhere ([] :: [Filter (PersonGeneric backend)])
-  deleteWhere ([] :: [Filter (Person1Generic backend)])
-  deleteWhere ([] :: [Filter (PetGeneric backend)])
-  deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
-  deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
-  deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
-  deleteWhere ([] :: [Filter (UserPTGeneric backend)])
-  deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
-  deleteWhere ([] :: [Filter (UpsertGeneric backend)])
-  deleteWhere ([] :: [Filter (UpsertByGeneric backend)])
+    deleteWhere ([] :: [Filter (PersonGeneric backend)])
+    deleteWhere ([] :: [Filter (Person1Generic backend)])
+    deleteWhere ([] :: [Filter (PetGeneric backend)])
+    deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
+    deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
+    deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
+    deleteWhere ([] :: [Filter (UserPTGeneric backend)])
+    deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
+    deleteWhere ([] :: [Filter (UpsertGeneric backend)])
+    deleteWhere ([] :: [Filter (UpsertByGeneric backend)])

persistent/ChangeLog.md

@@ -1,5 +1,12 @@
 # Changelog for persistent
 
+# 2.17.1.0
+
+* [#1601](https://github.com/yesodweb/persistent/pull/1601)
+  * Fix parsing of quoted entity field attributes
+  * Add and enforce `psQuotedAttributeErrorLevel` to deprecate quoted entity field attributes
+  * Improve parsing of types and entity fields
+
 # 2.17.0.0
 
 * [#1595](https://github.com/yesodweb/persistent/pull/1595)