packages feed

persistent-template 0.6.3.1 → 2.12.0.0

raw patch · 5 files changed

Files

+ ChangeLog.md view
@@ -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
− Database/Persist/TH.hs
@@ -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"
LICENSE view
@@ -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.
+ README.md view
@@ -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!
persistent-template.cabal view
@@ -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 <michael@snoyman.com>-maintainer:      Michael Snoyman <michael@snoyman.com>+maintainer:      Michael Snoyman <michael@snoyman.com>, Greg Weber <greg@gregweber.info> 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: <http://www.stackage.org/package/persistent-template>. 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