persistent-test 2.13.1.4 → 2.13.2.0
raw patch · 3 files changed
+84/−63 lines, 3 files
Files
- ChangeLog.md +4/−0
- persistent-test.cabal +2/−2
- src/PersistentTestModels.hs +78/−61
ChangeLog.md view
@@ -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.cabal view
@@ -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 <michael@snoyman.com>@@ -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
src/PersistentTestModels.hs view
@@ -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)])