diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,176 @@ +## Unreleased changes + +## 2.12.0.0 + +* Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174) +* [#1214](https://github.com/yesodweb/persistent/pull/1214): + * This package was asborbed into `persistent` itself. + +## 2.9.1.0 + +* [#1145](https://github.com/yesodweb/persistent/pull/1148) + * Fix a bug where the `SqlType` for a shared primary key was being + incorrectly set to `SqlString` instead of whatever the target primary key + sql type was. +* [#1151](https://github.com/yesodweb/persistent/pull/1151) + * Automatically generate `SymbolToField` instances for datatypes, allowing + `OverloadedLabels` to be used with the `EntityField` type. + +## 2.9 + +* Always use the "stock" strategy when deriving Show/Read for keys [#1106](https://github.com/yesodweb/persistent/pull/1106) + * This fixes a regression from 2.8.0, which started using the `newtype` strategy when deriving `Show`/`Read` for keys + * In practice, this means that from 2.8.0–2.8.3.1, for the following schema: + + ``` + Person + name Text + CustomPrimary + anInt Int + Primary anInt + name Text + ``` + + `PersonKey 1` would show as `"SqlBackendKey {unSqlBackendKey = 1}"` + and `CustomPrimaryKey 1` would show as `"1"` + + This was generally poor for debugging and logging, since all tables keys would print the same. For Persistent < 2.8.0 and > 2.8.3.1, they instead will show as: + + `"PersonKey {unPersonKey = SqlBackendKey {unSqlBackendKey = 1}}"` + and `"CustomPrimaryKey {unCustomPrimaryKey = 1}"` + + This could be a breaking change if you have used `Show` on a key, wrote that string into some persistent storage like a database, and are trying to `Read` it back again later. + +## 2.8.3.1 + +* Allow aeson 1.5. [#1085](https://github.com/yesodweb/persistent/pull/1085) + +## 2.8.3.0 + +* Add `Lift` instances for the cascade types. [#1060](https://github.com/yesodweb/persistent/pull/1060) +* Use `DeriveLift` to implement all `Lift` instances. Among other benefits, + this provides implementations of `liftTyped` on `template-haskell-2.16` (GHC + 8.10) or later. [#1064](https://github.com/yesodweb/persistent/pull/1064) + +## 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) + +## 2.8.2.1 + +* Fix the test-suite for persistent-template. [#1023](https://github.com/yesodweb/persistent/pull/1023) + +## 2.8.2 + +* Add `fieldError` to the export list of `Database.Persist.TH` [#1008](https://github.com/yesodweb/persistent/pull/1008) + +## 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) + +## 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) +* Support template-haskell-2.15 [#959](https://github.com/yesodweb/persistent/pull/959) + +## 2.7.2 + +* Expose the knot tying logic of `parseReferences` so that users can build + migrations from independently define entities at runtime [#932](https://github.com/yesodweb/persistent/pull/932) + +## 2.7.1 + +* Add the `mkEntityDefList` function to work around [#902](https://github.com/yesodweb/persistent/issues/902). [#904](https://github.com/yesodweb/persistent/pull/904) + +## 2.7.0 + +* Depends on `persistent-2.10.0` which provides the `OnlyOneUniqueKey` and `AtLeastOneUniqueKey` classes. Automatically generates instances for these classes based on how many unique keys the entity definition gets. This changes requires `UndecidableInstances` to be enabled on each module that generates entity definitions. [#885](https://github.com/yesodweb/persistent/pull/885) +* Removed deprecated `sqlOnlySettings`. Please use `sqlSettings` instead. [#894](https://github.com/yesodweb/persistent/pull/894) + +## 2.6.0 +* [persistent#846](https://github.com/yesodweb/persistent/pull/846): Improve error message when marshalling fails +* [persistent#826](https://github.com/yesodweb/persistent/pull/826): Change `Unique` derive `Show` + +## 2.5.4 + +* [persistent#778](https://github.com/yesodweb/persistent/issues/778): Add `persistManyFileWith`. + +## 2.5.3.1 + +* Slight improvement to the error message when a Persistent field can't be parsed from database results + +## 2.5.3 + +* Exposed `parseReferences` to allow custom QuasiQuoters + +## 2.5.2 + +* Fix incorrect `ToJSON`/`FromJSON` instance generation for generic + backends + +## 2.5.1.6 + +Allow non-null self-references in a list + +## 2.5.1.4 + +* Allow composite Primary keys for tables that contain nullable fields. +* Support foreign keys to non-integer ids + +## 2.5.1.3 + +* fix GHC 7.8 bug when a field name is "type" + +## 2.5.1.2 + +* fix a bad Eq instance /= definition for Key when mpsGenetric=True + +## 2.5.0.1 + +* workaround TH bug in GHC 7.10 + +## 2.5 + +* read/write typeclass split + +## 2.1.6 + +* aeson 0.11 +* transformers 0.5 +## 2.1.4 + +support http-api-data for url serialization + +## 2.1.3.3 + +By default explicitly use Int64 for foreign key references. +This avoids confusion on a 32 bit system. + +## 2.1.3.1 + +Support foreign key references to composite primary keys + +## 2.1.0.1 + +Support for monad-control 1.0 diff --git a/Database/Persist/TH.hs b/Database/Persist/TH.hs deleted file mode 100644 --- a/Database/Persist/TH.hs +++ /dev/null @@ -1,511 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-fields #-} --- | This module provides utilities for creating backends. Regular users do not --- need to use this module. -module Database.Persist.TH - ( mkPersist - , share - , persist - , persistFile - , share2 - , mkSave - , mkDeleteCascade - , derivePersistField - , mkMigrate - , MkPersistSettings (..) - , sqlSettings - ) where - -import Database.Persist.Base -import Database.Persist.GenericSql (Migration, SqlPersist, migrate) -import Database.Persist.GenericSql.Internal (unRawName,rawFieldName,rawTableIdName) -- XXX -import Database.Persist.Quasi (parse) -import Database.Persist.Util (nullable) -import Database.Persist.TH.Library (apE) -import Language.Haskell.TH.Quote -import Language.Haskell.TH.Syntax -import Data.Char (toLower, toUpper) -import Control.Monad (forM) -#if MIN_VERSION_monad_control(0, 3, 0) -import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.IO.Class (MonadIO) -#else -import Control.Monad.IO.Control (MonadControlIO) -#endif -import qualified System.IO as SIO -import Data.Text (pack) -import Data.List (isSuffixOf) - --- | Converts a quasi-quoted syntax into a list of entity definitions, to be --- used as input to the template haskell generation code (mkPersist). -persist :: QuasiQuoter -persist = QuasiQuoter - { quoteExp = lift . parse - } - -persistFile :: FilePath -> Q Exp -persistFile fp = do - h <- qRunIO $ SIO.openFile fp SIO.ReadMode - qRunIO $ SIO.hSetEncoding h SIO.utf8_bom - s <- qRunIO $ SIO.hGetContents h - lift $ parse s - --- | Create data types and appropriate 'PersistEntity' instances for the given --- 'EntityDef's. Works well with the persist quasi-quoter. -mkPersist :: MkPersistSettings -> [EntityDef] -> Q [Dec] -mkPersist mps = fmap concat . mapM (mkEntity mps) - -data MkPersistSettings = MkPersistSettings - { mpsBackend :: Type - } - -sqlSettings :: MkPersistSettings -sqlSettings = MkPersistSettings - { mpsBackend = ConT ''SqlPersist - } - -recName :: String -> String -> String -recName dt f = lowerFirst dt ++ upperFirst f - -lowerFirst :: String -> String -lowerFirst (x:xs) = toLower x : xs -lowerFirst [] = [] - -upperFirst :: String -> String -upperFirst (x:xs) = toUpper x : xs -upperFirst [] = [] - -dataTypeDec :: EntityDef -> Dec -dataTypeDec t = - DataD [] nameG [PlainTV backend] [RecC name cols] $ map mkName $ entityDerives t - where - mkCol x (ColumnDef n ty as) = - (mkName $ recName x n, NotStrict, pairToType backend (ty, nullable as)) - nameG = mkName $ entityName t ++ suffix - name = mkName $ entityName t - cols = map (mkCol $ entityName t) $ entityColumns t - backend = mkName "backend" - -readMay :: Read a => String -> Maybe a -readMay s = - case reads s of - (x, _):_ -> Just x - [] -> Nothing - -entityUpdates :: EntityDef -> [(String, String, Bool, PersistUpdate)] -entityUpdates = - concatMap go . entityColumns - where - go (ColumnDef x y as) = map (\a -> (x, y, nullable as, a)) [minBound..maxBound] - -uniqueTypeDec :: EntityDef -> Dec -uniqueTypeDec t = - DataInstD [] ''Unique [ConT (mkName (entityName t ++ suffix)) `AppT` VarT backend, VarT backend2] - (map (mkUnique backend t) $ entityUniques t) - (if null (entityUniques t) then [] else [''Show, ''Read, ''Eq]) - where - backend = mkName "backend" - backend2 = mkName "backend2" - -mkUnique :: Name -> EntityDef -> UniqueDef -> Con -mkUnique backend t (UniqueDef constr fields) = - NormalC (mkName constr) types - where - types = map (go . flip lookup3 (entityColumns t)) fields - go (_, True) = error "Error: cannot have nullables in unique" - go x = (NotStrict, pairToType backend x) - lookup3 s [] = - error $ "Column not found: " ++ s ++ " in unique " ++ constr - lookup3 x ((ColumnDef x' y z):rest) - | x == x' = (y, nullable z) - | otherwise = lookup3 x rest - -pairToType :: Name -- ^ backend - -> (String, Bool) -> Type -pairToType backend (s, False) = idType backend s -pairToType backend (s, True) = ConT (mkName "Maybe") `AppT` idType backend s - -idType :: Name -> String -> Type -idType backend typ - | "Id" `isSuffixOf` typ = ConT ''Key `AppT` VarT backend `AppT` ConT (mkName $ take (length typ - 2) typ) - | otherwise = ConT $ mkName typ - -degen :: [Clause] -> [Clause] -degen [] = - let err = VarE (mkName "error") `AppE` LitE (StringL - "Degenerate case, should never happen") - in [Clause [WildP] (NormalB err) []] -degen x = x - -mkToPersistFields :: [(String, Int)] -> Q Dec -mkToPersistFields pairs = do - clauses <- mapM go pairs - return $ FunD (mkName "toPersistFields") $ degen clauses - where - go :: (String, Int) -> Q Clause - go (constr, fields) = do - xs <- sequence $ replicate fields $ newName "x" - let pat = ConP (mkName constr) $ map VarP xs - sp <- [|SomePersistField|] - let bod = ListE $ map (AppE sp . VarE) xs - return $ Clause [pat] (NormalB bod) [] - -mkToFieldNames :: [UniqueDef] -> Dec -mkToFieldNames pairs = - FunD (mkName "persistUniqueToFieldNames") $ degen $ map go pairs - where - go (UniqueDef constr names) = - Clause [RecP (mkName constr) []] - (NormalB $ ListE $ map (LitE . StringL) names) - [] - -mkToUpdate :: String -> [(String, PersistUpdate)] -> Q Dec -mkToUpdate name pairs = do - pairs' <- mapM go pairs - return $ FunD (mkName name) $ degen pairs' - where - go (constr, pu) = do - pu' <- lift pu - return $ Clause [RecP (mkName constr) []] (NormalB pu') [] - -mkUniqueToValues :: [UniqueDef] -> Q Dec -mkUniqueToValues pairs = do - pairs' <- mapM go pairs - return $ FunD (mkName "persistUniqueToValues") $ degen pairs' - where - go :: UniqueDef -> Q Clause - go (UniqueDef constr names) = do - xs <- mapM (const $ newName "x") names - let pat = ConP (mkName constr) $ map VarP xs - tpv <- [|toPersistValue|] - let bod = ListE $ map (AppE tpv . VarE) xs - return $ Clause [pat] (NormalB bod) [] - -mkToFieldName :: String -> [(String, String)] -> Dec -mkToFieldName func pairs = - FunD (mkName func) $ degen $ map go pairs - where - go (constr, name) = - Clause [RecP (mkName constr) []] (NormalB $ LitE $ StringL name) [] - -mkToOrder :: [(String, Exp)] -> Dec -mkToOrder pairs = - FunD (mkName "persistOrderToOrder") $ degen $ map go pairs - where - go (constr, val) = - Clause [RecP (mkName constr) []] (NormalB val) [] - -mkToValue :: String -> [String] -> Dec -mkToValue func = FunD (mkName func) . degen . map go - where - go constr = - let x = mkName "x" - in Clause [ConP (mkName constr) [VarP x]] - (NormalB $ VarE (mkName "toPersistValue") `AppE` VarE x) - [] - -mkHalfDefined :: String -> Int -> Dec -mkHalfDefined constr count' = - FunD (mkName "halfDefined") - [Clause [] (NormalB - $ foldl AppE (ConE $ mkName constr) - (replicate count' $ VarE $ mkName "undefined")) []] - -mkFromPersistValues :: EntityDef -> Q [Clause] -mkFromPersistValues t = do - nothing <- [|Left "Invalid fromPersistValues input"|] - let cons = ConE $ mkName $ entityName t - xs <- mapM (const $ newName "x") $ entityColumns t - fs <- [|fromPersistValue|] - let xs' = map (AppE fs . VarE) xs - let pat = ListP $ map VarP xs - ap' <- [|apE|] - just <- [|Right|] - let cons' = just `AppE` cons - return - [ Clause [pat] (NormalB $ foldl (go ap') cons' xs') [] - , Clause [WildP] (NormalB nothing) [] - ] - where - go ap' x y = InfixE (Just x) ap' (Just y) - -mkEntity :: MkPersistSettings -> EntityDef -> Q [Dec] -mkEntity mps t = do - t' <- lift t - let name = entityName t - let clazz = ConT ''PersistEntity `AppT` (ConT (mkName $ entityName t ++ suffix) `AppT` VarT (mkName "backend")) - tpf <- mkToPersistFields [(name, length $ entityColumns t)] - fpv <- mkFromPersistValues t - utv <- mkUniqueToValues $ entityUniques t - puk <- mkUniqueKeys t - let colnames = map (unRawName . rawFieldName) $ entityColumns t - idname = unRawName $ rawTableIdName t - idname_ = (if idname `elem` colnames then (++"_") else id) idname - fields <- mapM (mkField t) $ ColumnDef idname_ (entityName t ++ "Id") [] : entityColumns t - return $ - [ dataTypeDec t - , TySynD (mkName $ entityName t) [] $ - ConT (mkName $ entityName t ++ suffix) `AppT` mpsBackend mps - , TySynD (mkName $ entityName t ++ "Id") [] $ - ConT ''Key `AppT` mpsBackend mps `AppT` ConT (mkName $ entityName t) - , InstanceD [] clazz $ - [ uniqueTypeDec t - , FunD (mkName "entityDef") [Clause [WildP] (NormalB t') []] - , tpf - , FunD (mkName "fromPersistValues") fpv - , mkHalfDefined name $ length $ entityColumns t - , mkToFieldNames $ entityUniques t - , utv - , puk - , DataInstD - [] - ''EntityField - [ ConT (mkName $ entityName t ++ suffix) `AppT` VarT (mkName "backend") - , VarT $ mkName "typ" - ] - (map fst fields) - [] - , FunD (mkName "persistColumnDef") (map snd fields) - ] - ] - -updateConName :: String -> String -> PersistUpdate -> String -updateConName name s pu = concat - [ name - , upperFirst s - , case pu of - Assign -> "" - _ -> show pu - ] - -share :: [[EntityDef] -> Q [Dec]] -> [EntityDef] -> Q [Dec] -share fs x = fmap concat $ mapM ($ x) fs - -share2 :: ([EntityDef] -> Q [Dec]) - -> ([EntityDef] -> Q [Dec]) - -> [EntityDef] - -> Q [Dec] -share2 f g x = do - y <- f x - z <- g x - return $ y ++ z - -mkSave :: String -> [EntityDef] -> Q [Dec] -mkSave name' defs' = do - let name = mkName name' - defs <- lift defs' - return [ SigD name $ ListT `AppT` ConT ''EntityDef - , FunD name [Clause [] (NormalB defs) []] - ] - -data Dep = Dep - { depTarget :: String - , depSourceTable :: String - , depSourceField :: String - , depSourceNull :: Bool - } - -mkDeleteCascade :: [EntityDef] -> Q [Dec] -mkDeleteCascade defs = do - let deps = concatMap getDeps defs - mapM (go deps) defs - where - getDeps :: EntityDef -> [Dep] - getDeps def = - concatMap getDeps' $ entityColumns def - where - getDeps' (ColumnDef name typ attribs) = - let isNull = nullable attribs - l = length typ - (f, b) = splitAt (l - 2) typ - in if b == "Id" - then return Dep - { depTarget = f - , depSourceTable = entityName def - , depSourceField = name - , depSourceNull = isNull - } - else [] - go :: [Dep] -> EntityDef -> Q Dec - go allDeps EntityDef{entityName = name} = do - let deps = filter (\x -> depTarget x == name) allDeps - key <- newName "key" - del <- [|delete|] - dcw <- [|deleteCascadeWhere|] - just <- [|Just|] - filt <- [|Filter|] - eq <- [|Eq|] - left <- [|Left|] - let mkStmt dep = NoBindS - $ dcw `AppE` - ListE - [ filt `AppE` ConE (mkName filtName) - `AppE` (left `AppE` val (depSourceNull dep)) - `AppE` eq - ] - where - filtName = depSourceTable dep ++ upperFirst (depSourceField dep) - val False = VarE key - val True = just `AppE` VarE key - - - - let stmts = map mkStmt deps ++ [NoBindS $ del `AppE` VarE key] - return $ - InstanceD - [] - (ConT ''DeleteCascade `AppT` - (ConT (mkName $ name ++ suffix) `AppT` VarT (mkName "backend")) - `AppT` VarT (mkName "backend") - ) - [ FunD (mkName "deleteCascade") - [Clause [VarP key] (NormalB $ DoE stmts) []] - ] - -mkUniqueKeys :: EntityDef -> Q Dec -mkUniqueKeys def = do - c <- clause - return $ FunD (mkName "persistUniqueKeys") [c] - where - clause = do - xs <- forM (entityColumns def) $ \(ColumnDef x _ _) -> do - x' <- newName $ '_' : x - return (x, x') - let pcs = map (go xs) $ entityUniques def - let pat = ConP (mkName $ entityName def) $ map (VarP . snd) xs - return $ Clause [pat] (NormalB $ ListE pcs) [] - go xs (UniqueDef name cols) = - foldl (go' xs) (ConE (mkName name)) cols - go' xs front col = - let Just col' = lookup col xs - in front `AppE` VarE col' - --- | Automatically creates a valid 'PersistField' instance for any datatype --- that has valid 'Show' and 'Read' instances. Can be very convenient for --- 'Enum' types. -derivePersistField :: String -> Q [Dec] -derivePersistField s = do - ss <- [|SqlString|] - tpv <- [|PersistText . pack . show|] - fpv <- [|\dt v -> - case fromPersistValue v of - Left e -> Left e - Right s' -> - case reads s' of - (x, _):_ -> Right x - [] -> Left $ "Invalid " ++ dt ++ ": " ++ s'|] - return - [ InstanceD [] (ConT ''PersistField `AppT` ConT (mkName s)) - [ FunD (mkName "sqlType") - [ Clause [WildP] (NormalB ss) [] - ] - , FunD (mkName "toPersistValue") - [ Clause [] (NormalB tpv) [] - ] - , FunD (mkName "fromPersistValue") - [ Clause [] (NormalB $ fpv `AppE` LitE (StringL s)) [] - ] - ] - ] - --- | Creates a single function to perform all migrations for the entities --- defined here. One thing to be aware of is dependencies: if you have entities --- with foreign references, make sure to place those definitions after the --- entities they reference. -mkMigrate :: String -> [EntityDef] -> Q [Dec] -mkMigrate fun defs = do - body' <- body - return - [ SigD (mkName fun) typ - , FunD (mkName fun) [Clause [] (NormalB body') []] - ] - where - typ = ForallT [PlainTV $ mkName "m"] -#if MIN_VERSION_monad_control(0, 3, 0) - [ ClassP ''MonadBaseControl [ConT ''IO, VarT $ mkName "m"] - , ClassP ''MonadIO [VarT $ mkName "m"] - ] -#else - [ ClassP ''MonadControlIO [VarT $ mkName "m"] - ] -#endif - $ ConT ''Migration `AppT` (ConT ''SqlPersist `AppT` VarT (mkName "m")) - body :: Q Exp - body = - case defs of - [] -> [|return ()|] - _ -> DoE `fmap` mapM toStmt defs - toStmt :: EntityDef -> Q Stmt - toStmt ed = do - let n = entityName ed - u <- [|undefined|] - m <- [|migrate|] - let u' = SigE u $ ConT $ mkName n - return $ NoBindS $ m `AppE` u' - -instance Lift EntityDef where - lift (EntityDef a b c d e) = do - x <- [|EntityDef|] - a' <- lift a - b' <- lift b - c' <- lift c - d' <- lift d - e' <- lift e - return $ x `AppE` a' `AppE` b' `AppE` c' `AppE` d' `AppE` e' -instance Lift ColumnDef where - lift (ColumnDef a b c) = [|ColumnDef $(lift a) $(lift b) $(lift c)|] -instance Lift UniqueDef where - lift (UniqueDef a b) = [|UniqueDef $(lift a) $(lift b)|] - -instance Lift PersistFilter where - lift Eq = [|Eq|] - lift Ne = [|Ne|] - lift Gt = [|Gt|] - lift Lt = [|Lt|] - lift Ge = [|Ge|] - lift Le = [|Le|] - lift In = [|In|] - lift NotIn = [|NotIn|] - lift (BackendSpecificFilter x) = [|BackendSpecificFilter $(lift x)|] - -instance Lift PersistUpdate where - lift Assign = [|Assign|] - lift Add = [|Add|] - lift Subtract = [|Subtract|] - lift Multiply = [|Multiply|] - lift Divide = [|Divide|] - -mkField :: EntityDef -> ColumnDef -> Q (Con, Clause) -mkField et cd = do - let con = ForallC - [] - [EqualP (VarT $ mkName "typ") typ] - $ NormalC name [] - bod <- lift cd - let cla = Clause - [ConP name []] - (NormalB bod) - [] - return (con, cla) - {- - bod <- [|Field $(lift cd)|] - return - [ SigD name $ ConT ''Field `AppT` ConT (mkName $ entityName et) `AppT` typ - , FunD name [Clause [] (NormalB bod) []] - ] - -} - where - name = mkName $ concat [entityName et, upperFirst $ columnName cd] - base = - if "Id" `isSuffixOf` columnType cd - then ConT ''Key - `AppT` (VarT $ mkName "backend") - `AppT` (ConT (mkName $ take (length (columnType cd) - 2) (columnType cd) ++ suffix) `AppT` VarT (mkName "backend")) - else ConT (mkName $ columnType cd) - typ = if nullable $ columnAttribs cd - then ConT ''Maybe `AppT` base - else base - -suffix :: String -suffix = "Generic" diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,25 +1,20 @@ -The following license covers this documentation, and the source code, except -where otherwise indicated. - -Copyright 2010, Michael Snoyman. All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: +Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/ -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR -IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO -EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, -INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT -NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, -OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE -OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF -ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,29 @@ +# Begone! + +This package was absorbed into `persistent` with the 2.12.0.1 release. + +## persistent-template + +Provides Template Haskell helpers for persistent. For more information, see +[the chapter in the Yesod book](http://www.yesodweb.com/book/persistent). + +### code organization + +The TH.hs module contains code generators. +persistent-template uses `EntityDef`s that it gets from the quasi-quoter. +The quasi-quoter is in persistent Quasi.hs +Similarly many 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 --git a/persistent-template.cabal b/persistent-template.cabal --- a/persistent-template.cabal +++ b/persistent-template.cabal @@ -1,26 +1,24 @@ name: persistent-template -version: 0.6.3.1 -license: BSD3 +version: 2.12.0.0 +license: MIT license-file: LICENSE author: Michael Snoyman -maintainer: Michael Snoyman +maintainer: Michael Snoyman , Greg Weber synopsis: Type-safe, non-relational, multi-backend persistence. -description: This library provides just the general interface and helper functions. You must use a specific backend in order to make this useful. +description: Hackage documentation generation is not reliable. For up to date documentation, please see: . category: Database, Yesod stability: Stable -cabal-version: >= 1.6 +cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/book/persistent +bug-reports: https://github.com/yesodweb/persistent/issues +extra-source-files: ChangeLog.md README.md library - build-depends: base >= 4 && < 5 - , template-haskell - , persistent >= 0.6.2 && < 0.7 - , monad-control >= 0.2 && < 0.4 - , text >= 0.5 && < 1.0 - , transformers >= 0.2 - exposed-modules: Database.Persist.TH + build-depends: base >= 4.10 && < 5 + exposed-modules: ghc-options: -Wall + default-language: Haskell2010 source-repository head type: git