Hello community,
here is the log from the commit of package ghc-persistent-template for
openSUSE:Leap:15.2 checked in at 2020-03-13 10:57:03
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Leap:15.2/ghc-persistent-template (Old)
and /work/SRC/openSUSE:Leap:15.2/.ghc-persistent-template.new.3160 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-template"
Fri Mar 13 10:57:03 2020 rev:15 rq:783183 version:2.8.2.3
Changes:
--------
---
/work/SRC/openSUSE:Leap:15.2/ghc-persistent-template/ghc-persistent-template.changes
2020-02-19 18:40:36.478145886 +0100
+++
/work/SRC/openSUSE:Leap:15.2/.ghc-persistent-template.new.3160/ghc-persistent-template.changes
2020-03-13 10:57:04.352421732 +0100
@@ -1,0 +2,33 @@
+Sat Feb 8 03:06:14 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.8.2.3.
+ ## 2.8.2.3
+
+ * Require extensions in a more friendly manner.
[#1030](https://github.com/yesodweb/persistent/pull/1030)
+ * Specify a strategy for all deriving clauses, which avoids the
`-Wmissing-deriving-strategy` warning introduced in GHC 8.8.2.
[#1030](https://github.com/yesodweb/persistent/pull/1030)
+
+ ## 2.8.2.2
+
+ * Fix the `mkPersist` function to not require importing the classes
explicitly. [#1027](https://github.com/yesodweb/persistent/pull/1027)
+
+-------------------------------------------------------------------
+Fri Feb 7 08:06:51 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.8.2.1.
+ ## 2.8.2.1
+
+ * Fix the test-suite for persistent-template.
[#1023](https://github.com/yesodweb/persistent/pull/1023)
+
+-------------------------------------------------------------------
+Wed Jan 29 03:01:47 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.8.2.
+ ## 2.8.2
+
+ * Add `fieldError` to the export list of `Database.Persist.TH`
[#1008](https://github.com/yesodweb/persistent/pull/1008)
+
+ ## 2.8.1
+
+ * Let the user pass instances that will be derived for record and for key
types (https://github.com/yesodweb/persistent/pull/990
+
+-------------------------------------------------------------------
Old:
----
persistent-template-2.8.0.1.tar.gz
New:
----
persistent-template-2.8.2.3.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-template.spec ++++++
--- /var/tmp/diff_new_pack.NykIaG/_old 2020-03-13 10:57:04.664421955 +0100
+++ /var/tmp/diff_new_pack.NykIaG/_new 2020-03-13 10:57:04.664421955 +0100
@@ -19,7 +19,7 @@
%global pkg_name persistent-template
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.8.0.1
+Version: 2.8.2.3
Release: 0
Summary: Type-safe, non-relational, multi-backend persistence
License: MIT
++++++ persistent-template-2.8.0.1.tar.gz -> persistent-template-2.8.2.3.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.8.0.1/ChangeLog.md
new/persistent-template-2.8.2.3/ChangeLog.md
--- old/persistent-template-2.8.0.1/ChangeLog.md 2020-01-13
20:53:42.000000000 +0100
+++ new/persistent-template-2.8.2.3/ChangeLog.md 2020-02-08
02:16:15.000000000 +0100
@@ -1,5 +1,26 @@
## Unreleased changes
+## 2.8.2.3
+
+* Require extensions in a more friendly manner.
[#1030](https://github.com/yesodweb/persistent/pull/1030)
+* Specify a strategy for all deriving clauses, which avoids the
`-Wmissing-deriving-strategy` warning introduced in GHC 8.8.2.
[#1030](https://github.com/yesodweb/persistent/pull/1030)
+
+## 2.8.2.2
+
+* Fix the `mkPersist` function to not require importing the classes
explicitly. [#1027](https://github.com/yesodweb/persistent/pull/1027)
+
+## 2.8.2.1
+
+* Fix the test-suite for persistent-template.
[#1023](https://github.com/yesodweb/persistent/pull/1023)
+
+## 2.8.2
+
+* Add `fieldError` to the export list of `Database.Persist.TH`
[#1008](https://github.com/yesodweb/persistent/pull/1008)
+
+## 2.8.1
+
+* Let the user pass instances that will be derived for record and for key
types (https://github.com/yesodweb/persistent/pull/990
+
## 2.8.0.1
* Small optimization/code cleanup to generated Template Haskell code size, by
slimming the implementation of to/fromPersistValue for Entities.
[#1014](https://github.com/yesodweb/persistent/pull/1014)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.8.0.1/Database/Persist/TH.hs
new/persistent-template-2.8.2.3/Database/Persist/TH.hs
--- old/persistent-template-2.8.0.1/Database/Persist/TH.hs 2020-01-13
20:53:42.000000000 +0100
+++ new/persistent-template-2.8.2.3/Database/Persist/TH.hs 2020-02-08
02:16:15.000000000 +0100
@@ -30,6 +30,7 @@
, mpsPrefixFields
, mpsEntityJSON
, mpsGenerateLenses
+ , mpsDeriveInstances
, EntityJSON(..)
, mkPersistSettings
, sqlSettings
@@ -46,6 +47,7 @@
, lensPTH
, parseReferences
, embedEntityDefs
+ , fieldError
, AtLeastOneUniqueKey(..)
, OnlyOneUniqueKey(..)
) where
@@ -55,7 +57,8 @@
import Prelude hiding ((++), take, concat, splitAt, exp)
-import Control.Monad (forM, mzero, filterM)
+import Data.Either
+import Control.Monad (forM, mzero, filterM, guard, unless)
import Data.Aeson
( ToJSON (toJSON), FromJSON (parseJSON), (.=), object
, Value (Object), (.:), (.:?)
@@ -86,6 +89,7 @@
import Language.Haskell.TH.Syntax
import Web.PathPieces (PathPiece(..))
import Web.HttpApiData (ToHttpApiData(..), FromHttpApiData(..))
+import qualified Data.Set as Set
import Database.Persist
import Database.Persist.Sql (Migration, PersistFieldSql, SqlBackend, migrate,
sqlType)
@@ -397,6 +401,7 @@
-- 'EntityDef's. Works well with the persist quasi-quoter.
mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec]
mkPersist mps ents' = do
+ requireExtensions [[TypeFamilies], [GADTs, ExistentialQuantification]]
x <- fmap Data.Monoid.mconcat $ mapM (persistFieldFromEntity mps) ents
y <- fmap mconcat $ mapM (mkEntity entityMap mps) ents
z <- fmap mconcat $ mapM (mkJSON mps) ents
@@ -445,6 +450,12 @@
-- Default: False
--
-- @since 1.3.1
+ , mpsDeriveInstances :: ![Name]
+ -- ^ Automatically derive these typeclass instances for all record and key
types.
+ --
+ -- Default: []
+ --
+ -- @since 2.8.1
}
data EntityJSON = EntityJSON
@@ -467,6 +478,7 @@
, entityFromJSON = 'entityIdFromJSON
}
, mpsGenerateLenses = False
+ , mpsDeriveInstances = []
}
-- | Use the 'SqlPersist' backend.
@@ -502,12 +514,33 @@
dataTypeDec :: MkPersistSettings -> EntityDef -> Q Dec
dataTypeDec mps t = do
- let names = map (mkName . unpack) $ entityDerives t
- DataD [] nameFinal paramsFinal
+ let entityInstances = map (mkName . unpack) $ entityDerives t
+ additionalInstances = filter (`notElem` entityInstances) $
mpsDeriveInstances mps
+ names = entityInstances <> additionalInstances
+
+ let (stocks, anyclasses) = partitionEithers (map stratFor names)
+ let stockDerives = do
+ guard (not (null stocks))
+ pure (DerivClause (Just StockStrategy) (map ConT stocks))
+ anyclassDerives = do
+ guard (not (null anyclasses))
+ pure (DerivClause (Just AnyclassStrategy) (map ConT anyclasses))
+ unless (null anyclassDerives) $ do
+ requireExtensions [[DeriveAnyClass]]
+ pure $ DataD [] nameFinal paramsFinal
Nothing
constrs
- <$> fmap (pure . DerivClause Nothing) (mapM conT names)
+ (stockDerives <> anyclassDerives)
where
+ stratFor n =
+ if n `elem` stockClasses then
+ Left n
+ else
+ Right n
+
+ stockClasses = Set.fromList . map mkName $
+ [ "Eq", "Ord", "Show", "Read", "Bounded", "Enum", "Ix", "Generic",
"Data", "Typeable"
+ ]
mkCol x fd@FieldDef {..} =
(mkName $ unpack $ recName mps x fieldHaskell,
if fieldStrict then isStrict else notStrict,
@@ -791,14 +824,14 @@
if mpsGeneric mps
then if not useNewtype
then do pfDec <- pfInstD
- return (pfDec, [''Generic])
+ return (pfDec, supplement [''Generic])
else do gi <- genericNewtypeInstances
- return (gi, [])
+ return (gi, supplement [])
else if not useNewtype
then do pfDec <- pfInstD
- return (pfDec, [''Show, ''Read, ''Eq, ''Ord, ''Generic])
+ return (pfDec, supplement [''Show, ''Read, ''Eq, ''Ord,
''Generic])
else do
- let allInstances = [''Show, ''Read, ''Eq, ''Ord,
''PathPiece, ''ToHttpApiData, ''FromHttpApiData, ''PersistField,
''PersistFieldSql, ''ToJSON, ''FromJSON]
+ let allInstances = supplement [''Show, ''Read, ''Eq,
''Ord, ''PathPiece, ''ToHttpApiData, ''FromHttpApiData, ''PersistField,
''PersistFieldSql, ''ToJSON, ''FromJSON]
if customKeyType
then return ([], allInstances)
else do
@@ -873,6 +906,8 @@
useNewtype = pkNewtype mps t
customKeyType = not (defaultIdType t) || not useNewtype || isJust
(entityPrimary t)
+ supplement :: [Name] -> [Name]
+ supplement names = names <> (filter (`notElem` names) $ mpsDeriveInstances
mps)
keyIdName :: EntityDef -> Name
keyIdName = mkName . unpack . keyIdText
@@ -1003,6 +1038,10 @@
let fieldName = (unHaskellName (fieldHaskell field))
in [|mapLeft (fieldError tableName fieldName) . fromPersistValue|]
+-- | Render an error message based on the @tableName@ and @fieldName@ with
+-- the provided message.
+--
+-- @since 2.8.2
fieldError :: Text -> Text -> Text -> Text
fieldError tableName fieldName err = mconcat
[ "Couldn't parse field `"
@@ -1011,7 +1050,7 @@
, tableName
, "`. "
, err
- ]
+ ]
mkEntity :: EntityMap -> MkPersistSettings -> EntityDef -> Q [Dec]
mkEntity entityMap mps t = do
@@ -1111,8 +1150,8 @@
[_] -> mappend <$> singleUniqueKey <*> atLeastOneKey
(_:_) -> mappend <$> typeErrorMultiple <*> atLeastOneKey
where
- requireUniquesPName = mkName "requireUniquesP"
- onlyUniquePName = mkName "onlyUniqueP"
+ requireUniquesPName = 'requireUniquesP
+ onlyUniquePName = 'onlyUniqueP
typeErrorSingle = mkOnlyUniqueError typeErrorNoneCtx
typeErrorMultiple = mkOnlyUniqueError typeErrorMultipleCtx
@@ -1143,7 +1182,7 @@
[ Clause
[ WildP ]
(NormalB
- (VarE (mkName "error") `AppE` LitE (StringL "impossible"))
+ (VarE 'error `AppE` LitE (StringL "impossible"))
)
[]
]
@@ -1260,7 +1299,7 @@
columnNames = map (unHaskellName . fieldHaskell) (entityFields
(entityDef (Just entity)))
fieldsAsPersistValues = map toPersistValue $ toPersistFields entity
-entityFromPersistValueHelper :: (PersistEntity record)
+entityFromPersistValueHelper :: (PersistEntity record)
=> [String] -- ^ Column names, as '[String]' to
avoid extra calls to "pack" in the generated code
-> PersistValue
-> Either Text record
@@ -1269,9 +1308,9 @@
let columnMap = HM.fromList persistMap
lookupPersistValueByColumnName :: String -> PersistValue
- lookupPersistValueByColumnName columnName =
+ lookupPersistValueByColumnName columnName =
fromMaybe PersistNull (HM.lookup (pack columnName) columnMap)
-
+
fromPersistValues $ map lookupPersistValueByColumnName columnNames
-- | Produce code similar to the following:
@@ -1725,6 +1764,7 @@
mkJSON :: MkPersistSettings -> EntityDef -> Q [Dec]
mkJSON _ def | ("json" `notElem` entityAttrs def) = return []
mkJSON mps def = do
+ requireExtensions [[FlexibleInstances]]
pureE <- [|pure|]
apE' <- [|(<*>)|]
packE <- [|pack|]
@@ -1832,27 +1872,46 @@
--
-- This function should be called before any code that depends on one of the
required extensions being enabled.
requirePersistentExtensions :: Q ()
-requirePersistentExtensions = do
+requirePersistentExtensions = requireExtensions requiredExtensions
+ where
+ requiredExtensions = map pure
+ [ DerivingStrategies
+ , GeneralizedNewtypeDeriving
+ , StandaloneDeriving
+ , UndecidableInstances
+ ]
+
+-- | Pass in a list of lists of extensions, where any of the given
+-- extensions will satisfy it. For example, you might need either GADTs or
+-- ExistentialQuantification, so you'd write:
+--
+-- > requireExtensions [[GADTs, ExistentialQuantification]]
+--
+-- But if you need TypeFamilies and MultiParamTypeClasses, then you'd
+-- write:
+--
+-- > requireExtensions [[TypeFamilies], [MultiParamTypeClasses]]
+requireExtensions :: [[Extension]] -> Q ()
+requireExtensions requiredExtensions = do
-- isExtEnabled breaks the persistent-template benchmark with the following
error:
-- Template Haskell error: Can't do `isExtEnabled' in the IO monad
-- You can workaround this by replacing isExtEnabled with (pure . const True)
- unenabledExtensions <- filterM (fmap not . isExtEnabled) requiredExtensions
+ unenabledExtensions <- filterM (fmap (not . or) . traverse isExtEnabled)
requiredExtensions
- case unenabledExtensions of
+ case mapMaybe listToMaybe unenabledExtensions of
[] -> pure ()
- [extension] -> fail $ mconcat
+ [extension] -> fail $ mconcat
[ "Generating Persistent entities now requires the "
, show extension
, " language extension. Please enable it by copy/pasting
this line to the top of your file:\n\n"
, extensionToPragma extension
]
- extensions -> fail $ mconcat
+ extensions -> fail $ mconcat
[ "Generating Persistent entities now requires the
following language extensions:\n\n"
, List.intercalate "\n" (map show extensions)
, "\n\nPlease enable the extensions by copy/pasting these
lines into the top of your file:\n\n"
, List.intercalate "\n" (map extensionToPragma extensions)
]
-
+
where
- requiredExtensions = [DerivingStrategies, GeneralizedNewtypeDeriving,
StandaloneDeriving, UndecidableInstances]
extensionToPragma ext = "{-# LANGUAGE " <> show ext <> " #-}"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/persistent-template-2.8.0.1/persistent-template.cabal
new/persistent-template-2.8.2.3/persistent-template.cabal
--- old/persistent-template-2.8.0.1/persistent-template.cabal 2020-01-13
20:53:42.000000000 +0100
+++ new/persistent-template-2.8.2.3/persistent-template.cabal 2020-02-08
02:16:15.000000000 +0100
@@ -1,5 +1,5 @@
name: persistent-template
-version: 2.8.0.1
+version: 2.8.2.3
license: MIT
license-file: LICENSE
author: Michael Snoyman <[email protected]>
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.8.0.1/test/main.hs
new/persistent-template-2.8.2.3/test/main.hs
--- old/persistent-template-2.8.0.1/test/main.hs 2020-01-12
05:32:47.000000000 +0100
+++ new/persistent-template-2.8.2.3/test/main.hs 2020-01-29
18:07:25.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -31,13 +32,15 @@
import Test.Hspec.QuickCheck
import Test.QuickCheck.Arbitrary
import Test.QuickCheck.Gen (Gen)
+import GHC.Generics (Generic)
import Database.Persist
+import Database.Persist.Sql
import Database.Persist.TH
import TemplateTestImports
-share [mkPersist sqlSettings { mpsGeneric = False }, mkDeleteCascade
sqlSettings { mpsGeneric = False }] [persistUpperCase|
+share [mkPersist sqlSettings { mpsGeneric = False, mpsDeriveInstances =
[''Generic] }, mkDeleteCascade sqlSettings { mpsGeneric = False }]
[persistUpperCase|
Person json
name Text
age Int Maybe
@@ -54,6 +57,9 @@
deriving Show Eq
|]
+-- TODO: Derive Generic at the source site to get this unblocked.
+deriving instance Generic (BackendKey SqlBackend)
+
share [mkPersist sqlSettings { mpsGeneric = False, mpsGenerateLenses = True }]
[persistLowerCase|
Lperson json
name Text
