persistent-template 2.8.2.2 → 2.8.2.3

raw patch · 3 files changed

+55/−13 lines, 3 filesdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Database/Persist/TH.hs +49/−12
• persistent-template.cabal +1/−1

@@ -1,5 +1,10 @@ ## 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)

@@ -57,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), (.:), (.:?)@@ -88,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)@@ -399,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@@ -514,11 +517,30 @@     let entityInstances     = map (mkName . unpack) $ entityDerives t         additionalInstances = filter (`notElem` entityInstances) $ mpsDeriveInstances mps         names               = entityInstances <> additionalInstances-    DataD [] nameFinal paramsFinal++    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,@@ -1742,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|]@@ -1849,13 +1872,33 @@ -- -- 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                      [ "Generating Persistent entities now requires the "@@ -1871,10 +1914,4 @@                     ]    where-    requiredExtensions =-        [ DerivingStrategies-        , GeneralizedNewtypeDeriving-        , StandaloneDeriving-        , UndecidableInstances-        ]     extensionToPragma ext = "{-# LANGUAGE " <> show ext <> " #-}"

@@ -1,5 +1,5 @@ name:            persistent-template-version:         2.8.2.2+version:         2.8.2.3 license:         MIT license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>