Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-persistent for openSUSE:Factory checked in at 2021-06-23 17:38:26 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-persistent (Old) and /work/SRC/openSUSE:Factory/.ghc-persistent.new.2625 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-persistent" Wed Jun 23 17:38:26 2021 rev:29 rq:901458 version:2.13.0.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-persistent/ghc-persistent.changes 2021-06-01 10:40:46.601151671 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-persistent.new.2625/ghc-persistent.changes 2021-06-23 17:38:34.524499838 +0200 @@ -1,0 +2,9 @@ +Sat Jun 19 17:44:59 UTC 2021 - [email protected] + +- Update persistent to version 2.13.0.3. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/persistent-2.13.0.3/src/ChangeLog.md + +------------------------------------------------------------------- Old: ---- persistent-2.13.0.2.tar.gz New: ---- persistent-2.13.0.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-persistent.spec ++++++ --- /var/tmp/diff_new_pack.394LYN/_old 2021-06-23 17:38:35.036500543 +0200 +++ /var/tmp/diff_new_pack.394LYN/_new 2021-06-23 17:38:35.036500543 +0200 @@ -19,7 +19,7 @@ %global pkg_name persistent %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.13.0.2 +Version: 2.13.0.3 Release: 0 Summary: Type-safe, multi-backend data serialization License: MIT ++++++ persistent-2.13.0.2.tar.gz -> persistent-2.13.0.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/ChangeLog.md new/persistent-2.13.0.3/ChangeLog.md --- old/persistent-2.13.0.2/ChangeLog.md 2021-05-24 17:18:53.000000000 +0200 +++ new/persistent-2.13.0.3/ChangeLog.md 2021-06-19 00:03:31.000000000 +0200 @@ -1,5 +1,13 @@ # Changelog for persistent +## 2.13.0.3 + +* [#1287](https://github.com/yesodweb/persistent/pull/1287) + * Fix the duplicate entity check for transitive dependencies. + * Fixes an issue where generating code would refer to the `ModelName` when + making a reference to another table when the explicit code only refers to + `ModelNameId`. + ## 2.13.0.2 * [#1265](https://github.com/yesodweb/persistent/pull/1265) @@ -83,17 +91,6 @@ * [#1255](https://github.com/yesodweb/persistent/pull/1255) * `mkPersist` now checks to see if an instance already exists for `PersistEntity` for the inputs. - -## 2.12.1.2 - -* [#1258](https://github.com/yesodweb/persistent/pull/1258) - * Support promoted types in Quasi Quoter -* [#1243](https://github.com/yesodweb/persistent/pull/1243) - * Assorted cleanup of TH module -* [#1242](https://github.com/yesodweb/persistent/pull/1242) - * Refactor setEmbedField to use do notation -* [#1237](https://github.com/yesodweb/persistent/pull/1237) - * Remove nonEmptyOrFail function from recent tests * [#1256](https://github.com/yesodweb/persistent/pull/1256) * The QuasiQuoter has been refactored and improved. * You can now use `mkPersistWith` to pass in a list of pre-existing @@ -108,6 +105,17 @@ * You can use `Key Foo` and `FooId` interchangeably in fields. * Support for GHC < 8.4 dropped. +## 2.12.1.2 + +* [#1258](https://github.com/yesodweb/persistent/pull/1258) + * Support promoted types in Quasi Quoter +* [#1243](https://github.com/yesodweb/persistent/pull/1243) + * Assorted cleanup of TH module +* [#1242](https://github.com/yesodweb/persistent/pull/1242) + * Refactor setEmbedField to use do notation +* [#1237](https://github.com/yesodweb/persistent/pull/1237) + * Remove nonEmptyOrFail function from recent tests + ## 2.12.1.1 * [#1231](https://github.com/yesodweb/persistent/pull/1231) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/Database/Persist/Quasi/Internal.hs new/persistent-2.13.0.3/Database/Persist/Quasi/Internal.hs --- old/persistent-2.13.0.2/Database/Persist/Quasi/Internal.hs 2021-05-24 17:18:53.000000000 +0200 +++ new/persistent-2.13.0.3/Database/Persist/Quasi/Internal.hs 2021-06-19 00:03:31.000000000 +0200 @@ -416,7 +416,7 @@ -- -- @since 2.13.0.0 } - deriving (Show, Lift) + deriving (Eq, Ord, Show, Lift) -- | Convert an 'EntityDef' into an 'UnboundEntityDef'. This "forgets" -- information about the 'EntityDef', but it is all kept present on the @@ -537,7 +537,7 @@ -- -- @since 2.13.0.0 } - deriving (Eq, Show, Lift) + deriving (Eq, Ord, Show, Lift) -- | Forget innformation about a 'FieldDef' so it can beused as an -- 'UnboundFieldDef'. @@ -615,7 +615,7 @@ -- have a 'DefaultKey'. -- -- @since 2.13.0.0 - deriving (Show, Lift) + deriving (Eq, Ord, Show, Lift) -- | Construct an entity definition. mkUnboundEntityDef @@ -964,7 +964,7 @@ , unboundIdCascade :: FieldCascade , unboundIdType :: Maybe FieldType } - deriving (Show, Lift) + deriving (Eq, Ord, Show, Lift) -- TODO: this is hacky (the double takeCols, the setFieldDef stuff, and setIdName. -- need to re-work takeCols function @@ -1009,7 +1009,7 @@ -- -- @since 2.13.0.0 } - deriving (Show, Lift) + deriving (Eq, Ord, Show, Lift) takeComposite :: [FieldNameHS] @@ -1130,7 +1130,7 @@ -- -- @since 2.13.0.0 } - deriving (Eq, Show, Lift) + deriving (Eq, Ord, Show, Lift) -- | A list of fields present on the foreign reference. data UnboundForeignFieldList @@ -1158,7 +1158,7 @@ -- @ -- -- @since 2.13.0.0 - deriving (Eq, Show, Lift) + deriving (Eq, Ord, Show, Lift) -- | A pairing of the 'FieldNameHS' for the source table to the 'FieldNameHS' -- for the target table. @@ -1175,7 +1175,7 @@ -- -- @since 2.13.0.0 } - deriving (Eq, Show, Lift) + deriving (Eq, Ord, Show, Lift) unbindForeignDef :: ForeignDef -> UnboundForeignDef unbindForeignDef fd = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/Database/Persist/TH.hs new/persistent-2.13.0.3/Database/Persist/TH.hs --- old/persistent-2.13.0.2/Database/Persist/TH.hs 2021-05-24 17:18:53.000000000 +0200 +++ new/persistent-2.13.0.3/Database/Persist/TH.hs 2021-06-19 00:03:31.000000000 +0200 @@ -237,8 +237,6 @@ (embedEntityMap, noCycleEnts) where noCycleEnts = entsWithEmbeds - -- every EntityDef could reference each-other (as an EmbedRef) - -- let Haskell tie the knot embedEntityMap = constructEmbedEntityMap entsWithEmbeds entsWithEmbeds = fmap setEmbedEntity (rawEnts <> map unbindEntityDef existingEnts) setEmbedEntity ubEnt = @@ -773,7 +771,13 @@ $ predefs entityMap = constructEntityMap allEnts - ents <- filterM shouldGenerateCode allEnts + preexistingSet = + Set.fromList $ map getEntityHaskellName preexistingEntities + newEnts = + filter + (\e -> getUnboundEntityNameHS e `Set.notMember` preexistingSet) + allEnts + ents <- filterM shouldGenerateCode newEnts requireExtensions [ [TypeFamilies], [GADTs, ExistentialQuantification] , [DerivingStrategies], [GeneralizedNewtypeDeriving], [StandaloneDeriving] @@ -1037,9 +1041,15 @@ cols :: [VarBangType] cols = do fieldDef <- getUnboundFieldDefs entDef - let recordName = fieldDefToRecordName mps entDef fieldDef - strictness = if unboundFieldStrict fieldDef then isStrict else notStrict - fieldIdType = maybeIdType mps entityMap fieldDef Nothing Nothing + let + recordName = + fieldDefToRecordName mps entDef fieldDef + strictness = + if unboundFieldStrict fieldDef + then isStrict + else notStrict + fieldIdType = + maybeIdType mps entityMap fieldDef Nothing Nothing pure (recordName, strictness, fieldIdType) constrs @@ -1097,6 +1107,45 @@ , "on the end of the line that defines your uniqueness " , "constraint in order to disable this check. ***" ] +-- | This function renders a Template Haskell 'Type' for an 'UnboundFieldDef'. +-- It takes care to respect the 'mpsGeneric' setting to render an Id faithfully, +-- and it also ensures that the generated Haskell type is 'Maybe' if the +-- database column has that attribute. +-- +-- For a database schema with @'mpsGeneric' = False@, this is simple - it uses +-- the @ModelNameId@ type directly. This resolves just fine. +-- +-- If 'mpsGeneric' is @True@, then we have to do something a bit more +-- complicated. We can't refer to a @ModelNameId@ directly, because that @Id@ +-- alias hides the backend type variable. Instead, we need to refer to: +-- +-- > Key (ModelNameGeneric backend) +-- +-- This means that the client code will need both the term @ModelNameId@ in +-- scope, as well as the @ModelNameGeneric@ constructor, despite the fact that +-- the @ModelNameId@ is the only term explicitly used (and imported). +-- +-- However, we're not guaranteed to have @ModelName@ in scope - we've only +-- referenced @ModelNameId@ in code, and so code generation *should* work even +-- without this. Consider an explicit-style import: +-- +-- @ +-- import Model.Foo (FooId) +-- +-- mkPersistWith sqlSettings $(discoverEntities) [persistLowerCase| +-- Bar +-- foo FooId +-- |] +-- @ +-- +-- This looks like it ought to work, but it would fail with @mpsGeneric@ being +-- enabled. One hacky work-around is to perform a @'lookupTypeName' :: String -> +-- Q (Maybe Name)@ on the @"ModelNameId"@ type string. If the @Id@ is +-- a reference in the 'EntityMap' and @lookupTypeName@ returns @'Just' name@, +-- then that 'Name' contains the fully qualified information needed to use the +-- 'Name' without importing it at the client-site. Then we can perform a bit of +-- surgery on the 'Name' to strip the @Id@ suffix, turn it into a 'Type', and +-- apply the 'Key' constructor. maybeIdType :: MkPersistSettings -> EntityMap @@ -1113,25 +1162,90 @@ True _ -> maybeNullable fieldDef - idType = fromMaybe (ftToType $ unboundFieldType fieldDef) $ do - typ <- extractForeignRef entityMap fieldDef - pure $ - ConT ''Key - `AppT` genericDataType mps typ (VarT $ fromMaybe backendName mbackend) + idType = + fromMaybe (ftToType $ unboundFieldType fieldDef) $ do + typ <- extractForeignRef entityMap fieldDef + guard ((mpsGeneric mps)) + pure $ + ConT ''Key + `AppT` genericDataType mps typ (VarT $ fromMaybe backendName mbackend) + + -- TODO: if we keep mpsGeneric, this needs to check 'mpsGeneric' and then + -- append Generic to the model name, probably + _removeIdFromTypeSuffix :: Name -> Type + _removeIdFromTypeSuffix oldName@(Name (OccName nm) nameFlavor) = + case stripSuffix "Id" (T.pack nm) of + Nothing -> + ConT oldName + Just name -> + ConT ''Key + `AppT` do + ConT $ Name (OccName (T.unpack name)) nameFlavor + + -- | TODO: if we keep mpsGeneric, let's incorporate this behavior here, so + -- end users don't need to import the constructor type as well as the id type + -- + -- Returns 'Nothing' if the given text does not appear to be a table reference. + -- In that case, do the usual thing for generating a type name. + -- + -- Returns a @Just typ@ if the text appears to be a model name, and if the + -- @ModelId@ type is in scope. The 'Type' is a fully qualified reference to + -- @'Key' ModelName@ such that end users won't have to import it directly. + _lookupReferencedTable :: EntityMap -> Text -> Q (Maybe Type) + _lookupReferencedTable em fieldTypeText = do + let + mmodelIdString = do + fieldTypeNoId <- stripSuffix "Id" fieldTypeText + _ <- M.lookup (EntityNameHS fieldTypeNoId) em + pure (T.unpack fieldTypeText) + case mmodelIdString of + Nothing -> + pure Nothing + Just modelIdString -> do + mIdName <- lookupTypeName modelIdString + pure $ fmap _removeIdFromTypeSuffix mIdName + + _fieldNameEndsWithId :: UnboundFieldDef -> Maybe String + _fieldNameEndsWithId ufd = go (unboundFieldType ufd) + where + go = \case + FTTypeCon mmodule name -> do + a <- stripSuffix "Id" name + pure $ + T.unpack $ mconcat + [ case mmodule of + Nothing -> + "" + Just m -> + mconcat [m, "."] + , a + , "Id" + ] + _ -> + Nothing backendDataType :: MkPersistSettings -> Type backendDataType mps | mpsGeneric mps = backendT | otherwise = mpsBackend mps +-- | TODO: +-- +-- if we keep mpsGeneric +-- then +-- let's make this fully qualify the generic name +-- else +-- let's delete it genericDataType :: MkPersistSettings -> EntityNameHS -> Type -- ^ backend -> Type genericDataType mps name backend - | mpsGeneric mps = ConT (mkEntityNameHSGenericName name) `AppT` backend - | otherwise = ConT $ mkEntityNameHSName name + | mpsGeneric mps = + ConT (mkEntityNameHSGenericName name) `AppT` backend + | otherwise = + ConT $ mkEntityNameHSName name degen :: [Clause] -> [Clause] degen [] = @@ -2429,8 +2543,10 @@ con = ForallC [] - [mkEqualP (VarT $ mkName "typ") $ maybeIdType mps entityMap fieldDef Nothing Nothing] + [mkEqualP (VarT $ mkName "typ") fieldT] $ NormalC name [] + fieldT = + maybeIdType mps entityMap fieldDef Nothing Nothing bod <- mkLookupEntityField et (unboundFieldNameHS fieldDef) let cla = normalClause [ConP name []] @@ -2679,7 +2795,6 @@ symbolToField = $(entityFieldConstr) |] - -- | 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: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/persistent.cabal new/persistent-2.13.0.3/persistent.cabal --- old/persistent-2.13.0.2/persistent.cabal 2021-05-24 17:18:53.000000000 +0200 +++ new/persistent-2.13.0.3/persistent.cabal 2021-06-19 00:03:31.000000000 +0200 @@ -1,5 +1,5 @@ name: persistent -version: 2.13.0.2 +version: 2.13.0.3 license: MIT license-file: LICENSE author: Michael Snoyman <[email protected]> @@ -164,6 +164,9 @@ Database.Persist.TH.DiscoverEntitiesSpec Database.Persist.TH.EmbedSpec Database.Persist.TH.ForeignRefSpec + Database.Persist.TH.PersistWith.Model + Database.Persist.TH.PersistWith.Model2 + Database.Persist.TH.PersistWithSpec Database.Persist.TH.ImplicitIdColSpec Database.Persist.TH.JsonEncodingSpec Database.Persist.TH.KindEntitiesSpec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWith/Model.hs new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWith/Model.hs --- old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWith/Model.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWith/Model.hs 2021-06-19 00:03:31.000000000 +0200 @@ -0,0 +1,26 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Database.Persist.TH.PersistWith.Model where + +import TemplateTestImports + +import Database.Persist.TH.PersistWith.Model2 + +mkPersistWith sqlSettings $(discoverEntities) [persistLowerCase| + +IceCream + flavor FlavorId + +|] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWith/Model2.hs new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWith/Model2.hs --- old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWith/Model2.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWith/Model2.hs 2021-06-19 00:03:31.000000000 +0200 @@ -0,0 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Database.Persist.TH.PersistWith.Model2 where + +import TemplateTestImports + +mkPersist sqlSettings [persistLowerCase| + +Flavor + name Text + +|] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWithSpec.hs new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWithSpec.hs --- old/persistent-2.13.0.2/test/Database/Persist/TH/PersistWithSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/persistent-2.13.0.3/test/Database/Persist/TH/PersistWithSpec.hs 2021-06-19 00:03:31.000000000 +0200 @@ -0,0 +1,39 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Database.Persist.TH.PersistWithSpec where + +import TemplateTestImports +import Database.Persist.TH.PersistWith.Model (IceCreamId) +import Data.List (find) +import Language.Haskell.TH as TH + +mkPersistWith sqlSettings $(discoverEntities) [persistLowerCase| + +BestTopping + iceCream IceCreamId + +|] + +spec :: Spec +spec = describe "mkPersistWith" $ do + it "works" $ do + let + edef = + entityDef (Proxy @BestTopping) + Just iceCreamField = + find ((FieldNameHS "iceCream" ==) . fieldHaskell) (getEntityFields edef) + fieldReference iceCreamField + `shouldBe` + ForeignRef (EntityNameHS "IceCream") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs new/persistent-2.13.0.3/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs --- old/persistent-2.13.0.2/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs 2021-05-05 23:10:13.000000000 +0200 +++ new/persistent-2.13.0.3/test/Database/Persist/TH/SharedPrimaryKeyImportedSpec.hs 2021-06-19 00:03:31.000000000 +0200 @@ -21,12 +21,14 @@ import Database.Persist.Sql import Database.Persist.Sql.Util import Database.Persist.TH +import Language.Haskell.TH +import Control.Monad.IO.Class import Database.Persist.TH.SharedPrimaryKeySpec (User, UserId) -share [ mkPersist sqlSettings ] [persistLowerCase| +mkPersistWith sqlSettings $(discoverEntities) [persistLowerCase| -Profile +ProfileX Id UserId email String @@ -42,7 +44,7 @@ it "should match underlying key" $ do sqlType (Proxy @UserId) `shouldBe` - sqlType (Proxy @ProfileId) + sqlType (Proxy @ProfileXId) describe "getEntityId FieldDef" $ do it "should match underlying primary key" $ do @@ -56,4 +58,15 @@ SqlOther "Composite Key" getSqlType (Proxy @User) `shouldBe` - getSqlType (Proxy @Profile) + getSqlType (Proxy @ProfileX) + + + describe "foreign reference should work" $ do + it "should have a foreign reference" $ do + pendingWith "issue #1289" + let + Just fd = + getEntityIdField (entityDef (Proxy @ProfileX)) + fieldReference fd + `shouldBe` + ForeignRef (EntityNameHS "User") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/persistent-2.13.0.2/test/Database/Persist/THSpec.hs new/persistent-2.13.0.3/test/Database/Persist/THSpec.hs --- old/persistent-2.13.0.2/test/Database/Persist/THSpec.hs 2021-05-05 23:10:13.000000000 +0200 +++ new/persistent-2.13.0.3/test/Database/Persist/THSpec.hs 2021-06-19 00:03:31.000000000 +0200 @@ -45,6 +45,8 @@ import Database.Persist.TH import TemplateTestImports + +import qualified Database.Persist.TH.PersistWithSpec as PersistWithSpec import qualified Database.Persist.TH.DiscoverEntitiesSpec as DiscoverEntitiesSpec import qualified Database.Persist.TH.EmbedSpec as EmbedSpec import qualified Database.Persist.TH.ForeignRefSpec as ForeignRefSpec @@ -171,6 +173,7 @@ spec :: Spec spec = describe "THSpec" $ do + PersistWithSpec.spec KindEntitiesSpec.spec OverloadedLabelSpec.spec SharedPrimaryKeySpec.spec
