persistent-template 2.8.0.1 → 2.8.1

raw patch · 4 files changed

+32/−14 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Database/Persist/TH.hs +24/−12
• persistent-template.cabal +1/−1
• test/main.hs +3/−1

@@ -1,5 +1,9 @@ ## Unreleased changes +## 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)

@@ -30,6 +30,7 @@     , mpsPrefixFields     , mpsEntityJSON     , mpsGenerateLenses+    , mpsDeriveInstances     , EntityJSON(..)     , mkPersistSettings     , sqlSettings@@ -445,6 +446,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 +474,7 @@         , entityFromJSON = 'entityIdFromJSON         }     , mpsGenerateLenses = False+    , mpsDeriveInstances = []     }  -- | Use the 'SqlPersist' backend.@@ -502,7 +510,9 @@  dataTypeDec :: MkPersistSettings -> EntityDef -> Q Dec dataTypeDec mps t = do-    let names = map (mkName . unpack) $ entityDerives t+    let entityInstances     = map (mkName . unpack) $ entityDerives t+        additionalInstances = filter (`notElem` entityInstances) $ mpsDeriveInstances mps+        names               = entityInstances <> additionalInstances     DataD [] nameFinal paramsFinal                 Nothing                 constrs@@ -791,14 +801,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 +883,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@@ -1011,7 +1023,7 @@     , tableName     , "`. "     , err-    ]        +    ]  mkEntity :: EntityMap -> MkPersistSettings -> EntityDef -> Q [Dec] mkEntity entityMap mps t = do@@ -1260,7 +1272,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 +1281,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:@@ -1840,19 +1852,19 @@    case 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 <> " #-}"

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

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -31,13 +32,14 @@ import Test.Hspec.QuickCheck import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen (Gen)+import GHC.Generics (Generic)  import Database.Persist 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