groundhog-th 0.5.1 → 0.6.0

raw patch · 5 files changed

+248/−202 lines, 5 filesdep +aesondep +unordered-containersdep ~groundhogPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, unordered-containers

Dependency ranges changed: groundhog

API changes (from Hackage documentation)

Files

• Database/Groundhog/TH.hs +58/−46
• Database/Groundhog/TH/CodeGen.hs +143/−124
• Database/Groundhog/TH/Settings.hs +37/−30
• changelog +6/−0
• groundhog-th.cabal +4/−2

@@ -11,6 +11,9 @@   -- * Settings for code generation   , CodegenConfig(..)   , defaultCodegenConfig+  , defaultMkEntityDecs+  , defaultMkEmbeddedDecs+  , defaultMkPrimitiveDecs   -- $namingStylesDoc   , NamingStyle(..)   , suffixNamingStyle@@ -19,6 +22,8 @@   , lowerCaseSuffixNamingStyle   , toUnderscore   , firstChar+  -- * Utility functions+  , mkTHEntityDef   ) where  import Database.Groundhog.Core (delim, UniqueType(..))@@ -28,25 +33,29 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax (StrictType, VarStrictType, Lift(..)) import Language.Haskell.TH.Quote-import Control.Applicative ((<$>))+import Control.Applicative import Control.Monad (forM, forM_, when, unless, liftM2) import Data.Char (isUpper, isLower, isSpace, isDigit, toUpper, toLower) import Data.List (nub, (\\)) import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing) import Data.String import Data.Text.Encoding (encodeUtf8)-import Data.Yaml as Y(decodeHelper, ParseException(..))+import Data.Yaml as Y (decodeHelper, ParseException(..)) import qualified Text.Libyaml as Y  data CodegenConfig = CodegenConfig {-    -- | Naming style that is applied for all definitions+  -- | Naming style that is applied for all definitions     namingStyle :: NamingStyle-    -- | Codegenerator will create a function with this name that will run 'migrate' for each non-polymorphic entity in definition+  -- | Codegenerator will create a function with this name that will run 'migrate' for each non-polymorphic entity in definition   , migrationFunction :: Maybe String+  -- | Functions that produce Haskell code for the entities. In most cases when overriding, the default functions that produce mappings are not replaced but kept along with custom code. Example: @['defaultMkEntityDecs', mkMyDecs]@.+  , mkEntityDecs :: [THEntityDef -> Q [Dec]]+  , mkEmbeddedDecs :: [THEmbeddedDef -> Q [Dec]]+  , mkPrimitiveDecs :: [THPrimitiveDef -> Q [Dec]] }  defaultCodegenConfig :: CodegenConfig-defaultCodegenConfig = CodegenConfig suffixNamingStyle Nothing+defaultCodegenConfig = CodegenConfig suffixNamingStyle Nothing [defaultMkEntityDecs] [defaultMkEmbeddedDecs] [defaultMkPrimitiveDecs]  -- $namingStylesDoc -- When describing a datatype you can omit the most of the declarations. @@ -203,7 +212,7 @@   primitives <- catMaybes <$> forM defs (\d -> case d of     PSPrimitiveDef'     e -> Just .                                 applyPrimitiveSettings e               . mkTHPrimitiveDef namingStyle     <$> getDecl (psPrimitiveName e)     _ -> return Nothing)-  decs <- fmap (concat . concat) $ sequence [mapM mkEntityDecs entities, mapM mkEmbeddedDecs embeddeds, mapM mkPrimitiveDecs primitives]+  decs <- fmap concat $ sequence $ (mkEntityDecs <*> entities) ++ ( mkEmbeddedDecs <*> embeddeds) ++ (mkPrimitiveDecs <*> primitives)   migrateFunc <- maybe (return []) (\name -> mkMigrateFunction name entities) migrationFunction   return $ migrateFunc ++ decs @@ -255,7 +264,7 @@   f = foldr $ replaceOne "field" psFieldName thFieldName applyFieldSettings   convertUnique (PSUniqueDef uName uType uFields) = THUniqueDef uName (fromMaybe UniqueConstraint uType) uFields   -applyFieldSettings :: PSFieldDef -> THFieldDef -> THFieldDef+applyFieldSettings :: PSFieldDef String -> THFieldDef -> THFieldDef applyFieldSettings PSFieldDef{..} def@(THFieldDef{..}) =   def { thDbFieldName = fromMaybe thDbFieldName psDbFieldName       , thExprName = fromMaybe thExprName psExprName@@ -280,8 +289,9 @@  mkFieldsForUniqueKey :: NamingStyle -> String -> THUniqueKeyDef -> THConstructorDef -> [THFieldDef] mkFieldsForUniqueKey style dName uniqueKey cDef = zipWith (setSelector . findField) (thUniqueFields uniqueDef) [0..] where-  findField name = findOne "field" id thFieldName name $ thConstrFields cDef-  uniqueDef = findOne "unique" id thUniqueName (thUniqueKeyName uniqueKey) $ thConstrUniques cDef+  findField (Left name) = findOne "field" thFieldName name $ thConstrFields cDef+  findField (Right expr) = error $ "A unique key may not contain expressions: " ++ expr+  uniqueDef = findOne "unique" thUniqueName (thUniqueKeyName uniqueKey) $ thConstrUniques cDef   setSelector f i = f {thExprName = mkExprSelectorName style dName (thUniqueKeyConstrName uniqueKey) (thFieldName f) i}  notUniqueBy :: Eq b => (a -> b) -> [a] -> [b]@@ -328,14 +338,11 @@     then when (primaryConstraints > 0) $            fail $ "Custom primary keys may exist only for datatypes with single constructor: " ++ show (thDataName def)     else when (primaryConstraints + maybe 0 (const 1) (thAutoKey def) > 1) $-           fail $ "A datatype may have either an auto key or one custom primary key constraint : " ++ show (thDataName def)-  -- check that if unique keys = [] there is auto key-  when (null (thUniqueKeys def) && isNothing (thAutoKey def)) $-    fail $ "A datatype must have either an auto key or unique keys: " ++ show (thDataName def)+           fail $ "A datatype cannot have more than one primary key constraint: " ++ show (thDataName def)   -- check that only one of the keys is default-  let defaults = maybe False thAutoKeyIsDef (thAutoKey def) : map thUniqueKeyIsDef (thUniqueKeys def)-  when (length (filter id defaults) /= 1) $-    fail $ "A datatype must have exactly one default key: " ++ show (thDataName def)+  let keyDefaults = maybe id ((:) . thAutoKeyIsDef) (thAutoKey def) $ map thUniqueKeyIsDef (thUniqueKeys def)+  when (not (null keyDefaults) && length (filter id keyDefaults) /= 1) $+    fail $ "A datatype with keys must have one default key: " ++ show (thDataName def)   return def    validateField :: THFieldDef -> Either String ()@@ -432,7 +439,7 @@ --    \-- The declaration with defaulted names -- --mkPersist defaultCodegenConfig [groundhog|---entity: Settable                       # If we did not want to add a constraint, this line would be enough+--entity: Settable                       # If we did not have a constraint, this line would be enough --keys: --  - name: someconstraint --constructors:@@ -493,7 +500,12 @@ --        uniques: --          - name: someconstraint --            type: constraint           # The type can be be \"constraint\", \"index\", or \"primary\"---            fields: [foo, bar]         # List of constructor parameter names. Not DB names(!)+--            fields: [foo, bar]         # List of constructor parameter names. Not column names.+--   # This is example for databases which support expression indexes.+--   # Note that for checking index during migration expression should be written in exactly the same form as database returns.+--   #  - name: myuniqueindex+--   #    type: index+--   #    fields: [foo, {expr: "(bar + 1)" }] -- |] -- @ --@@ -579,45 +591,45 @@     Right (Left err) -> fail err     Right (Right result') -> lift (result' :: PersistDefinitions) -mkEntityDecs :: THEntityDef -> Q [Dec]-mkEntityDecs def = do+defaultMkEntityDecs :: THEntityDef -> Q [Dec]+defaultMkEntityDecs def = do   --runIO (print def)-  decs <- fmap concat $ sequence-    [ mkEntityPhantomConstructors def-    , mkEntityPhantomConstructorInstances def-    , mkAutoKeyPersistFieldInstance def-    , mkAutoKeyPrimitivePersistFieldInstance def-    , mkEntityUniqueKeysPhantoms def-    , mkUniqueKeysIsUniqueInstances def-    , mkUniqueKeysEmbeddedInstances def-    , mkUniqueKeysPersistFieldInstances def-    , mkUniqueKeysPrimitiveOrPurePersistFieldInstances def-    , mkKeyEqShowInstances def-    , mkEntityPersistFieldInstance def-    , mkEntitySinglePersistFieldInstance def-    , mkPersistEntityInstance def-    , mkEntityNeverNullInstance def+  decs <- fmap concat $ sequence $ map ($ def)+    [ mkEntityPhantomConstructors+    , mkEntityPhantomConstructorInstances+    , mkAutoKeyPersistFieldInstance+    , mkAutoKeyPrimitivePersistFieldInstance+    , mkEntityUniqueKeysPhantoms+    , mkUniqueKeysIsUniqueInstances+    , mkUniqueKeysEmbeddedInstances+    , mkUniqueKeysPersistFieldInstances+    , mkUniqueKeysPrimitiveOrPurePersistFieldInstances+    , mkKeyEqShowInstances+    , mkEntityPersistFieldInstance+    , mkEntitySinglePersistFieldInstance+    , mkPersistEntityInstance+    , mkEntityNeverNullInstance     ]   --runIO $ putStrLn $ pprint decs   return decs -mkEmbeddedDecs :: THEmbeddedDef -> Q [Dec]-mkEmbeddedDecs def = do+defaultMkEmbeddedDecs :: THEmbeddedDef -> Q [Dec]+defaultMkEmbeddedDecs def = do   --runIO (print def)-  decs <- fmap concat $ sequence-    [ mkEmbeddedPersistFieldInstance def-    , mkEmbeddedPurePersistFieldInstance def-    , mkEmbeddedInstance def+  decs <- fmap concat $ sequence $ map ($ def)+    [ mkEmbeddedPersistFieldInstance+    , mkEmbeddedPurePersistFieldInstance+    , mkEmbeddedInstance     ] --  runIO $ putStrLn $ pprint decs   return decs -mkPrimitiveDecs :: THPrimitiveDef -> Q [Dec]-mkPrimitiveDecs def = do+defaultMkPrimitiveDecs :: THPrimitiveDef -> Q [Dec]+defaultMkPrimitiveDecs def = do   --runIO (print def)-  decs <- fmap concat $ sequence-    [ mkPrimitivePersistFieldInstance def-    , mkPrimitivePrimitivePersistFieldInstance def+  decs <- fmap concat $ sequence $ map ($ def)+    [ mkPrimitivePersistFieldInstance+    , mkPrimitivePrimitivePersistFieldInstance     ] --  runIO $ putStrLn $ pprint decs   return decs

@@ -31,8 +31,9 @@ import Language.Haskell.TH.Syntax (Lift(..))
 import Control.Arrow (second)
 import Control.Monad (liftM, liftM2, forM, forM_, foldM, filterM, replicateM)
+import Data.Either (lefts, rights)
 import Data.List (findIndex, nub, partition)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, mapMaybe)
 
 mkEmbeddedPersistFieldInstance :: THEmbeddedDef -> Q [Dec]
 mkEmbeddedPersistFieldInstance def = do
@@ -81,6 +82,7 @@ 
   dbType' <- do
     v <- newName "v"
+    proxy <- newName "p"
     let mkField fNum f = do
         a <- newName "a"
         let fname = thDbFieldName f
@@ -88,10 +90,10 @@               then let pat = conP (thEmbeddedConstructorName def) $ replicate fNum wildP ++ [varP a] ++ replicate (length (thEmbeddedFields def) - fNum - 1) wildP
                    in caseE (varE v) $ [match pat (normalB $ varE a) []]
               else [| undefined :: $(return $ thFieldType f) |]
-            typ = mkType f nvar
+            typ = mkType f proxy nvar
         [| (fname, $typ) |]
     let pat = if null $ thEmbeddedTypeParams def then wildP else varP v
-    funD 'dbType $ [ clause [pat] (normalB [| DbEmbedded (EmbeddedDef False $(listE $ zipWith mkField [0..] $ thEmbeddedFields def)) Nothing |]) [] ]
+    funD 'dbType $ [ clause [varP proxy, pat] (normalB [| DbEmbedded (EmbeddedDef False $(listE $ zipWith mkField [0..] $ thEmbeddedFields def)) Nothing |]) [] ]
 
   let context = paramsContext (thEmbeddedTypeParams def) (thEmbeddedFields def)
   let decs = [persistName', toPersistValues', fromPersistValues', dbType']
@@ -197,10 +199,11 @@     toPersistValues' <- funD 'toPersistValues [clause [] (normalB [| primToPersistValue |]) []]
     fromPersistValues' <- funD 'fromPersistValues [clause [] (normalB [| primFromPersistValue |]) []]
     dbType' <- do
+      proxy <- newName "p"
       a <- newName "a"
-      let e = [| entityDef ((undefined :: Key v a -> v) $(varE a)) |]
-          body = [| DbTypePrimitive DbAutoKey False Nothing (Just (Left ($e, Nothing), Nothing, Nothing)) |]
-      funD 'dbType [clause [varP a] (normalB body) []]
+      let e = [| entityDef $(varE proxy) ((undefined :: Key v a -> v) $(varE a)) |]
+          body = [| DbTypePrimitive (getAutoKeyType $(varE proxy)) False Nothing (Just (Left ($e, Nothing), Nothing, Nothing)) |]
+      funD 'dbType [clause [varP proxy, varP a] (normalB body) []]
     
     let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
     let decs = [persistName', toPersistValues', fromPersistValues', dbType']
@@ -282,15 +285,16 @@ 
     dbType' <- do
       a <- newName "a"
+      proxy <- newName "p"
       let mkField f = do
           let fname = thDbFieldName f
               nvar = [| undefined :: $(return $ thFieldType f) |]
-              typ = mkType f nvar
+              typ = mkType f proxy nvar
           [| (fname, $typ) |]
       let embedded = [| EmbeddedDef False $(listE $ map mkField $ thUniqueKeyFields unique) |]
-          e = [| entityDef ((undefined :: Key v a -> v) $(varE a)) |]
+          e = [| entityDef $(varE proxy) ((undefined :: Key v a -> v) $(varE a)) |]
           body = [| DbEmbedded $embedded (Just (Left ($e, Just $(lift $ thUniqueKeyName unique)), Nothing, Nothing)) |]
-      funD 'dbType [clause [varP a] (normalB body) []]
+      funD 'dbType [clause [varP proxy, varP a] (normalB body) []]
     let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
     let decs = [persistName', toPersistValues', fromPersistValues', dbType']
     return $ InstanceD context (AppT (ConT ''PersistField) uniqKeyType) decs
@@ -302,9 +306,9 @@     uniqKeyType <- [t| Key $(return entity) (Unique $(conT $ mkName $ thUniqueKeyPhantomName unique)) |]
     let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
     let conName = mkName $ thUniqueKeyConstrName unique
-    isUniquePrim <- if (length $ thUniqueKeyFields unique) == 1
-      then isPrim $ thFieldType $ head $ thUniqueKeyFields unique
-      else return False
+    isUniquePrim <- case thUniqueKeyFields unique of
+      [uniq] -> isPrim $ thFieldType uniq
+      _      -> return False
     if isUniquePrim
       then do
         proxy <- newName "p"
@@ -322,11 +326,11 @@ mkKeyEqShowInstances :: THEntityDef -> Q [Dec]
 mkKeyEqShowInstances def = do
   let entity = foldl AppT (ConT (thDataName def)) $ map extractType $ thTypeParams def
-  let forKeys f = maybe [] (\k -> [f (thAutoKeyConstrName k) 1]) (thAutoKey def)
-               ++ map (\k -> f (thUniqueKeyConstrName k) (length $ thUniqueKeyFields k)) (thUniqueKeys def)
+  let keysInfo = maybe [] (\k -> [(thAutoKeyConstrName k, 1)]) (thAutoKey def)
+               ++ map (\k -> (thUniqueKeyConstrName k, length $ thUniqueKeyFields k)) (thUniqueKeys def)
 
   showsPrec' <- let
-    mkClause cName fieldsNum = do
+    mkClause (cName, fieldsNum) = do
       p <- newName "p"
       fields <- replicateM fieldsNum (newName "x")
       let pat = conP (mkName cName) $ map varP fields
@@ -334,22 +338,24 @@           showArgs = foldr1 (\a b -> [| $a . showString " " . $b |]) $ map (\a -> [| showsPrec 11 $(varE a) |]) fields
           body = [| showParen ($(varE p) >= (11 :: Int)) ($showC . $showArgs) |]
       clause [varP p, pat] (normalB body) []
-    in funD 'showsPrec $ forKeys mkClause
+    in funD 'showsPrec $ map mkClause keysInfo
     
   eq' <- let
-    mkClause cName fieldsNum = do
+    mkClause (cName, fieldsNum) = do
       let fields = replicateM fieldsNum (newName "x")
       (fields1, fields2) <- liftM2 (,) fields fields
       let mkPat = conP (mkName cName) . map varP
           body = foldr1 (\e1 e2 -> [| $e1 && $e2 |]) $ zipWith (\n1 n2 -> [| $(varE n1) == $(varE n2) |]) fields1 fields2
       clause [mkPat fields1, mkPat fields2] (normalB body) []
-    clauses = forKeys mkClause
+    clauses = map mkClause keysInfo
     noMatch = if length clauses > 1 then [clause [wildP, wildP] (normalB [| False |]) []] else []
     in funD '(==) $ clauses ++ noMatch
 
   let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
   typ <- [t| Key $(return entity) $(newName "a" >>= varT) |]
-  return $ [InstanceD context (AppT (ConT ''Eq) typ) [eq'], InstanceD context (AppT (ConT ''Show) typ) [showsPrec']]
+  return $ if null keysInfo
+    then []
+    else [InstanceD context (AppT (ConT ''Eq) typ) [eq'], InstanceD context (AppT (ConT ''Show) typ) [showsPrec']]
 
 mkEmbeddedInstance :: THEmbeddedDef -> Q [Dec]
 mkEmbeddedInstance def = do
@@ -415,26 +421,26 @@         keyDescr <- [t| BackendSpecific |]
         return [ForallC [] [EqualP (VarT uParam) keyDescr] $ NormalC (mkName $ thAutoKeyConstrName k) [(NotStrict, ConT ''PersistValue)]]
     uniques <- forM (thUniqueKeys def) $ \unique -> do
-      let cDef = head $ thConstructors def
       uniqType <- [t| Unique $(conT $ mkName $ thUniqueKeyPhantomName unique) |]
-      let uniqFieldNames = thUniqueFields $ findOne "unique" thUniqueKeyName thUniqueName unique $ thConstrUniques cDef
-      let uniqFields = concat $ flip map uniqFieldNames $ \name -> (filter ((== name) . thFieldName) $ thConstrFields cDef)
-      let uniqFields' = map (\f -> (NotStrict, thFieldType f)) uniqFields
+      let cDef = head $ thConstructors def
+          uniqFieldNames = lefts $ thUniqueFields $ findOne "unique" thUniqueName (thUniqueKeyName unique) $ thConstrUniques cDef
+          uniqFields = concat $ flip map uniqFieldNames $ \name -> (filter ((== name) . thFieldName) $ thConstrFields cDef)
+          uniqFields' = map (\f -> (NotStrict, thFieldType f)) uniqFields
       return $ ForallC [] [EqualP (VarT uParam) uniqType] $ NormalC (mkName $ thUniqueKeyConstrName unique) uniqFields'
     return $ DataInstD [] ''Key [entity, VarT uParam] (autoKey ++ uniques) []
 
   autoKey' <- do
     autoType <- case thAutoKey def of
-      Nothing -> conT ''()
+      Nothing -> [t| () |]
       Just _ -> [t| Key $(return entity) BackendSpecific |]
     return $ mkTySynInstD ''AutoKey [entity] autoType
     
   defaultKey' <- do
-    let keyType = case thAutoKey def of
-         Just k | thAutoKeyIsDef k -> [t| BackendSpecific |]
-         _ -> let unique = head $ filter thUniqueKeyIsDef $ thUniqueKeys def
-              in  [t| Unique $(conT $ mkName $ thUniqueKeyPhantomName unique) |]
-    typ <- [t| Key $(return entity) $keyType |]
+    typ <- case thAutoKey def of
+      Just k | thAutoKeyIsDef k -> [t| Key $(return entity) BackendSpecific |]
+      _ -> case filter thUniqueKeyIsDef $ thUniqueKeys def of
+        [unique] -> [t| Key $(return entity) (Unique $(conT $ mkName $ thUniqueKeyPhantomName unique)) |]
+        _ -> [t| () |]
     return $ mkTySynInstD ''DefaultKey [entity] typ
 
   isSumType' <- do
@@ -453,35 +459,35 @@     
   entityDef' <- do
     v <- newName "v"
+    proxy <- newName "p"
     let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |]
-    let types = map extractType $ thTypeParams def
-    let typeParams' = listE $ map (\t -> [| dbType ($(mkLambda t) $(varE v)) |]) types
-    let mkField c fNum f = do
-        a <- newName "a"
-        let fname = thDbFieldName f
-            nvar = if hasFreeVars (thFieldType f)
-              then let pat = conP (thConstrName c) $ replicate fNum wildP ++ [varP a] ++ replicate (length (thConstrFields c) - fNum - 1) wildP
-                       wildClause = if length (thConstructors def) > 1 then [match wildP (normalB [| undefined |]) []] else []
-                   in caseE (varE v) $ [match pat (normalB $ varE a) []] ++ wildClause
-              else [| undefined :: $(return $ thFieldType f) |]
-            typ = mkType f nvar
-        [| (fname, $typ) |]
-    let constrs = listE $ zipWith mkConstructorDef [0 :: Int ..] $ thConstructors def
-        mkConstructorDef cNum c@(THConstructorDef _ _ name keyName params conss) = [| ConstructorDef cNum name keyName $(listE $ map snd fields) $(listE $ map mkConstraint conss) |] where
+        types = map extractType $ thTypeParams def
+        typeParams' = listE $ map (\t -> [| dbType $(varE proxy) ($(mkLambda t) $(varE v)) |]) types
+        mkField c fNum f = do
+          a <- newName "a"
+          let fname = thDbFieldName f
+              nvar = if hasFreeVars (thFieldType f)
+                then let pat = conP (thConstrName c) $ replicate fNum wildP ++ [varP a] ++ replicate (length (thConstrFields c) - fNum - 1) wildP
+                         wildClause = if length (thConstructors def) > 1 then [match wildP (normalB [| undefined |]) []] else []
+                     in caseE (varE v) $ [match pat (normalB $ varE a) []] ++ wildClause
+                else [| undefined :: $(return $ thFieldType f) |]
+              typ = mkType f proxy nvar
+          [| (fname, $typ) |]
+        constrs = listE $ map mkConstructorDef $ thConstructors def
+        mkConstructorDef c@(THConstructorDef _ _ name keyName params conss) = [| ConstructorDef name keyName $(listE $ map snd fields) $(listE $ map mkConstraint conss) |] where
           fields = zipWith (\i f -> (thFieldName f, mkField c i f)) [0..] params
-          mkConstraint (THUniqueDef uName uType uFields) = [| UniqueDef uName uType $(listE $ map getField uFields) |]
-          getField fName = case lookup fName fields of
-            Just f -> f
-            Nothing -> error $ "Field name " ++ show fName ++ " declared in unique not found"
+          mkConstraint (THUniqueDef uName uType uFields) = [| UniqueDef (Just uName) uType $(listE $ map getField uFields) |]
+          getField (Left fName) = [| Left $(snd $ findOne "field" fst fName fields) |]
+          getField (Right expr) = [| Right expr |]
     
-    let paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types
-    let fullEntityName = case null types of
+        paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types
+        fullEntityName = case null types of
          True  -> [| $(stringE $ thDbEntityName def) |]
          False -> [| $(stringE $ thDbEntityName def) ++ [delim] ++ $(paramNames) |]
 
-    let body = normalB [| EntityDef $fullEntityName $(lift $ thEntitySchema def) $typeParams' $constrs |]
-    let pat = if null $ thTypeParams def then wildP else varP v
-    funD 'entityDef $ [ clause [pat] body [] ]
+        body = normalB [| EntityDef $fullEntityName $(lift $ thEntitySchema def) $typeParams' $constrs |]
+        entityPat = if null $ thTypeParams def then wildP else varP v
+    funD 'entityDef $ [ clause [varP proxy, entityPat] body [] ]
 
   toEntityPersistValues' <- liftM (FunD 'toEntityPersistValues) $ forM (zip [0 :: Int ..] $ thConstructors def) $ \(cNum, c) -> do
     vars <- mapM (\f -> newName "x" >>= \fname -> return (fname, thFieldType f)) $ thConstrFields c
@@ -504,7 +510,7 @@ 
   fromEntityPersistValues' <- do
       xs <- newName "xs"
-      let failureBody = normalB [| (\a -> fail (failMessage a $(varE xs)) >> return (a, [])) undefined |]
+      let failureBody = normalB [| (\a -> phantomDb >>= \proxy -> fail (failMessageNamed (entityName $ entityDef proxy a) $(varE xs)) >> return (a, [])) undefined |]
       failureName <- newName "failure"
       let failure = match wildP (normalB $ varE failureName) []
       matches <- forM (zip [0..] (thConstructors def)) $ \(cNum, c) -> do
@@ -522,15 +528,18 @@     mkClause cNum cdef | not (hasConstraints cdef) = clause [wildP, conP (thConstrName cdef) pats] (normalB [| (cNum, []) |]) [] where
       pats = map (const wildP) $ thConstrFields cdef
     mkClause cNum cdef = do
-      let allConstrainedFields = concatMap thUniqueFields $ thConstrUniques cdef
+      let allConstrainedFields = lefts $ concatMap thUniqueFields $ thConstrUniques cdef
       vars <- mapM (\f -> newName "x" >>= \x -> return $ if thFieldName f `elem` allConstrainedFields then Just (x, f) else Nothing) $ thConstrFields cdef
       proxy <- newName "p"
       let pat = conP (thConstrName cdef) $ map (maybe wildP (varP . fst)) vars
-          body = normalB $ [| (cNum, $(listE $ map mkUnique $ thConstrUniques cdef)) |]
-          mkUnique (THUniqueDef uName _ fnames) = [| (uName, $result) |] where
-            -- find corresponding field from vars
-            uFields = map (\f -> findOne "field" id (thFieldName . snd) f $ catMaybes vars) fnames
-            result = mkToPurePersistValues proxy $ map (second thFieldType) uFields
+          body = normalB $ [| (cNum, $(listE $ mapMaybe mkUnique $ thConstrUniques cdef)) |]
+          mkUnique (THUniqueDef uName _ fnames) = if null $ rights fnames
+            then let
+              -- find corresponding field from vars
+              uFields = map (\f -> findOne "field" (thFieldName . snd) f $ catMaybes vars) $ lefts fnames
+              result = mkToPurePersistValues proxy $ map (second thFieldType) uFields
+              in Just [| (uName, $result) |]
+            else Nothing
       clause [varP proxy, pat] body []
     in funD 'getUniques clauses
 
@@ -539,12 +548,13 @@     clauses = map mkClause thFieldNames
     mkClause f = do
         fArg <- newName "f"
+        proxy <- newName "p"
         let nvar = [| (undefined :: Field v c a -> a) $(varE fArg) |]
-            typ = mkType f nvar
+            typ = mkType f proxy nvar
             body = [| (($(lift $ thDbFieldName f), $typ), []) |]
-        clause [asP fArg $ conP (mkName $ thExprName f) []] (normalB body) []-    clauses' = if null clauses then [clause [wildP] (normalB [| undefined |]) []] else clauses-    in funD 'entityFieldChain clauses'+        clause [varP proxy, asP fArg $ conP (mkName $ thExprName f) []] (normalB body) []
+    clauses' = if null clauses then [clause [wildP] (normalB [| undefined |]) []] else clauses
+    in funD 'entityFieldChain clauses'
 
   let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
   let decs = [key', autoKey', defaultKey', isSumType', fields', entityDef', toEntityPersistValues', fromEntityPersistValues', getUniques', entityFieldChain']
@@ -566,69 +576,75 @@       letE stmts result
 
 mkEntityPersistFieldInstance :: THEntityDef -> Q [Dec]
-mkEntityPersistFieldInstance def = do
-  let types = map extractType $ thTypeParams def
-  let entity = foldl AppT (ConT (thDataName def)) types
+mkEntityPersistFieldInstance def = case getDefaultKey def of
+  Just defaultKey -> do
+    let types = map extractType $ thTypeParams def
+    let entity = foldl AppT (ConT (thDataName def)) types
   
-  persistName' <- do
-    v <- newName "v"
-    let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |]
+    persistName' <- do
+      v <- newName "v"
+      let mkLambda t = [|undefined :: $(forallT (thTypeParams def) (cxt []) [t| $(return entity) -> $(return t) |]) |]
     
-    let paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types
-    let fullEntityName = case null types of
-         True  -> [| $(stringE $ thDbEntityName def) |]
-         False -> [| $(stringE $ thDbEntityName def) ++ [delim] ++ $(paramNames) |]
-    let body = normalB $ fullEntityName
-    let pat = if null types then wildP else varP v
-    funD 'persistName $ [ clause [pat] body [] ]
+      let paramNames = foldr1 (\p xs -> [| $p ++ [delim] ++ $xs |] ) $ map (\t -> [| persistName ($(mkLambda t) $(varE v)) |]) types
+      let fullEntityName = case null types of
+           True  -> [| $(stringE $ thDbEntityName def) |]
+           False -> [| $(stringE $ thDbEntityName def) ++ [delim] ++ $(paramNames) |]
+      let body = normalB $ fullEntityName
+      let pat = if null types then wildP else varP v
+      funD 'persistName $ [ clause [pat] body [] ]
   
-  isOne <- isDefaultKeyOneColumn def
-  let uniqInfo = either auto uniq $ getDefaultKey def where
-      auto _ = Nothing
-      uniq u = let name = mkName $ thUniqueKeyPhantomName u in Just $ (conT name, conE name)
+    isOne <- isDefaultKeyOneColumn def
+    let uniqInfo = either auto uniq defaultKey where
+        auto _ = Nothing
+        uniq u = let name = mkName $ thUniqueKeyPhantomName u in Just $ (conT name, conE name)
 
-  toPersistValues' <- do
-    let body = normalB $ case uniqInfo of
-         _ | isOne -> [| singleToPersistValue |]
-         Just u    -> [| toPersistValuesUnique $(snd u) |]
-         _         -> error "mkEntityPersistFieldInstance: key has no unique type"
-    funD 'toPersistValues $ [ clause [] body [] ]
+    toPersistValues' <- do
+      let body = normalB $ case uniqInfo of
+           _ | isOne -> [| singleToPersistValue |]
+           Just u    -> [| toPersistValuesUnique $(snd u) |]
+           _         -> error "mkEntityPersistFieldInstance: key has no unique type"
+      funD 'toPersistValues $ [ clause [] body [] ]
 
-  fromPersistValues' <- do
-    let body = normalB $ case uniqInfo of
-         _ | isOne -> [| singleFromPersistValue |]
-         Just u    -> [| fromPersistValuesUnique $(snd u) |]
-         _         -> error "mkEntityPersistFieldInstance: key has no unique type"
-    funD 'fromPersistValues $ [ clause [] body []]
+    fromPersistValues' <- do
+      let body = normalB $ case uniqInfo of
+           _ | isOne -> [| singleFromPersistValue |]
+           Just u    -> [| fromPersistValuesUnique $(snd u) |]
+           _         -> error "mkEntityPersistFieldInstance: key has no unique type"
+      funD 'fromPersistValues $ [ clause [] body []]
 
-  dbType' <- funD 'dbType $ [clause [] (normalB [| dbType . (undefined :: a -> DefaultKey a) |]) []]
+    dbType' <- do
+      proxy <- newName "p"
+      let body = [| dbType $(varE proxy) . (undefined :: a -> DefaultKey a) |]
+      funD 'dbType $ [clause [varP proxy] (normalB body) []]
 
-  let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
-  let decs = [persistName', toPersistValues', fromPersistValues', dbType']
-  return $ [InstanceD context (AppT (ConT ''PersistField) entity) decs]
+    let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
+    let decs = [persistName', toPersistValues', fromPersistValues', dbType']
+    return $ [InstanceD context (AppT (ConT ''PersistField) entity) decs]
+  Nothing -> return []
 
 mkEntitySinglePersistFieldInstance :: THEntityDef -> Q [Dec]
-mkEntitySinglePersistFieldInstance def = isDefaultKeyOneColumn def >>= \isOne ->
-  if isOne
-    then do
-      toSinglePersistValue' <- funD 'toSinglePersistValue $ [ clause [] (normalB to) [] ]
-      fromSinglePersistValue' <- funD 'fromSinglePersistValue $ [ clause [] (normalB from) []]
-      let decs = [toSinglePersistValue', fromSinglePersistValue']
-      return [InstanceD context (AppT (ConT ''SinglePersistField) entity) decs]
-    else return [] where
-    (to, from) = case getDefaultKey def of
-      Left  _ -> ([| toSinglePersistValueAutoKey |], [| fromSinglePersistValueAutoKey |])
-      Right k -> ([| toSinglePersistValueUnique $u |], [| fromSinglePersistValueUnique $u |]) where
-        u = conE $ mkName $ thUniqueKeyPhantomName k
-    types = map extractType $ thTypeParams def
-    entity = foldl AppT (ConT (thDataName def)) types
-    context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
+mkEntitySinglePersistFieldInstance def = isDefaultKeyOneColumn def >>= \isOne -> case getDefaultKey def of
+  Just defaultKey | isOne -> do
+    let types = map extractType $ thTypeParams def
+        entity = foldl AppT (ConT (thDataName def)) types
+        context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
 
+        (to, from) = case defaultKey of
+          Left  _ -> ([| toSinglePersistValueAutoKey |], [| fromSinglePersistValueAutoKey |])
+          Right k -> ([| toSinglePersistValueUnique $u |], [| fromSinglePersistValueUnique $u |]) where
+            u = conE $ mkName $ thUniqueKeyPhantomName k
+
+    toSinglePersistValue' <- funD 'toSinglePersistValue $ [ clause [] (normalB to) [] ]
+    fromSinglePersistValue' <- funD 'fromSinglePersistValue $ [ clause [] (normalB from) []]
+    let decs = [toSinglePersistValue', fromSinglePersistValue']
+    return [InstanceD context (AppT (ConT ''SinglePersistField) entity) decs]
+  _ -> return []
+
 mkEntityNeverNullInstance :: THEntityDef -> Q [Dec]
 mkEntityNeverNullInstance def = do
   let types = map extractType $ thTypeParams def
-  let entity = foldl AppT (ConT (thDataName def)) types
-  let context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
+      entity = foldl AppT (ConT (thDataName def)) types
+      context = paramsContext (thTypeParams def) (thConstructors def >>= thConstrFields)
   isOne <- isDefaultKeyOneColumn def
   return $ if isOne
     then [InstanceD context (AppT (ConT ''NeverNull) entity) []]
@@ -646,7 +662,7 @@     let typ = if thPrimitiveStringEnumRepresentation def
           then [| DbTypePrimitive DbString False Nothing Nothing |]
           else [| DbTypePrimitive DbInt32  False Nothing Nothing |]
-    funD 'dbType $ [ clause [wildP] (normalB typ) [] ]
+    funD 'dbType $ [ clause [wildP, wildP] (normalB typ) [] ]
   let decs = [persistName', toPersistValues', fromPersistValues', dbType']
   return [ InstanceD [] (AppT (ConT ''PersistField) prim) decs
          , InstanceD [] (AppT (ConT ''NeverNull) prim) []
@@ -687,15 +703,18 @@   return [sig, func]
 
 isDefaultKeyOneColumn :: THEntityDef -> Q Bool
-isDefaultKeyOneColumn def = either (const $ return True) checkUnique $ getDefaultKey def where
-  checkUnique unique = if (length $ thUniqueKeyFields unique) == 1
-    then isPrim $ thFieldType $ head $ thUniqueKeyFields unique
-    else return False
+isDefaultKeyOneColumn def = case getDefaultKey def of
+  Just (Left _) -> return True
+  Just (Right unique) | (length $ thUniqueKeyFields unique) == 1 ->
+    isPrim $ thFieldType $ head $ thUniqueKeyFields unique
+  _ -> return False
 
-getDefaultKey :: THEntityDef -> Either THAutoKeyDef THUniqueKeyDef
+getDefaultKey :: THEntityDef -> Maybe (Either THAutoKeyDef THUniqueKeyDef)
 getDefaultKey def = case thAutoKey def of
-  Just k | thAutoKeyIsDef k -> Left k
-  _ -> Right $ head $ filter thUniqueKeyIsDef $ thUniqueKeys def
+  Just k | thAutoKeyIsDef k -> Just $ Left k
+  _ -> case filter thUniqueKeyIsDef $ thUniqueKeys def of
+    [] -> Nothing
+    (u:_) -> Just $ Right u
 
 paramsContext :: [TyVarBndr] -> [THFieldDef] -> Cxt
 paramsContext types fields = classPred ''PersistField params ++ classPred ''SinglePersistField maybys ++ classPred ''NeverNull maybys where
@@ -775,10 +794,10 @@         return (x:ys, zs)
       else return ([], x:xs)
 
-mkType :: THFieldDef -> ExpQ -> ExpQ
-mkType THFieldDef{..} nvar = t2 where
+mkType :: THFieldDef -> Name -> ExpQ -> ExpQ
+mkType THFieldDef{..} proxy nvar = t2 where
   psField = PSFieldDef thFieldName (Just thDbFieldName) thDbTypeName (Just thExprName) thEmbeddedDef thDefaultValue thReferenceParent
-  t1 = [| dbType $nvar |]
+  t1 = [| dbType $(varE proxy) $nvar |]
   -- if there are any type settings, apply them in runtime
   t2 = case (thDbTypeName, thEmbeddedDef, thDefaultValue, thReferenceParent) of
     (Nothing, Nothing, Nothing, Nothing) -> t1

@@ -27,8 +27,9 @@ import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
 import Control.Applicative
-import Control.Monad (mzero)
-import Data.Yaml
+import Control.Monad (forM, mzero)
+import Data.Aeson
+import qualified Data.HashMap.Strict as H
 
 data PersistDefinitions = PersistDefinitions {definitions :: [PersistDefinition]} deriving Show
 data PersistDefinition = PSEntityDef' PSEntityDef
@@ -82,7 +83,7 @@   , thDbTypeName :: Maybe String -- inet, NUMERIC(5, 2), VARCHAR(50)
   , thExprName :: String -- BarField
   , thFieldType :: Type
-  , thEmbeddedDef :: Maybe [PSFieldDef]
+  , thEmbeddedDef :: Maybe [PSFieldDef String]
   , thDefaultValue :: Maybe String
   , thReferenceParent :: Maybe (Maybe (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)
 } deriving Show
@@ -90,7 +91,7 @@ data THUniqueDef = THUniqueDef {
     thUniqueName :: String
   , thUniqueType :: UniqueType
-  , thUniqueFields :: [String] -- ^ Names of fields, not column names, i.e, thFieldName
+  , thUniqueFields :: [Either String String] -- ^ Either name of field, i.e, thFieldName, or expression
 } deriving Show
 
 data THUniqueKeyDef = THUniqueKeyDef {
@@ -116,7 +117,7 @@ data PSEmbeddedDef = PSEmbeddedDef {
     psEmbeddedName :: String
   , psDbEmbeddedName :: Maybe String -- ^ It is used only to set polymorphic part of name of its container
-  , psEmbeddedFields :: Maybe [PSFieldDef]
+  , psEmbeddedFields :: Maybe [PSFieldDef String]
 } deriving Show
 
 data PSPrimitiveDef = PSPrimitiveDef {
@@ -130,14 +131,14 @@   , psPhantomConstrName :: Maybe String -- U2Constructor
   , psDbConstrName :: Maybe String -- SQLU2
   , psDbAutoKeyName :: Maybe (Maybe String) -- u2_id
-  , psConstrFields  :: Maybe [PSFieldDef]
+  , psConstrFields  :: Maybe [PSFieldDef String]
   , psConstrUniques :: Maybe [PSUniqueDef]
 } deriving Show
 
 data PSUniqueDef = PSUniqueDef {
     psUniqueName :: String
   , psUniqueType :: Maybe UniqueType
-  , psUniqueFields :: [String]
+  , psUniqueFields :: [Either String String]
 } deriving Show
 
 data PSUniqueKeyDef = PSUniqueKeyDef {
@@ -145,7 +146,7 @@   , psUniqueKeyPhantomName :: Maybe String
   , psUniqueKeyConstrName :: Maybe String
   , psUniqueKeyDbName :: Maybe String
-  , psUniqueKeyFields :: Maybe [PSFieldDef]
+  , psUniqueKeyFields :: Maybe [PSFieldDef String]
   , psUniqueKeyMakeEmbedded :: Maybe Bool
   , psUniqueKeyIsDef :: Maybe Bool
 } deriving Show
@@ -190,7 +191,7 @@   lift SetNull = [| SetNull |]
   lift SetDefault = [| SetDefault |]
 
-instance Lift PSFieldDef where
+instance Lift (PSFieldDef String) where
   lift (PSFieldDef {..}) = [| PSFieldDef $(lift psFieldName) $(lift psDbFieldName) $(lift psDbTypeName) $(lift psExprName) $(lift psEmbeddedDef) $(lift psDefaultValue) $(lift psReferenceParent) |]
 
 instance Lift PSUniqueKeyDef where
@@ -219,20 +220,23 @@     _ -> mzero
 
 instance FromJSON PersistDefinition where
-  parseJSON obj = PSEntityDef' <$> parseJSON obj
-              <|> PSEmbeddedDef' <$> parseJSON obj
-              <|> PSPrimitiveDef' <$> parseJSON obj
+  parseJSON obj@(Object v) = case () of
+    _ | H.member "entity" v -> PSEntityDef' <$> parseJSON obj
+    _ | H.member "embedded" v -> PSEmbeddedDef' <$> parseJSON obj
+    _ | H.member "primitive" v -> PSPrimitiveDef' <$> parseJSON obj
+    _ -> mzero
+  parseJSON _ = mzero
 
 instance FromJSON PSEntityDef where
-  parseJSON (Object v) = PSEntityDef <$> v .: "entity" <*> v .:? "dbName" <*> v .:? "schema" <*> optional (v .: "autoKey") <*> v .:? "keys" <*> v .:? "constructors"
-  parseJSON _          = mzero
+  parseJSON = withObject "entity" $ \v ->
+    PSEntityDef <$> v .: "entity" <*> v .:? "dbName" <*> v .:? "schema" <*> optional (v .: "autoKey") <*> v .:? "keys" <*> v .:? "constructors"
 
 instance FromJSON PSEmbeddedDef where
-  parseJSON (Object v) = PSEmbeddedDef <$> v .: "embedded" <*> v .:? "dbName" <*> v .:? "fields"
-  parseJSON _          = mzero
+  parseJSON = withObject "embedded" $ \v ->
+    PSEmbeddedDef <$> v .: "embedded" <*> v .:? "dbName" <*> v .:? "fields"
 
 instance FromJSON PSPrimitiveDef where
-  parseJSON (Object v) = do
+  parseJSON = withObject "primitive" $ \v -> do
     x <- v .:? "representation"
     let representation = case x of
           Nothing -> pure True
@@ -240,15 +244,18 @@           Just "enum" -> pure False
           Just r -> fail $ "parseJSON: representation expected [\"showread\",\"enum\"], but got " ++ r
     PSPrimitiveDef <$> v .: "primitive" <*> v .:? "dbName" <*> pure representation
-  parseJSON _          = mzero
 
 instance FromJSON PSConstructorDef where
-  parseJSON (Object v) = PSConstructorDef <$> v .: "name" <*> v .:? "phantomName" <*> v .:? "dbName" <*> v .:? "keyDbName" <*> v .:? "fields" <*> v .:? "uniques"
-  parseJSON _          = mzero
+  parseJSON = withObject "constructor" $ \v ->
+     PSConstructorDef <$> v .: "name" <*> v .:? "phantomName" <*> v .:? "dbName" <*> v .:? "keyDbName" <*> v .:? "fields" <*> v .:? "uniques"
 
 instance FromJSON PSUniqueDef where
-  parseJSON (Object v) = PSUniqueDef <$> v .: "name" <*> v .:? "type" <*> v .: "fields"
-  parseJSON _          = mzero
+  parseJSON = withObject "unique" $ \v -> do
+    fields <- v .: "fields"
+    fields' <- forM fields $ \f -> case f of
+      Object expr  -> Right <$> expr .: "expr"
+      field -> Left <$> parseJSON field
+    PSUniqueDef <$> v .: "name" <*> v .:? "type" <*> pure fields'
 
 instance FromJSON UniqueType where
   parseJSON o = do
@@ -266,9 +273,10 @@       Just a -> return a
       Nothing -> fail $ "parseJSON: UniqueType expected " ++ show (map fst vals) ++ ", but got " ++ x
 
-instance FromJSON PSFieldDef where
-  parseJSON (Object v) = PSFieldDef <$> v .: "name" <*> v .:? "dbName" <*> v .:? "type" <*> v .:? "exprName" <*> v .:? "embeddedType" <*> v .:? "default" <*> mkRefSettings where
-    mkRefSettings = do
+instance FromJSON (PSFieldDef String) where
+  parseJSON = withObject "field" $ \v ->
+    PSFieldDef <$> v .: "name" <*> v .:? "dbName" <*> v .:? "type" <*> v .:? "exprName" <*> v .:? "embeddedType" <*> v .:? "default" <*> mkRefSettings v where
+    mkRefSettings v = do
       ref <- v .:? "reference"
       (parent, onDel, onUpd) <- case ref of
         Just (Object r) -> (,,) <$> parentRef <*> r .:? "onDelete" <*> r .:? "onUpdate" where
@@ -279,12 +287,11 @@       pure $ case (parent, onDel <|> onDel', onUpd <|> onUpd') of
         (Nothing, Nothing, Nothing) -> Nothing
         refSettings -> Just refSettings
-  parseJSON _          = mzero
 
 instance FromJSON PSUniqueKeyDef where
-  parseJSON (Object v) = PSUniqueKeyDef <$> v .: "name" <*> v .:? "keyPhantom" <*> v .:? "constrName" <*> v .:? "dbName" <*> v .:? "fields" <*> v .:? "mkEmbedded" <*> v .:? "default"
-  parseJSON _          = mzero
+  parseJSON = withObject "unique key" $ \v ->
+    PSUniqueKeyDef <$> v .: "name" <*> v .:? "keyPhantom" <*> v .:? "constrName" <*> v .:? "dbName" <*> v .:? "fields" <*> v .:? "mkEmbedded" <*> v .:? "default"
 
 instance FromJSON PSAutoKeyDef where
-  parseJSON (Object v) = PSAutoKeyDef <$> v .:? "constrName" <*> v .:? "default"
-  parseJSON _          = mzero
+  parseJSON = withObject "autogenerated key" $ \v ->
+    PSAutoKeyDef <$> v .:? "constrName" <*> v .:? "default"

@@ -1,3 +1,9 @@+0.6.0+* Entities without keys. It can be useful for many-to-many tables which hold keys but are not referenced+* Entity and fields descriptions are parameterized so that they can be promoted+* Entity and fields descriptions are dependent on database proxy. It allows to use different types depending on a database, for example, the same type can be array[] in PostgreSQL and varchar elsewhere+* Migration support for indexes on expressions+ 0.5.1 * Export firstChar for creating user naming styles * Support entities with no fields

@@ -1,5 +1,5 @@ name:            groundhog-th-version:         0.5.1+version:         0.6.0 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -17,10 +17,12 @@ library     build-depends:   base                     >= 4         && < 5                    , bytestring               >= 0.9-                   , groundhog                >= 0.5.0     && < 0.6.0+                   , groundhog                >= 0.6       && < 0.7                    , template-haskell                    , time                     >= 1.1.4                    , containers               >= 0.2+                   , unordered-containers     >= 0.1.3+                   , aeson                    >= 0.7                    , yaml                     >= 0.8.1                    , text                     >= 0.8     exposed-modules: Database.Groundhog.TH