Hello community,
here is the log from the commit of package ghc-persistent-template for
openSUSE:Factory checked in at 2020-01-29 13:13:02
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-persistent-template (Old)
and /work/SRC/openSUSE:Factory/.ghc-persistent-template.new.26092 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent-template"
Wed Jan 29 13:13:02 2020 rev:21 rq:766987 version:2.8.0.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-persistent-template/ghc-persistent-template.changes
2019-12-27 13:56:18.640743603 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-persistent-template.new.26092/ghc-persistent-template.changes
2020-01-29 13:13:23.442016774 +0100
@@ -1,0 +2,28 @@
+Tue Jan 14 03:03:07 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.8.0.1.
+ ## 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)
+
+-------------------------------------------------------------------
+Sat Jan 4 03:01:38 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.8.0.
+ ## 2.8.0
+
+ * Reduces the amount of code generated by Template Haskell. The amount of
code generated for a certain function was O(N^2) with respect to the number of
fields on a given Entity. This change shows dramatic improvements in benchmarks
for compiling Persistent models. [#]()
+ * Drops support for GHC 8.0, so that `DerivingStrategies` can be used by
`persistent-template`
+ * `persistent-template` now requires `DerivingStrategies`,
`GeneralizedNewtypeDeriving`, and `StandaloneDeriving` to be enabled in the
file where Persistent entities are created
+ * Fixes a long-standing issue where persistent-template would fail when
`DeriveAnyClass` was enabled (See #578)
+ * [#1002](https://github.com/yesodweb/persistent/pull/1002)
+
+-------------------------------------------------------------------
+Thu Jan 2 03:01:46 UTC 2020 - [email protected]
+
+- Update persistent-template to version 2.7.4.
+ ## 2.7.4
+
+ * Remove an overlapping instance for `Lift a`.
[#998](https://github.com/yesodweb/persistent/pull/998)
+
+-------------------------------------------------------------------
Old:
----
persistent-template-2.7.3.tar.gz
New:
----
persistent-template-2.8.0.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-persistent-template.spec ++++++
--- /var/tmp/diff_new_pack.Y3rSOO/_old 2020-01-29 13:13:27.758018981 +0100
+++ /var/tmp/diff_new_pack.Y3rSOO/_new 2020-01-29 13:13:27.758018981 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-persistent-template
#
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
%global pkg_name persistent-template
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 2.7.3
+Version: 2.8.0.1
Release: 0
Summary: Type-safe, non-relational, multi-backend persistence
License: MIT
@@ -37,6 +37,7 @@
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-template-haskell-devel
BuildRequires: ghc-text-devel
+BuildRequires: ghc-th-lift-instances-devel
BuildRequires: ghc-transformers-devel
BuildRequires: ghc-unordered-containers-devel
%if %{with tests}
++++++ persistent-template-2.7.3.tar.gz -> persistent-template-2.8.0.1.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.7.3/ChangeLog.md
new/persistent-template-2.8.0.1/ChangeLog.md
--- old/persistent-template-2.7.3/ChangeLog.md 2019-10-28 16:58:53.000000000
+0100
+++ new/persistent-template-2.8.0.1/ChangeLog.md 2020-01-13
20:53:42.000000000 +0100
@@ -1,5 +1,21 @@
## Unreleased changes
+## 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)
+
+## 2.8.0
+
+* Reduces the amount of code generated by Template Haskell. The amount of code
generated for a certain function was O(N^2) with respect to the number of
fields on a given Entity. This change shows dramatic improvements in benchmarks
for compiling Persistent models. [#]()
+* Drops support for GHC 8.0, so that `DerivingStrategies` can be used by
`persistent-template`
+* `persistent-template` now requires `DerivingStrategies`,
`GeneralizedNewtypeDeriving`, and `StandaloneDeriving` to be enabled in the
file where Persistent entities are created
+* Fixes a long-standing issue where persistent-template would fail when
`DeriveAnyClass` was enabled (See #578)
+* [#1002](https://github.com/yesodweb/persistent/pull/1002)
+
+## 2.7.4
+
+* Remove an overlapping instance for `Lift a`.
[#998](https://github.com/yesodweb/persistent/pull/998)
+
## 2.7.3
* Update module documentation for `Database.Persist.TH` to better describe the
purpose of the module [#968](https://github.com/yesodweb/persistent/pull/968)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.7.3/Database/Persist/TH.hs
new/persistent-template-2.8.0.1/Database/Persist/TH.hs
--- old/persistent-template-2.7.3/Database/Persist/TH.hs 2019-10-28
16:58:53.000000000 +0100
+++ new/persistent-template-2.8.0.1/Database/Persist/TH.hs 2020-01-13
20:53:42.000000000 +0100
@@ -7,6 +7,10 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-fields #-}
-- | This module provides the tools for defining your database schema and using
@@ -46,9 +50,12 @@
, OnlyOneUniqueKey(..)
) where
+-- Development Tip: See persistent-template/README.md for advice on seeing
generated Template Haskell code
+-- It's highly recommended to check the diff between master and your PR's
generated code.
+
import Prelude hiding ((++), take, concat, splitAt, exp)
-import Control.Monad (forM, unless, (<=<), mzero)
+import Control.Monad (forM, mzero, filterM)
import Data.Aeson
( ToJSON (toJSON), FromJSON (parseJSON), (.=), object
, Value (Object), (.:), (.:?)
@@ -59,6 +66,7 @@
import qualified Data.HashMap.Strict as HM
import Data.Int (Int64)
import Data.List (foldl')
+import qualified Data.List as List
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as M
import Data.Maybe (isJust, listToMaybe, mapMaybe, fromMaybe)
@@ -70,10 +78,12 @@
import qualified Data.Text.Encoding as TE
import GHC.Generics (Generic)
import GHC.TypeLits
+import Instances.TH.Lift ()
+ -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
+ -- instance on pre-1.2.4 versions of `text`
import Language.Haskell.TH.Lib (conT, varE)
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
-import Text.Read (readPrec, lexP, step, prec, parens, Lexeme(Ident))
import Web.PathPieces (PathPiece(..))
import Web.HttpApiData (ToHttpApiData(..), FromHttpApiData(..))
@@ -493,17 +503,10 @@
dataTypeDec :: MkPersistSettings -> EntityDef -> Q Dec
dataTypeDec mps t = do
let names = map (mkName . unpack) $ entityDerives t
-#if MIN_VERSION_template_haskell(2,12,0)
DataD [] nameFinal paramsFinal
Nothing
constrs
<$> fmap (pure . DerivClause Nothing) (mapM conT names)
-#else
- DataD [] nameFinal paramsFinal
- Nothing
- constrs
- <$> mapM conT names
-#endif
where
mkCol x fd@FieldDef {..} =
(mkName $ unpack $ recName mps x fieldHaskell,
@@ -552,11 +555,7 @@
#endif
where
derivClause [] = []
-#if MIN_VERSION_template_haskell(2,12,0)
derivClause _ = [DerivClause Nothing [ConT ''Show]]
-#else
- derivClause _ = [ConT ''Show]
-#endif
mkUnique :: MkPersistSettings -> EntityDef -> UniqueDef -> Con
mkUnique mps t (UniqueDef (HaskellName constr) _ fields attrs) =
@@ -806,21 +805,18 @@
bi <- backendKeyI
return (bi, allInstances)
+ requirePersistentExtensions
+
#if MIN_VERSION_template_haskell(2,15,0)
cxti <- mapM conT i
let kd = if useNewtype
- then NewtypeInstD [] Nothing (AppT (ConT k) recordType) Nothing
dec [DerivClause Nothing cxti]
- else DataInstD [] Nothing (AppT (ConT k) recordType) Nothing
[dec] [DerivClause Nothing cxti]
-#elif MIN_VERSION_template_haskell(2,12,0)
- cxti <- mapM conT i
- let kd = if useNewtype
- then NewtypeInstD [] k [recordType] Nothing dec [DerivClause
Nothing cxti]
- else DataInstD [] k [recordType] Nothing [dec] [DerivClause
Nothing cxti]
+ then NewtypeInstD [] Nothing (AppT (ConT k) recordType) Nothing
dec [DerivClause (Just NewtypeStrategy) cxti]
+ else DataInstD [] Nothing (AppT (ConT k) recordType) Nothing
[dec] [DerivClause (Just StockStrategy) cxti]
#else
cxti <- mapM conT i
let kd = if useNewtype
- then NewtypeInstD [] k [recordType] Nothing dec cxti
- else DataInstD [] k [recordType] Nothing [dec] cxti
+ then NewtypeInstD [] k [recordType] Nothing dec [DerivClause
(Just NewtypeStrategy) cxti]
+ else DataInstD [] k [recordType] Nothing [dec] [DerivClause
(Just StockStrategy) cxti]
#endif
return (kd, instDecs)
where
@@ -840,10 +836,6 @@
instance FromJSON (Key $(pure recordType))
|]
- keyStringL = StringL . keyString
- -- ghc 7.6 cannot parse the left arrow Ident $() <- lexP
- keyPattern = BindS (ConP 'Ident [LitP $ keyStringL t])
-
backendKeyGenericI =
[d| instance PersistStore $(pure backendT) =>
ToBackendKey $(pure backendT) $(pure recordType) where
@@ -856,43 +848,22 @@
fromBackendKey = $(return keyConE)
|]
- -- truly unfortunate that TH doesn't support standalone deriving
- -- https://ghc.haskell.org/trac/ghc/ticket/8100
genericNewtypeInstances = do
- instances <- [|lexP|] >>= \lexPE -> [| step readPrec >>= return .
($(pure keyConE) )|] >>= \readE -> do
+ requirePersistentExtensions
+
+ instances <- do
alwaysInstances <-
- [d|instance Show (BackendKey $(pure backendT)) => Show (Key $(pure
recordType)) where
- showsPrec i x = showParen (i > app_prec) $
- (showString $ $(pure $ LitE $ keyStringL t) `mappend` " ") .
- showsPrec i ($(return unKeyE) x)
- where app_prec = (10::Int)
- instance Read (BackendKey $(pure backendT)) => Read (Key $(pure
recordType)) where
- readPrec = parens $ (prec app_prec $ $(pure $ DoE [keyPattern
lexPE, NoBindS readE]))
- where app_prec = (10::Int)
- instance Eq (BackendKey $(pure backendT)) => Eq (Key $(pure
recordType)) where
- x == y =
- ($(return unKeyE) x) ==
- ($(return unKeyE) y)
- instance Ord (BackendKey $(pure backendT)) => Ord (Key $(pure
recordType)) where
- compare x y = compare
- ($(return unKeyE) x)
- ($(return unKeyE) y)
- instance ToHttpApiData (BackendKey $(pure backendT)) =>
ToHttpApiData (Key $(pure recordType)) where
- toUrlPiece = toUrlPiece . $(return unKeyE)
- instance FromHttpApiData (BackendKey $(pure backendT)) =>
FromHttpApiData(Key $(pure recordType)) where
- parseUrlPiece = fmap $(return keyConE) . parseUrlPiece
- instance PathPiece (BackendKey $(pure backendT)) => PathPiece
(Key $(pure recordType)) where
- toPathPiece = toPathPiece . $(return unKeyE)
- fromPathPiece = fmap $(return keyConE) . fromPathPiece
- instance PersistField (BackendKey $(pure backendT)) =>
PersistField (Key $(pure recordType)) where
- toPersistValue = toPersistValue . $(return unKeyE)
- fromPersistValue = fmap $(return keyConE) . fromPersistValue
- instance PersistFieldSql (BackendKey $(pure backendT)) =>
PersistFieldSql (Key $(pure recordType)) where
- sqlType = sqlType . fmap $(return unKeyE)
- instance ToJSON (BackendKey $(pure backendT)) => ToJSON (Key
$(pure recordType)) where
- toJSON = toJSON . $(return unKeyE)
- instance FromJSON (BackendKey $(pure backendT)) => FromJSON (Key
$(pure recordType)) where
- parseJSON = fmap $(return keyConE) . parseJSON
+ [d|deriving newtype instance Show (BackendKey $(pure backendT)) =>
Show (Key $(pure recordType))
+ deriving newtype instance Read (BackendKey $(pure backendT)) =>
Read (Key $(pure recordType))
+ deriving newtype instance Eq (BackendKey $(pure backendT)) => Eq
(Key $(pure recordType))
+ deriving newtype instance Ord (BackendKey $(pure backendT)) =>
Ord (Key $(pure recordType))
+ deriving newtype instance ToHttpApiData (BackendKey $(pure
backendT)) => ToHttpApiData (Key $(pure recordType))
+ deriving newtype instance FromHttpApiData (BackendKey $(pure
backendT)) => FromHttpApiData(Key $(pure recordType))
+ deriving newtype instance PathPiece (BackendKey $(pure backendT))
=> PathPiece (Key $(pure recordType))
+ deriving newtype instance PersistField (BackendKey $(pure
backendT)) => PersistField (Key $(pure recordType))
+ deriving newtype instance PersistFieldSql (BackendKey $(pure
backendT)) => PersistFieldSql (Key $(pure recordType))
+ deriving newtype instance ToJSON (BackendKey $(pure backendT)) =>
ToJSON (Key $(pure recordType))
+ deriving newtype instance FromJSON (BackendKey $(pure backendT))
=> FromJSON (Key $(pure recordType))
|]
if customKeyType then return alwaysInstances
@@ -1006,6 +977,7 @@
suc <- patternSuccess
return [ suc, normalClause [VarP x] patternMatchFailure ]
where
+ tableName = unDBName (entityDB t)
patternSuccess =
case fields of
[] -> do
@@ -1028,23 +1000,18 @@
UInfixE exp applyE (fpv `AppE` VarE name)
mkPersistValue field =
- [|mapLeft (fieldError t field) . fromPersistValue|]
+ let fieldName = (unHaskellName (fieldHaskell field))
+ in [|mapLeft (fieldError tableName fieldName) . fromPersistValue|]
-fieldError :: EntityDef -> FieldDef -> Text -> Text
-fieldError entity field err = mconcat
+fieldError :: Text -> Text -> Text -> Text
+fieldError tableName fieldName err = mconcat
[ "Couldn't parse field `"
, fieldName
, "` from table `"
, tableName
, "`. "
, err
- ]
- where
- fieldName =
- unHaskellName (fieldHaskell field)
-
- tableName =
- unDBName (entityDB entity)
+ ]
mkEntity :: EntityMap -> MkPersistSettings -> EntityDef -> Q [Dec]
mkEntity entityMap mps t = do
@@ -1138,13 +1105,7 @@
mkUniqueKeyInstances :: MkPersistSettings -> EntityDef -> Q [Dec]
mkUniqueKeyInstances mps t = do
- -- FIXME: isExtEnabled breaks the benchmark
- undecidableInstancesEnabled <- isExtEnabled UndecidableInstances
- unless undecidableInstancesEnabled . fail
- $ "Generating Persistent entities now requires the
'UndecidableInstances' "
- `mappend` "language extension. Please enable it in your file by
copy/pasting "
- `mappend` "this line into the top of your file: \n\n"
- `mappend` "{-# LANGUAGE UndecidableInstances #-}"
+ requirePersistentExtensions
case entityUniques t of
[] -> mappend <$> typeErrorSingle <*> typeErrorAtLeastOne
[_] -> mappend <$> singleUniqueKey <*> atLeastOneKey
@@ -1291,50 +1252,56 @@
maybeTyp may typ | may = ConT ''Maybe `AppT` typ
| otherwise = typ
--- | produce code similar to the following:
+
+
+entityToPersistValueHelper :: (PersistEntity record) => record -> PersistValue
+entityToPersistValueHelper entity = PersistMap $ zip columnNames
fieldsAsPersistValues
+ where
+ columnNames = map (unHaskellName . fieldHaskell) (entityFields
(entityDef (Just entity)))
+ fieldsAsPersistValues = map toPersistValue $ toPersistFields entity
+
+entityFromPersistValueHelper :: (PersistEntity record)
+ => [String] -- ^ Column names, as '[String]' to
avoid extra calls to "pack" in the generated code
+ -> PersistValue
+ -> Either Text record
+entityFromPersistValueHelper columnNames pv = do
+ (persistMap :: [(T.Text, PersistValue)]) <- getPersistMap pv
+
+ let columnMap = HM.fromList persistMap
+ lookupPersistValueByColumnName :: String -> PersistValue
+ lookupPersistValueByColumnName columnName =
+ fromMaybe PersistNull (HM.lookup (pack columnName) columnMap)
+
+ fromPersistValues $ map lookupPersistValueByColumnName columnNames
+
+-- | Produce code similar to the following:
--
-- @
-- instance PersistEntity e => PersistField e where
--- toPersistValue = PersistMap $ zip columNames (map toPersistValue .
toPersistFields)
--- fromPersistValue (PersistMap o) =
--- let columns = HM.fromList o
--- in fromPersistValues $ map (\name ->
--- case HM.lookup name columns of
--- Just v -> v
--- Nothing -> PersistNull
--- fromPersistValue x = Left $ "Expected PersistMap, received: " ++ show x
+-- toPersistValue = entityToPersistValueHelper
+-- fromPersistValue = entityFromPersistValueHelper ["col1", "col2"]
-- sqlType _ = SqlString
-- @
persistFieldFromEntity :: MkPersistSettings -> EntityDef -> Q [Dec]
-persistFieldFromEntity mps e = do
- ss <- [|SqlString|]
- obj <- [|\ent -> PersistMap $ zip (map pack columnNames) (map
toPersistValue $ toPersistFields ent)|]
- fpv <- [|\x -> let columns = HM.fromList x
- in fromPersistValues $ map
- (\(name) ->
- case HM.lookup (pack name) columns of
- Just v -> v
- Nothing -> PersistNull)
- $ columnNames
- |]
+persistFieldFromEntity mps entDef = do
+ sqlStringConstructor' <- [|SqlString|]
+ toPersistValueImplementation <- [|entityToPersistValueHelper|]
+ fromPersistValueImplementation <- [|entityFromPersistValueHelper
columnNames|]
- compose <- [|(<=<)|]
- getPersistMap' <- [|getPersistMap|]
return
[ persistFieldInstanceD (mpsGeneric mps) typ
- [ FunD 'toPersistValue [ normalClause [] obj ]
+ [ FunD 'toPersistValue [ normalClause []
toPersistValueImplementation ]
, FunD 'fromPersistValue
- [ normalClause [] (InfixE (Just fpv) compose $ Just
getPersistMap')
- ]
+ [ normalClause [] fromPersistValueImplementation ]
]
, persistFieldSqlInstanceD (mpsGeneric mps) typ
- [ sqlTypeFunD ss
+ [ sqlTypeFunD sqlStringConstructor'
]
]
where
- typ = genericDataType mps (entityHaskell e) backendT
- entFields = entityFields e
- columnNames = map (unpack . unHaskellName . fieldHaskell) entFields
+ typ = genericDataType mps (entityHaskell entDef) backendT
+ entFields = entityFields entDef
+ columnNames = map (unpack . unHaskellName . fieldHaskell) entFields
-- | Apply the given list of functions to the same @EntityDef@s.
--
@@ -1656,29 +1623,6 @@
instance Lift ForeignDef where
lift (ForeignDef a b c d e f g) = [|ForeignDef a b c d e f g|]
--- | A hack to avoid orphans.
-class Lift' a where
- lift' :: a -> Q Exp
-instance Lift' Text where
- lift' = liftT
-instance Lift' a => Lift' [a] where
- lift' xs = do { xs' <- mapM lift' xs; return (ListE xs') }
-instance (Lift' k, Lift' v) => Lift' (M.Map k v) where
- lift' m = [|M.fromList $(fmap ListE $ mapM liftPair $ M.toList m)|]
-
--- overlapping instances is for automatic lifting
--- while avoiding an orphan of Lift for Text
-
--- auto-lifting, means instances are overlapping
-instance {-# OVERLAPPABLE #-} Lift' a => Lift a where
- lift = lift'
-
-liftT :: Text -> Q Exp
-liftT t = [|pack $(lift (unpack t))|]
-
-liftPair :: (Lift' k, Lift' v) => (k, v) -> Q Exp
-liftPair (k, v) = [|($(lift' k), $(lift' v))|]
-
instance Lift HaskellName where
lift (HaskellName t) = [|HaskellName t|]
instance Lift DBName where
@@ -1883,3 +1827,32 @@
-- let x = mkName "x"
-- in normalClause [ConP (mkName constr) [VarP x]]
-- (VarE 'toPersistValue `AppE` VarE x)
+
+-- | Check that all of Persistent's required extensions are enabled, or else
fail compilation
+--
+-- This function should be called before any code that depends on one of the
required extensions being enabled.
+requirePersistentExtensions :: Q ()
+requirePersistentExtensions = 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
+
+ case unenabledExtensions of
+ [] -> pure ()
+ [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
+ [ "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.7.3/README.md
new/persistent-template-2.8.0.1/README.md
--- old/persistent-template-2.7.3/README.md 2019-05-07 01:24:32.000000000
+0200
+++ new/persistent-template-2.8.0.1/README.md 2020-01-13 20:53:42.000000000
+0100
@@ -9,3 +9,17 @@
persistent-template uses `EntityDef`s that it gets from the quasi-quoter.
The quasi-quoter is in persistent Quasi.hs
Similarly mant of the types come from the persistent library
+
+### Development tips
+
+To get a better idea of what code you're generating, you can output the
content of Template Haskell expressions to a file:
+
+```
+stack test persistent-template --ghc-options='-ddump-splices -ddump-to-file'
+```
+
+The output will be in the `.stack-work` directory. The exact path will depend
on your specific setup, but if you search for files ending in `.dump-splices`
you'll find the output (`find .stack-work -type f -name '*.dump-splices'`)
+
+If you make changes to the generated code, it is highly recommended to compare
the output with your changes to output from `master` (even better if this diff
is included in your PR!). Seemingly small changes can have dramatic changes on
the generated code.
+
+For example, embedding an `EntityDef` in a function that was called for every
field of that `Entity` made the number of generated lines O(N^2) for that
function—very bad!
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.7.3/bench/Main.hs
new/persistent-template-2.8.0.1/bench/Main.hs
--- old/persistent-template-2.7.3/bench/Main.hs 2019-05-07 01:24:32.000000000
+0200
+++ new/persistent-template-2.8.0.1/bench/Main.hs 2020-01-13
20:53:42.000000000 +0100
@@ -18,8 +18,8 @@
main = defaultMain
[ bgroup "mkPersist"
[ bench "From File" $ nfIO $ mkPersist' $(persistFileWith
lowerCaseSettings "bench/models-slowly")
- --, bgroup "Non-Null Fields"
- -- , bgroup "Increasing model count"
+ -- , bgroup "Non-Null Fields"
+ -- [ bgroup "Increasing model count"
-- [ bench "1x10" $ nfIO $ mkPersist' $( parseReferencesQ
(mkModels 10 10))
-- , bench "10x10" $ nfIO $ mkPersist' $(parseReferencesQ
(mkModels 10 10))
-- , bench "100x10" $ nfIO $ mkPersist' $(parseReferencesQ
(mkModels 100 10))
@@ -32,7 +32,7 @@
-- -- , bench "10x1000" $ nfIO $ mkPersist' $(parseReferencesQ
(mkModels 10 1000))
-- ]
-- ]
- --, bgroup "Nullable"
+ -- , bgroup "Nullable"
-- [ bgroup "Increasing model count"
-- [ bench "20x10" $ nfIO $ mkPersist' $(parseReferencesQ
(mkNullableModels 20 10))
-- , bench "40x10" $ nfIO $ mkPersist' $(parseReferencesQ
(mkNullableModels 40 10))
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.7.3/persistent-template.cabal
new/persistent-template-2.8.0.1/persistent-template.cabal
--- old/persistent-template-2.7.3/persistent-template.cabal 2019-10-28
16:58:53.000000000 +0100
+++ new/persistent-template-2.8.0.1/persistent-template.cabal 2020-01-13
20:53:42.000000000 +0100
@@ -1,5 +1,5 @@
name: persistent-template
-version: 2.7.3
+version: 2.8.0.1
license: MIT
license-file: LICENSE
author: Michael Snoyman <[email protected]>
@@ -15,7 +15,7 @@
extra-source-files: test/main.hs ChangeLog.md README.md
library
- build-depends: base >= 4.9 && < 5
+ build-depends: base >= 4.10 && < 5
, persistent >= 2.10 && < 3
, aeson >= 1.0 && < 1.5
, bytestring >= 0.10
@@ -26,6 +26,7 @@
, path-pieces
, template-haskell >= 2.11
, text >= 1.2
+ , th-lift-instances >= 0.1.14 && < 0.2
, transformers >= 0.5 && < 0.6
, unordered-containers
exposed-modules: Database.Persist.TH
@@ -39,7 +40,7 @@
other-modules: TemplateTestImports
ghc-options: -Wall
- build-depends: base >= 4.9 && < 5
+ build-depends: base >= 4.10 && < 5
, persistent
, persistent-template
, aeson
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/persistent-template-2.7.3/test/main.hs
new/persistent-template-2.8.0.1/test/main.hs
--- old/persistent-template-2.7.3/test/main.hs 2019-05-22 04:00:54.000000000
+0200
+++ new/persistent-template-2.8.0.1/test/main.hs 2020-01-12
05:32:47.000000000 +0100
@@ -7,6 +7,15 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+-- DeriveAnyClass is not actually used by persistent-template
+-- But a long standing bug was that if it was enabled, it was used to derive
instead of GeneralizedNewtypeDeriving
+-- This was fixed by using DerivingStrategies to specify newtype deriving
should be used.
+-- This pragma is left here as a "test" that deriving works when
DeriveAnyClass is enabled.
+-- See https://github.com/yesodweb/persistent/issues/578
+{-# LANGUAGE DeriveAnyClass #-}
module Main
(
-- avoid unused ident warnings
