packages feed

persistent 2.13.0.1 → 2.13.0.2

raw patch · 20 files changed

+181/−79 lines, 20 filesdep −deepseq-genericsdep ~deepseqdep ~template-haskell

Dependencies removed: deepseq-generics

Dependency ranges changed: deepseq, template-haskell

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ # Changelog for persistent +## 2.13.0.2++* [#1265](https://github.com/yesodweb/persistent/pull/1265)+    * Support GHC 9+ ## 2.13.0.1  * [#1268](https://github.com/yesodweb/persistent/pull/1268)
Database/Persist/Class/PersistConfig.hs view
@@ -6,12 +6,13 @@ import Data.Aeson (Value (Object)) import Data.Aeson.Types (Parser) import qualified Data.HashMap.Strict as HashMap+import Data.Kind (Type)  -- | Represents a value containing all the configuration options for a specific -- backend. This abstraction makes it easier to write code that can easily swap -- backends. class PersistConfig c where-    type PersistConfigBackend c :: (* -> *) -> * -> *+    type PersistConfigBackend c :: (Type -> Type) -> Type -> Type     type PersistConfigPool c      -- | Load the config settings from a 'Value', most likely taken from a YAML
Database/Persist/Class/PersistEntity.hs view
@@ -49,7 +49,6 @@ import qualified Data.HashMap.Strict as HM import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe (isJust)-import Data.Monoid (mappend) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE@@ -58,6 +57,7 @@ import GHC.Generics import GHC.OverloadedLabels import GHC.TypeLits+import Data.Kind (Type)  import Database.Persist.Class.PersistField import Database.Persist.Names@@ -102,7 +102,7 @@     -- As of @persistent-2.11.0.0@, it's possible to use the @OverloadedLabels@     -- language extension to refer to 'EntityField' values polymorphically. See     -- the documentation on 'SymbolToField' for more information.-    data EntityField record :: * -> *+    data EntityField record :: Type -> Type     -- | Return meta-data for a given 'EntityField'.     persistFieldDef :: EntityField record typ -> FieldDef     -- | A meta-operation to get the database fields of a record.@@ -317,7 +317,7 @@         _ -> error $ T.unpack $ errMsg "expected PersistMap"      fromPersistValue (PersistMap alist) = case after of-        [] -> Left $ errMsg $ "did not find " `Data.Monoid.mappend` idField `mappend` " field"+        [] -> Left $ errMsg $ "did not find " `mappend` idField `mappend` " field"         ("_id", kv):afterRest ->             fromPersistValue (PersistMap (before ++ afterRest)) >>= \record ->                 keyFromValues [kv] >>= \k ->
Database/Persist/Class/PersistField.hs view
@@ -20,7 +20,6 @@ import Data.Int (Int8, Int16, Int32, Int64) import qualified Data.IntMap as IM import qualified Data.Map as M-import Data.Monoid ((<>)) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T
Database/Persist/Quasi/Internal.hs view
@@ -924,7 +924,7 @@           | n == "Foreign" =               (Nothing, Nothing, Nothing, Just $ takeForeign ps entityName rest)           | n == "Primary" =-              (Nothing, Just $ takeComposite ps defNames rest, Nothing, Nothing)+              (Nothing, Just $ takeComposite defNames rest, Nothing, Nothing)           | n == "Id"      =               (Just $ takeId ps entityName rest, Nothing, Nothing, Nothing)           | otherwise      =@@ -1012,11 +1012,10 @@     deriving (Show, Lift)  takeComposite-    :: PersistSettings-    -> [FieldNameHS]+    :: [FieldNameHS]     -> [Text]     -> UnboundCompositeDef-takeComposite ps fields pkcols =+takeComposite fields pkcols =     UnboundCompositeDef         { unboundCompositeCols =             map (getDef fields) cols
Database/Persist/Sql/Class.hs view
@@ -22,7 +22,6 @@ import qualified Data.IntMap as IM import qualified Data.Map as M import Data.Maybe (fromMaybe)-import Data.Monoid ((<>)) import Data.Proxy (Proxy(..)) import qualified Data.Set as S import Data.Text (Text, intercalate, pack)
Database/Persist/Sql/Orphan/PersistQuery.hs view
@@ -23,7 +23,7 @@ import Data.Int (Int64) import Data.List (find, inits, transpose) import Data.Maybe (isJust)-import Data.Monoid (Monoid(..), (<>))+import Data.Monoid (Monoid(..)) import Data.Text (Text) import qualified Data.Text as T import Data.Foldable (toList)
Database/Persist/Sql/Orphan/PersistStore.hs view
@@ -30,7 +30,6 @@ import Data.List (find, nubBy) import qualified Data.Map as Map import Data.Maybe (isJust)-import Data.Monoid (mappend, (<>)) import Data.Text (Text, unpack) import qualified Data.Text as T import Data.Void (Void)
Database/Persist/Sql/Orphan/PersistUnique.hs view
@@ -10,7 +10,6 @@ import qualified Data.Conduit.List as CL import Data.Function (on) import Data.List (nubBy)-import Data.Monoid (mappend) import qualified Data.Text as T import Data.Foldable (toList)
Database/Persist/Sql/Run.hs view
@@ -10,7 +10,6 @@ import Control.Monad.Trans.Resource import Data.Acquire (Acquire, ReleaseType(..), mkAcquireType, with) import Data.IORef (readIORef)-import Data.Pool (Pool) import Data.Pool as P import qualified Data.Map as Map import qualified Data.Text as T
Database/Persist/Sql/Types.hs view
@@ -8,8 +8,6 @@     , ConnectionPoolConfig(..)     ) where -import Database.Persist.Types.Base (FieldCascade)- import Control.Exception (Exception(..)) import Control.Monad.Logger (NoLoggingT) import Control.Monad.Trans.Reader (ReaderT(..))
Database/Persist/Sql/Types/Internal.hs view
@@ -29,7 +29,6 @@  import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask)-import Data.Monoid ((<>))  import Database.Persist.Class     ( HasPersistBackend (..)
Database/Persist/Sql/Util.hs view
@@ -22,7 +22,6 @@  import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Maybe as Maybe-import Data.Monoid ((<>)) import Data.Text (Text, pack) import qualified Data.Text as T
Database/Persist/SqlBackend/Internal/IsolationLevel.hs view
@@ -1,7 +1,6 @@ module Database.Persist.SqlBackend.Internal.IsolationLevel where  import Data.String (IsString(..))-import Data.Monoid ((<>)) -- TODO: remove when GHC-8.2 support is dropped  -- | Please refer to the documentation for the database in question for a full -- overview of the semantics of the varying isloation levels
Database/Persist/TH.hs view
@@ -97,7 +97,6 @@ import qualified Data.List.NonEmpty as NEL import qualified Data.Map as M import Data.Maybe (fromMaybe, isJust, listToMaybe, mapMaybe)-import Data.Monoid (mappend, mconcat, (<>)) import Data.Proxy (Proxy(Proxy)) import Data.Text (Text, concat, cons, pack, stripSuffix, uncons, unpack) import qualified Data.Text as T@@ -124,7 +123,7 @@ import Database.Persist.Sql        (Migration, PersistFieldSql, SqlBackend, migrate, sqlType) -import Database.Persist.EntityDef.Internal (EntityDef(..), EntityIdDef(..))+import Database.Persist.EntityDef.Internal (EntityDef(..)) import Database.Persist.ImplicitIdDef (autoIncrementingInteger) import Database.Persist.ImplicitIdDef.Internal @@ -714,7 +713,7 @@     Left Nothing mEmbedded ents (FTTypeCon Nothing (EntityNameHS -> name)) =     maybe (Left Nothing) (\_ -> Right name) $ M.lookup name ents-mEmbedded ents (FTTypePromoted (EntityNameHS -> name)) =+mEmbedded _ (FTTypePromoted _) =     Left Nothing mEmbedded ents (FTList x) =     mEmbedded ents x@@ -1026,9 +1025,15 @@         )      (nameFinal, paramsFinal)-        | mpsGeneric mps = (mkEntityDefGenericName entDef, [PlainTV backendName])-        | otherwise = (mkEntityDefName entDef, [])+        | mpsGeneric mps =+            ( mkEntityDefGenericName entDef+            , [ mkPlainTV backendName+              ]+            ) +        | otherwise =+            (mkEntityDefName entDef, [])+     cols :: [VarBangType]     cols = do         fieldDef <- getUnboundFieldDefs entDef@@ -1913,8 +1918,8 @@         sT = mkST backend1         tT = mkST backend2         t1 `arrow` t2 = ArrowT `AppT` t1 `AppT` t2-        vars = PlainTV fT-             : (if mpsGeneric mps then [PlainTV backend1{-, PlainTV backend2-}] else [])+        vars = mkForallTV fT+             : (if mpsGeneric mps then [mkForallTV backend1{-, PlainTV backend2-}] else [])     return         [ SigD lensName $ ForallT vars [mkClassP ''Functor [VarT fT]] $             (aT `arrow` (VarT fT `AppT` bT)) `arrow`@@ -1933,6 +1938,33 @@             ]         ] +#if MIN_VERSION_template_haskell(2,17,0)+mkPlainTV+    :: Name+    -> TyVarBndr ()+mkPlainTV n = PlainTV n ()++mkDoE :: [Stmt] -> Exp+mkDoE stmts = DoE Nothing stmts++mkForallTV :: Name -> TyVarBndr Specificity+mkForallTV n = PlainTV n SpecifiedSpec+#else++mkDoE :: [Stmt] -> Exp+mkDoE = DoE++mkPlainTV+    :: Name+    -> TyVarBndr+mkPlainTV = PlainTV++mkForallTV+    :: Name+    -> TyVarBndr+mkForallTV = mkPlainTV+#endif+ mkForeignKeysComposite     :: MkPersistSettings     -> UnboundEntityDef@@ -2168,7 +2200,7 @@             ]             (ConT ''DeleteCascade `AppT` entityT `AppT` backendT)             [ FunD 'deleteCascade-                [normalClause [VarP key] (DoE stmts)]+                [normalClause [VarP key] (mkDoE stmts)]             ]  -- | Creates a declaration for the @['EntityDef']@ from the @persistent@
bench/Main.hs view
@@ -1,12 +1,14 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+ {-# OPTIONS_GHC -Wno-orphans #-}+ module Main (main) where  import Control.DeepSeq-import Control.DeepSeq.Generics import Criterion.Main-import Data.Text                  (Text)+import Data.Text (Text) import Language.Haskell.TH import Language.Haskell.TH.Syntax @@ -17,7 +19,7 @@ main :: IO () main = defaultMain     [ bgroup "mkPersist"-        [ bench "From File" $ nfIO $ mkPersist' $(persistFileWith lowerCaseSettings "bench/models-slowly")+        [ -- bench "From File" $ nfIO $ mkPersist' $(persistFileWith lowerCaseSettings "bench/models-slowly")         -- , bgroup "Non-Null Fields"         --    [ bgroup "Increasing model count"         --        [ bench "1x10" $ nfIO $ mkPersist' $( parseReferencesQ (mkModels 10 10))@@ -55,137 +57,146 @@  -- Orphan instances for NFData Template Haskell types instance NFData Overlap where-    rnf = genericRnf + instance NFData AnnTarget where-    rnf = genericRnf+ instance NFData RuleBndr where-    rnf = genericRnf + instance NFData Role where-    rnf = genericRnf + instance NFData Phases where-    rnf = genericRnf + instance NFData InjectivityAnn where-    rnf = genericRnf + instance NFData FamilyResultSig where-    rnf = genericRnf + instance NFData RuleMatch where-    rnf = genericRnf + instance NFData TypeFamilyHead where-    rnf = genericRnf + instance NFData TySynEqn where-    rnf = genericRnf + instance NFData Inline where-    rnf = genericRnf + instance NFData Pragma where-    rnf = genericRnf + instance NFData FixityDirection where-    rnf = genericRnf + instance NFData Safety where-    rnf = genericRnf + instance NFData Fixity where-    rnf = genericRnf + instance NFData Callconv where-    rnf = genericRnf + instance NFData Foreign where-    rnf = genericRnf + instance NFData SourceStrictness where-    rnf = genericRnf + instance NFData SourceUnpackedness where-    rnf = genericRnf + instance NFData FunDep where-    rnf = genericRnf + instance NFData Bang where-    rnf = genericRnf + #if MIN_VERSION_template_haskell(2,12,0) instance NFData PatSynDir where-    rnf = genericRnf + instance NFData PatSynArgs where-    rnf = genericRnf + instance NFData DerivStrategy where-    rnf = genericRnf + instance NFData DerivClause where-    rnf = genericRnf+ #endif  instance NFData Con where-    rnf = genericRnf + instance NFData Range where-    rnf = genericRnf + instance NFData Clause where-    rnf = genericRnf + instance NFData PkgName where-    rnf = genericRnf + instance NFData Dec where-    rnf = genericRnf + instance NFData Stmt where-    rnf = genericRnf + instance NFData TyLit where-    rnf = genericRnf + instance NFData NameSpace where-    rnf = genericRnf + instance NFData Body where-    rnf = genericRnf + instance NFData Guard where-    rnf = genericRnf + instance NFData Match where-    rnf = genericRnf + instance NFData ModName where-    rnf = genericRnf + instance NFData Pat where-    rnf = genericRnf +#if MIN_VERSION_template_haskell(2,16,0)+instance NFData Bytes where+    rnf !_ = ()+#endif++#if MIN_VERSION_template_haskell(2,17,0)+instance NFData a => NFData (TyVarBndr a) where++instance NFData Specificity+#else instance NFData TyVarBndr where-    rnf = genericRnf +#endif+ instance NFData NameFlavour where-    rnf = genericRnf + instance NFData Type where-    rnf = genericRnf + instance NFData Exp where-    rnf = genericRnf + instance NFData Lit where-    rnf = genericRnf  instance NFData OccName where-    rnf = genericRnf + instance NFData Name where-    rnf = genericRnf+
bench/Models.hs view
@@ -5,10 +5,13 @@ import qualified Data.Text as Text  import Database.Persist.Quasi+import Database.Persist.Quasi.Internal import Database.Persist.TH import Database.Persist.Sql -mkPersist' :: [EntityDef] -> IO [Dec]+-- TODO: we use lookupName and reify etc which breaks in IO. somehow need to+-- test this out elsewise+mkPersist' :: [UnboundEntityDef] -> IO [Dec] mkPersist' = runQ . mkPersist sqlSettings  parseReferences' :: String -> IO Exp
persistent.cabal view
@@ -1,5 +1,5 @@ name:            persistent-version:         2.13.0.1+version:         2.13.0.2 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -166,6 +166,8 @@         Database.Persist.TH.ForeignRefSpec         Database.Persist.TH.ImplicitIdColSpec         Database.Persist.TH.JsonEncodingSpec+        Database.Persist.TH.KindEntitiesSpec+        Database.Persist.TH.KindEntitiesSpecImports         Database.Persist.TH.MigrationOnlySpec         Database.Persist.TH.MultiBlockSpec         Database.Persist.TH.MultiBlockSpec.Model@@ -189,8 +191,7 @@     build-depends:    base                     , persistent                     , criterion-                    , deepseq-                    , deepseq-generics+                    , deepseq >= 1.4                     , file-embed                     , text                     , template-haskell
+ test/Database/Persist/TH/KindEntitiesSpec.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Persist.TH.KindEntitiesSpec where++import Database.Persist.TH.KindEntitiesSpecImports+import TemplateTestImports++mkPersist sqlSettings [persistLowerCase|++Customer+    name    String+    age     Int++CustomerTransfer+    customerId CustomerId+    moneyAmount (MoneyAmount 'CustomerOwned 'Debit)+|]++spec :: Spec+spec = describe "KindEntities" $ do+    it "should support DataKinds in entity definition" $ do+        let mkTransfer :: CustomerId -> MoneyAmount 'CustomerOwned 'Debit -> CustomerTransfer+            mkTransfer = CustomerTransfer+            getAmount :: CustomerTransfer -> MoneyAmount 'CustomerOwned 'Debit+            getAmount = customerTransferMoneyAmount+        compiles++compiles :: Expectation+compiles = True `shouldBe` True
+ test/Database/Persist/TH/KindEntitiesSpecImports.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}++module Database.Persist.TH.KindEntitiesSpecImports where++import Data.Proxy+import qualified Data.Text as T+import TemplateTestImports++data Owner = MerchantOwned | CustomerOwned+data AccountKind = Debit | Credit++newtype MoneyAmount (a :: Owner) (b :: AccountKind) = MoneyAmount Rational++instance PersistFieldSql (MoneyAmount a b) where+    sqlType _ = sqlType (Proxy :: Proxy Rational)++instance PersistField (MoneyAmount a b) where+    toPersistValue (MoneyAmount n) =+        toPersistValue n+    fromPersistValue v =+        MoneyAmount <$> fromPersistValue v