diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/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` diff --git a/persistent-test.cabal b/persistent-test.cabal --- a/persistent-test.cabal +++ b/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 @@ -77,7 +77,7 @@ , monad-logger >=0.3.25 , mtl , path-pieces >=0.2 - , persistent >=2.14 && <2.18 + , persistent >=2.16 && <2.18 , QuickCheck >=2.9 , quickcheck-instances >=0.3 , random >=1.1 diff --git a/src/PersistentTestModels.hs b/src/PersistentTestModels.hs --- a/src/PersistentTestModels.hs +++ b/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 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 @@ |] -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) -deriving instance Show (BackendKey backend) => Show (RelationshipGeneric backend) -deriving instance Eq (BackendKey backend) => Eq (RelationshipGeneric 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| +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 @@ |] -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) -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| +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 @@ 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 @@ -- | 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 @@ 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 @@ :: (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)])