Skip to content

Commit 44adecb

Browse files
dtpowlrestyled-commits
dtpowl
and
restyled-commits
authored
Warn on quoted attributes (#1601)
* warn when parsing quoted field attributes * warn when parsing quoted directive arguments * add another test * remove an unused import * improve a name * fix issues found in testing * fix a bug in a test * allow deriving nothing * refactor to remove boolean argument * move warning-related tests into CPP * formatting * remove redundant tests (which were in the wrong place) * disable fourmolu * use IsInner in another place * run formatter * simplify implementation of `fieldStrictness` * new versions and changelogs * clarify changelog message * more formatting * remove superfluous `optional` * more formatting --------- Co-authored-by: Restyled.io <[email protected]>
1 parent 5a9deb2 commit 44adecb

File tree

17 files changed

+2061
-1343
lines changed

17 files changed

+2061
-1343
lines changed

‎persistent-qq/ChangeLog.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# Changelog for persistent-qq
22

3+
## 2.12.0.7
4+
* [#1601](https://github.com/yesodweb/persistent/pull/1601)
5+
* Adjust a test to avoid deprecated entity definition syntax
6+
37
## 2.12.0.6
48

59
* Fix test compilation by importing `Control.Monad` explicitly [#1487](https://github.com/yesodweb/persistent/pull/1487)

‎persistent-qq/persistent-qq.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 1.12
22
name: persistent-qq
3-
version: 2.12.0.6
3+
version: 2.12.0.7
44
synopsis: Provides a quasi-quoter for raw SQL for persistent
55
description:
66
Please see README and API docs at <http://www.stackage.org/package/persistent>.

‎persistent-qq/test/PersistentTestModels.hs‎

Lines changed: 32 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,6 @@
1111
{-# LANGUAGE TemplateHaskell #-}
1212
{-# LANGUAGE TypeFamilies #-}
1313
{-# LANGUAGE UndecidableInstances #-}
14-
1514
{-# OPTIONS_GHC -ddump-splices #-}
1615

1716
module PersistentTestModels where
@@ -29,16 +28,17 @@ import PersistTestPetCollarType
2928
import PersistTestPetType
3029

3130
share
32-
[ mkPersist sqlSettings { mpsGeneric = True }
31+
[ mkPersist sqlSettings{mpsGeneric = True}
3332
, mkMigrate "testMigrate"
34-
] [persistUpperCase|
33+
]
34+
[persistUpperCase|
3535

3636
-- Dedented comment
3737
-- Header-level comment
3838
-- Indented comment
3939
Person json
4040
name Text
41-
age Int "some ignored -- \" attribute"
41+
age Int some="ignored -- \" attribute"
4242
color Text Maybe -- this is a comment sql=foobarbaz
4343
PersonNameKey name -- this is a comment sql=foobarbaz
4444
deriving Show Eq
@@ -112,12 +112,14 @@ share
112112

113113
|]
114114

115-
deriving instance Show (BackendKey backend) => Show (PetGeneric backend)
116-
deriving instance Eq (BackendKey backend) => Eq (PetGeneric backend)
115+
deriving instance (Show (BackendKey backend)) => Show (PetGeneric backend)
116+
deriving instance (Eq (BackendKey backend)) => Eq (PetGeneric backend)
117117

118-
share [ mkPersist sqlSettings { mpsPrefixFields = False, mpsGeneric = True }
119-
, mkMigrate "noPrefixMigrate"
120-
] [persistLowerCase|
118+
share
119+
[ mkPersist sqlSettings{mpsPrefixFields = False, mpsGeneric = True}
120+
, mkMigrate "noPrefixMigrate"
121+
]
122+
[persistLowerCase|
121123
NoPrefix1
122124
someFieldName Int
123125
NoPrefix2
@@ -129,23 +131,27 @@ NoPrefix2
129131
deriving Show Eq
130132
|]
131133

132-
deriving instance Show (BackendKey backend) => Show (NoPrefix1Generic backend)
133-
deriving instance Eq (BackendKey backend) => Eq (NoPrefix1Generic backend)
134+
deriving instance (Show (BackendKey backend)) => Show (NoPrefix1Generic backend)
135+
deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix1Generic backend)
134136

135-
deriving instance Show (BackendKey backend) => Show (NoPrefix2Generic backend)
136-
deriving instance Eq (BackendKey backend) => Eq (NoPrefix2Generic backend)
137+
deriving instance (Show (BackendKey backend)) => Show (NoPrefix2Generic backend)
138+
deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix2Generic backend)
137139

138140
-- | Reverses the order of the fields of an entity. Used to test
139141
-- @??@ placeholders of 'rawSql'.
140142
newtype ReverseFieldOrder a = RFO {unRFO :: a} deriving (Eq, Show)
141-
instance ToJSON (Key (ReverseFieldOrder a)) where toJSON = error "ReverseFieldOrder"
142-
instance FromJSON (Key (ReverseFieldOrder a)) where parseJSON = error "ReverseFieldOrder"
143+
144+
instance ToJSON (Key (ReverseFieldOrder a)) where
145+
toJSON = error "ReverseFieldOrder"
146+
instance FromJSON (Key (ReverseFieldOrder a)) where
147+
parseJSON = error "ReverseFieldOrder"
143148
instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
144149
type PersistEntityBackend (ReverseFieldOrder a) = PersistEntityBackend a
145150

146-
newtype Key (ReverseFieldOrder a) = RFOKey { unRFOKey :: BackendKey SqlBackend } deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
151+
newtype Key (ReverseFieldOrder a) = RFOKey {unRFOKey :: BackendKey SqlBackend}
152+
deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
147153
keyFromValues = fmap RFOKey . fromPersistValue . head
148-
keyToValues = (:[]) . toPersistValue . unRFOKey
154+
keyToValues = (: []) . toPersistValue . unRFOKey
149155

150156
entityDef = revFields . entityDef . unRfoProxy
151157
where
@@ -158,7 +164,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
158164
persistFieldDef = persistFieldDef . unEFRFO
159165
fromPersistValues = fmap RFO . fromPersistValues . reverse
160166

161-
newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a }
167+
newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a}
162168
persistUniqueToFieldNames = NEL.reverse . persistUniqueToFieldNames . unURFO
163169
persistUniqueToValues = reverse . persistUniqueToValues . unURFO
164170
persistUniqueKeys = map URFO . reverse . persistUniqueKeys . unRFO
@@ -170,11 +176,11 @@ cleanDB
170176
:: (MonadIO m, PersistQuery backend, PersistStoreWrite (BaseBackend backend))
171177
=> ReaderT backend m ()
172178
cleanDB = do
173-
deleteWhere ([] :: [Filter (PersonGeneric backend)])
174-
deleteWhere ([] :: [Filter (Person1Generic backend)])
175-
deleteWhere ([] :: [Filter (PetGeneric backend)])
176-
deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
177-
deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
178-
deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
179-
deleteWhere ([] :: [Filter (UserPTGeneric backend)])
180-
deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
179+
deleteWhere ([] :: [Filter (PersonGeneric backend)])
180+
deleteWhere ([] :: [Filter (Person1Generic backend)])
181+
deleteWhere ([] :: [Filter (PetGeneric backend)])
182+
deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
183+
deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
184+
deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
185+
deleteWhere ([] :: [Filter (UserPTGeneric backend)])
186+
deleteWhere ([] :: [Filter (EmailPTGeneric backend)])

‎persistent-sqlite/test1.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{- FOURMOLU_DISABLE -}
12
{-# LANGUAGE TypeFamilies #-}
23
{-# LANGUAGE QuasiQuotes #-}
34
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -8,7 +9,7 @@ import Control.Monad.IO.Class
89
mkPersist [$persist|
910
Person sql=PersonTable
1011
name String update Eq Ne Desc In
11-
age Int update "Asc" Lt "some ignored attribute"
12+
age Int update Asc Lt someIgnoredAttribute
1213
color String null Eq Ne sql=mycolorfield NotIn Ge
1314
PersonNameKey name
1415
Pet

‎persistent-test/ChangeLog.md‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
## Unreleased changes
22

3+
# 2.13.2.0
4+
* [#1601](https://github.com/yesodweb/persistent/pull/1601)
5+
* Adjust test data to avoid deprecated entity definition syntax
6+
37
## 2.13.1.4
48

59
* Support `persistent-2.17`

‎persistent-test/persistent-test.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: persistent-test
2-
version: 2.13.1.4
2+
version: 2.13.2.0
33
license: MIT
44
license-file: LICENSE
55
author: Michael Snoyman <[email protected]>

‎persistent-test/src/PersistentTestModels.hs‎

Lines changed: 82 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
1+
{-# LANGUAGE DeriveGeneric #-}
12
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
23
{-# LANGUAGE StandaloneDeriving #-}
3-
{-# LANGUAGE DeriveGeneric #-}
44
{-# LANGUAGE TypeOperators #-}
5-
{-# LANGUAGE UndecidableInstances #-} -- FIXME
6-
5+
-- FIXME
6+
{-# LANGUAGE UndecidableInstances #-}
77
{-# OPTIONS_GHC -ddump-splices #-}
88

99
module PersistentTestModels where
@@ -12,25 +12,27 @@ import Data.Aeson hiding (Key)
1212

1313
import qualified Data.List.NonEmpty as NEL
1414
import Data.Proxy
15-
import Test.QuickCheck
15+
import Data.Text (append)
1616
import Database.Persist.Sql
1717
import Database.Persist.TH
1818
import Init
19-
import PersistTestPetType
2019
import PersistTestPetCollarType
21-
import Data.Text (append)
20+
import PersistTestPetType
21+
import Test.QuickCheck
2222

2323
-- just need to ensure this compiles
24-
import PersistentTestModelsImports()
24+
import PersistentTestModelsImports ()
2525

26-
share [mkPersist persistSettings { mpsGeneric = True }, mkMigrate "testMigrate"] [persistUpperCase|
26+
share
27+
[mkPersist persistSettings{mpsGeneric = True}, mkMigrate "testMigrate"]
28+
[persistUpperCase|
2729

2830
-- Dedented comment
2931
-- Header-level comment
3032
-- Indented comment
3133
Person json
3234
name Text
33-
age Int "some ignored -- \" attribute"
35+
age Int some="ignored -- \" attribute"
3436
color Text Maybe -- this is a comment sql=foobarbaz
3537
PersonNameKey name -- this is a comment sql=foobarbaz
3638
deriving Show Eq
@@ -125,20 +127,24 @@ share [mkPersist persistSettings { mpsGeneric = True }, mkMigrate "testMigrate"
125127

126128
|]
127129

128-
deriving instance Show (BackendKey backend) => Show (PetGeneric backend)
129-
deriving instance Eq (BackendKey backend) => Eq (PetGeneric backend)
130-
131-
deriving instance Show (BackendKey backend) => Show (RelationshipGeneric backend)
132-
deriving instance Eq (BackendKey backend) => Eq (RelationshipGeneric backend)
133-
134-
share [mkPersist persistSettings {
135-
mpsPrefixFields = False
136-
, mpsFieldLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
137-
, mpsConstraintLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
138-
, mpsGeneric = True
139-
}
140-
, mkMigrate "noPrefixMigrate"
141-
] [persistLowerCase|
130+
deriving instance (Show (BackendKey backend)) => Show (PetGeneric backend)
131+
deriving instance (Eq (BackendKey backend)) => Eq (PetGeneric backend)
132+
133+
deriving instance
134+
(Show (BackendKey backend)) => Show (RelationshipGeneric backend)
135+
deriving instance (Eq (BackendKey backend)) => Eq (RelationshipGeneric backend)
136+
137+
share
138+
[ mkPersist
139+
persistSettings
140+
{ mpsPrefixFields = False
141+
, mpsFieldLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
142+
, mpsConstraintLabelModifier = \_ _ -> "" -- this field is ignored when mpsPrefixFields == False
143+
, mpsGeneric = True
144+
}
145+
, mkMigrate "noPrefixMigrate"
146+
]
147+
[persistLowerCase|
142148
NoPrefix1
143149
someFieldName Int
144150
NoPrefix2
@@ -151,26 +157,29 @@ NoPrefix2
151157

152158
|]
153159

154-
deriving instance Show (BackendKey backend) => Show (NoPrefix1Generic backend)
155-
deriving instance Eq (BackendKey backend) => Eq (NoPrefix1Generic backend)
156-
157-
deriving instance Show (BackendKey backend) => Show (NoPrefix2Generic backend)
158-
deriving instance Eq (BackendKey backend) => Eq (NoPrefix2Generic backend)
159-
160-
share [mkPersist persistSettings {
161-
mpsFieldLabelModifier = \entity field -> case entity of
162-
"CustomPrefix1" -> append "_cp1" field
163-
"CustomPrefix2" -> append "_cp2" field
164-
_ -> error "should not be called"
165-
, mpsConstraintLabelModifier = \entity field -> case entity of
166-
"CustomPrefix1" -> append "CP1" field
167-
"CustomPrefix2" -> append "CP2" field
168-
"CustomPrefixSum" -> append "CP" field
169-
_ -> error "should not be called"
170-
, mpsGeneric = True
171-
}
172-
, mkMigrate "customPrefixMigrate"
173-
] [persistLowerCase|
160+
deriving instance (Show (BackendKey backend)) => Show (NoPrefix1Generic backend)
161+
deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix1Generic backend)
162+
163+
deriving instance (Show (BackendKey backend)) => Show (NoPrefix2Generic backend)
164+
deriving instance (Eq (BackendKey backend)) => Eq (NoPrefix2Generic backend)
165+
166+
share
167+
[ mkPersist
168+
persistSettings
169+
{ mpsFieldLabelModifier = \entity field -> case entity of
170+
"CustomPrefix1" -> append "_cp1" field
171+
"CustomPrefix2" -> append "_cp2" field
172+
_ -> error "should not be called"
173+
, mpsConstraintLabelModifier = \entity field -> case entity of
174+
"CustomPrefix1" -> append "CP1" field
175+
"CustomPrefix2" -> append "CP2" field
176+
"CustomPrefixSum" -> append "CP" field
177+
_ -> error "should not be called"
178+
, mpsGeneric = True
179+
}
180+
, mkMigrate "customPrefixMigrate"
181+
]
182+
[persistLowerCase|
174183
CustomPrefix1
175184
customFieldName Int
176185
CustomPrefix2
@@ -182,15 +191,19 @@ CustomPrefix2
182191
deriving Show Eq
183192
|]
184193

185-
deriving instance Show (BackendKey backend) => Show (CustomPrefix1Generic backend)
186-
deriving instance Eq (BackendKey backend) => Eq (CustomPrefix1Generic backend)
194+
deriving instance
195+
(Show (BackendKey backend)) => Show (CustomPrefix1Generic backend)
196+
deriving instance (Eq (BackendKey backend)) => Eq (CustomPrefix1Generic backend)
187197

188-
deriving instance Show (BackendKey backend) => Show (CustomPrefix2Generic backend)
189-
deriving instance Eq (BackendKey backend) => Eq (CustomPrefix2Generic backend)
198+
deriving instance
199+
(Show (BackendKey backend)) => Show (CustomPrefix2Generic backend)
200+
deriving instance (Eq (BackendKey backend)) => Eq (CustomPrefix2Generic backend)
190201

191-
share [mkPersist persistSettings { mpsPrefixFields = False, mpsGeneric = False }
192-
, mkMigrate "treeMigrate"
193-
] [persistLowerCase|
202+
share
203+
[ mkPersist persistSettings{mpsPrefixFields = False, mpsGeneric = False}
204+
, mkMigrate "treeMigrate"
205+
]
206+
[persistLowerCase|
194207

195208
Tree sql=trees
196209
name String
@@ -202,14 +215,18 @@ Tree sql=trees
202215
-- | Reverses the order of the fields of an entity. Used to test
203216
-- @??@ placeholders of 'rawSql'.
204217
newtype ReverseFieldOrder a = RFO {unRFO :: a} deriving (Eq, Show)
205-
instance ToJSON (Key (ReverseFieldOrder a)) where toJSON = error "ReverseFieldOrder"
206-
instance FromJSON (Key (ReverseFieldOrder a)) where parseJSON = error "ReverseFieldOrder"
218+
219+
instance ToJSON (Key (ReverseFieldOrder a)) where
220+
toJSON = error "ReverseFieldOrder"
221+
instance FromJSON (Key (ReverseFieldOrder a)) where
222+
parseJSON = error "ReverseFieldOrder"
207223
instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
208224
type PersistEntityBackend (ReverseFieldOrder a) = PersistEntityBackend a
209225

210-
newtype Key (ReverseFieldOrder a) = RFOKey { unRFOKey :: BackendKey SqlBackend } deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
226+
newtype Key (ReverseFieldOrder a) = RFOKey {unRFOKey :: BackendKey SqlBackend}
227+
deriving (Show, Read, Eq, Ord, PersistField, PersistFieldSql)
211228
keyFromValues = fmap RFOKey . fromPersistValue . head
212-
keyToValues = (:[]) . toPersistValue . unRFOKey
229+
keyToValues = (: []) . toPersistValue . unRFOKey
213230

214231
entityDef = revFields . entityDef . unRfoProxy
215232
where
@@ -222,7 +239,7 @@ instance (PersistEntity a) => PersistEntity (ReverseFieldOrder a) where
222239
persistFieldDef = persistFieldDef . unEFRFO
223240
fromPersistValues = fmap RFO . fromPersistValues . reverse
224241

225-
newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a }
242+
newtype Unique (ReverseFieldOrder a) = URFO {unURFO :: Unique a}
226243
persistUniqueToFieldNames = NEL.reverse . persistUniqueToFieldNames . unURFO
227244
persistUniqueToValues = reverse . persistUniqueToValues . unURFO
228245
persistUniqueKeys = fmap URFO . reverse . persistUniqueKeys . unRFO
@@ -234,13 +251,13 @@ cleanDB
234251
:: (MonadIO m, PersistQuery backend, PersistStoreWrite (BaseBackend backend))
235252
=> ReaderT backend m ()
236253
cleanDB = do
237-
deleteWhere ([] :: [Filter (PersonGeneric backend)])
238-
deleteWhere ([] :: [Filter (Person1Generic backend)])
239-
deleteWhere ([] :: [Filter (PetGeneric backend)])
240-
deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
241-
deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
242-
deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
243-
deleteWhere ([] :: [Filter (UserPTGeneric backend)])
244-
deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
245-
deleteWhere ([] :: [Filter (UpsertGeneric backend)])
246-
deleteWhere ([] :: [Filter (UpsertByGeneric backend)])
254+
deleteWhere ([] :: [Filter (PersonGeneric backend)])
255+
deleteWhere ([] :: [Filter (Person1Generic backend)])
256+
deleteWhere ([] :: [Filter (PetGeneric backend)])
257+
deleteWhere ([] :: [Filter (MaybeOwnedPetGeneric backend)])
258+
deleteWhere ([] :: [Filter (NeedsPetGeneric backend)])
259+
deleteWhere ([] :: [Filter (OutdoorPetGeneric backend)])
260+
deleteWhere ([] :: [Filter (UserPTGeneric backend)])
261+
deleteWhere ([] :: [Filter (EmailPTGeneric backend)])
262+
deleteWhere ([] :: [Filter (UpsertGeneric backend)])
263+
deleteWhere ([] :: [Filter (UpsertByGeneric backend)])

‎persistent/ChangeLog.md‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,12 @@
11
# Changelog for persistent
22

3+
# 2.17.1.0
4+
5+
* [#1601](https://github.com/yesodweb/persistent/pull/1601)
6+
* Fix parsing of quoted entity field attributes
7+
* Add and enforce `psQuotedAttributeErrorLevel` to deprecate quoted entity field attributes
8+
* Improve parsing of types and entity fields
9+
310
# 2.17.0.0
411

512
* [#1595](https://github.com/yesodweb/persistent/pull/1595)

0 commit comments

Comments
 (0)