packages feed

groundhog 0.5.1 → 0.6.0

raw patch · 9 files changed

+288/−221 lines, 9 filesdep ~blaze-builderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: blaze-builder

API changes (from Hackage documentation)

- Database.Groundhog.Core: DbAutoKey :: DbTypePrimitive
- Database.Groundhog.Core: constrNum :: ConstructorDef -> Int
- Database.Groundhog.Core: data ConstructorDef
- Database.Groundhog.Core: data DbTypePrimitive
- Database.Groundhog.Core: data EmbeddedDef
- Database.Groundhog.Core: data EntityDef
- Database.Groundhog.Core: data UniqueDef
- Database.Groundhog.Core: instance Eq ConstructorDef
- Database.Groundhog.Core: instance Eq DbTypePrimitive
- Database.Groundhog.Core: instance Eq EmbeddedDef
- Database.Groundhog.Core: instance Eq EntityDef
- Database.Groundhog.Core: instance Eq OtherTypeDef
- Database.Groundhog.Core: instance Eq UniqueDef
- Database.Groundhog.Core: instance HasSelectOptions (Cond db r) db r
- Database.Groundhog.Core: instance HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db r
- Database.Groundhog.Core: instance Show ConstructorDef
- Database.Groundhog.Core: instance Show DbTypePrimitive
- Database.Groundhog.Core: instance Show EmbeddedDef
- Database.Groundhog.Core: instance Show EntityDef
- Database.Groundhog.Core: instance Show OtherTypeDef
- Database.Groundhog.Core: instance Show UniqueDef
- Database.Groundhog.Core: newtype OtherTypeDef
- Database.Groundhog.Core: uniqueFields :: UniqueDef -> [(String, DbType)]
- Database.Groundhog.Core: uniqueName :: UniqueDef -> String
- Database.Groundhog.Core: uniqueType :: UniqueDef -> UniqueType
- Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (Field v c a)
- Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (SubField v c a)
- Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, RestrictionHolder v c ~ r') => Expression db r' (AutoKeyField v c)
- Database.Groundhog.Expression: instance [overlap ok] (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u), RestrictionHolder v c ~ r') => Expression db r' (u (UniqueMarker v))
- Database.Groundhog.Expression: instance [overlap ok] NormalizeValue a (isPlain, r) => Normalize HFalse (SubField v c a) (HFalse, r)
- Database.Groundhog.Expression: instance [overlap ok] r ~ (HFalse, a) => Normalize HTrue (SubField v c a) r
- Database.Groundhog.Generic: instance Show PSFieldDef
- Database.Groundhog.Generic.Migration: UniqueDef' :: Maybe String -> UniqueType -> [String] -> UniqueDef'
- Database.Groundhog.Generic.Migration: data UniqueDef'
- Database.Groundhog.Generic.Migration: defaultReferenceActionType :: MigrationPack m -> ReferenceActionType
- Database.Groundhog.Generic.Migration: instance Eq UniqueDef'
- Database.Groundhog.Generic.Migration: instance Ord UniqueDef'
- Database.Groundhog.Generic.Migration: instance Show UniqueDef'
- Database.Groundhog.Generic.Migration: mkColumns :: (String, DbType) -> ([Column] -> [Column])
- Database.Groundhog.Generic.Migration: primaryKeyTypeName :: MigrationPack m -> String
- Database.Groundhog.Generic.Migration: uniqueDefColumns :: UniqueDef' -> [String]
- Database.Groundhog.Generic.Migration: uniqueDefName :: UniqueDef' -> Maybe String
- Database.Groundhog.Generic.Migration: uniqueDefType :: UniqueDef' -> UniqueType
- Database.Groundhog.Instances: instance [overlap ok] (DbDescriptor db, PersistEntity v) => PersistField (KeyForBackend db v)
- Database.Groundhog.Instances: instance [overlap ok] (DbDescriptor db, PersistEntity v) => PrimitivePersistField (KeyForBackend db v)
- Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => Assignable (SubField v c a) a
- Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => FieldLike (SubField v c a) a
- Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => Projection (SubField v c a) a
- Database.Groundhog.Instances: instance [overlap ok] NeverNull (Key v u)
+ Database.Groundhog.Core: data ConstructorDef' str dbType
+ Database.Groundhog.Core: data DbTypePrimitive' str
+ Database.Groundhog.Core: data EmbeddedDef' str dbType
+ Database.Groundhog.Core: data EntityDef' str dbType
+ Database.Groundhog.Core: data UniqueDef' str field
+ Database.Groundhog.Core: instance (Eq str, Eq dbType) => Eq (ConstructorDef' str dbType)
+ Database.Groundhog.Core: instance (Eq str, Eq dbType) => Eq (EmbeddedDef' str dbType)
+ Database.Groundhog.Core: instance (Eq str, Eq dbType) => Eq (EntityDef' str dbType)
+ Database.Groundhog.Core: instance (Eq str, Eq field) => Eq (UniqueDef' str field)
+ Database.Groundhog.Core: instance (Show str, Show dbType) => Show (ConstructorDef' str dbType)
+ Database.Groundhog.Core: instance (Show str, Show dbType) => Show (EmbeddedDef' str dbType)
+ Database.Groundhog.Core: instance (Show str, Show dbType) => Show (EntityDef' str dbType)
+ Database.Groundhog.Core: instance (Show str, Show field) => Show (UniqueDef' str field)
+ Database.Groundhog.Core: instance Eq str => Eq (DbTypePrimitive' str)
+ Database.Groundhog.Core: instance Eq str => Eq (OtherTypeDef' str)
+ Database.Groundhog.Core: instance Show str => Show (DbTypePrimitive' str)
+ Database.Groundhog.Core: instance Show str => Show (OtherTypeDef' str)
+ Database.Groundhog.Core: instance db' ~ db => HasSelectOptions (Cond db r) db' r
+ Database.Groundhog.Core: instance db' ~ db => HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db' r
+ Database.Groundhog.Core: newtype OtherTypeDef' str
+ Database.Groundhog.Core: type ConstructorDef = ConstructorDef' String DbType
+ Database.Groundhog.Core: type DbTypePrimitive = DbTypePrimitive' String
+ Database.Groundhog.Core: type EmbeddedDef = EmbeddedDef' String DbType
+ Database.Groundhog.Core: type EntityDef = EntityDef' String DbType
+ Database.Groundhog.Core: type OtherTypeDef = OtherTypeDef' String
+ Database.Groundhog.Core: type UniqueDef = UniqueDef' String (Either (String, DbType) String)
+ Database.Groundhog.Core: uniqueDefFields :: UniqueDef' str field -> [field]
+ Database.Groundhog.Core: uniqueDefName :: UniqueDef' str field -> Maybe str
+ Database.Groundhog.Core: uniqueDefType :: UniqueDef' str field -> UniqueType
+ Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, DbDescriptor db, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (Field v c a)
+ Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, DbDescriptor db, PersistField a, db' ~ db, RestrictionHolder v c ~ r') => Expression db' r' (SubField db v c a)
+ Database.Groundhog.Expression: instance [overlap ok] (EntityConstr v c, DbDescriptor db, RestrictionHolder v c ~ r') => Expression db r' (AutoKeyField v c)
+ Database.Groundhog.Expression: instance [overlap ok] (PersistEntity v, DbDescriptor db, IsUniqueKey k, k ~ Key v (Unique u), RestrictionHolder v c ~ r') => Expression db r' (u (UniqueMarker v))
+ Database.Groundhog.Expression: instance [overlap ok] NormalizeValue a (isPlain, r) => Normalize HFalse (SubField db v c a) (HFalse, r)
+ Database.Groundhog.Expression: instance [overlap ok] r ~ (HFalse, a) => Normalize HTrue (SubField db v c a) r
+ Database.Groundhog.Generic: failMessageNamed :: String -> [PersistValue] -> String
+ Database.Groundhog.Generic: getAutoKeyType :: DbDescriptor db => proxy db -> DbTypePrimitive
+ Database.Groundhog.Generic: getUniqueFields :: UniqueDef' str (Either field str) -> [field]
+ Database.Groundhog.Generic: instance Show str => Show (PSFieldDef str)
+ Database.Groundhog.Generic.Migration: autoincrementedKeyTypeName :: MigrationPack m -> String
+ Database.Groundhog.Generic.Migration: defaultReferenceOnDelete :: MigrationPack m -> ReferenceActionType
+ Database.Groundhog.Generic.Migration: defaultReferenceOnUpdate :: MigrationPack m -> ReferenceActionType
+ Database.Groundhog.Generic.Migration: getMigrationPack :: SchemaAnalyzer m => m (MigrationPack m)
+ Database.Groundhog.Generic.Migration: showSqlType :: MigrationPack m -> DbTypePrimitive -> String
+ Database.Groundhog.Generic.Migration: type UniqueDefInfo = UniqueDef' String (Either String String)
+ Database.Groundhog.Instances: instance [overlap ok] (DbDescriptor db, PersistEntity v, PersistField v) => PersistField (KeyForBackend db v)
+ Database.Groundhog.Instances: instance [overlap ok] (DbDescriptor db, PersistEntity v, PersistField v) => PrimitivePersistField (KeyForBackend db v)
+ Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => Assignable (SubField db v c a) a
+ Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => FieldLike (SubField db v c a) a
+ Database.Groundhog.Instances: instance [overlap ok] (EntityConstr v c, PersistField a) => Projection (SubField db v c a) a
+ Database.Groundhog.Instances: instance [overlap ok] PrimitivePersistField (Key v u) => NeverNull (Key v u)
- Database.Groundhog: (~>) :: (EntityConstr v c, FieldLike f a, ProjectionRestriction f (RestrictionHolder v c), Embedded a) => f -> Selector a a' -> SubField v c a'
+ Database.Groundhog: (~>) :: (EntityConstr v c, FieldLike f a, DbDescriptor db, Projection' f db (RestrictionHolder v c) a, Embedded a) => f -> Selector a a' -> SubField db v c a'
- Database.Groundhog.Core: (~>) :: (EntityConstr v c, FieldLike f a, ProjectionRestriction f (RestrictionHolder v c), Embedded a) => f -> Selector a a' -> SubField v c a'
+ Database.Groundhog.Core: (~>) :: (EntityConstr v c, FieldLike f a, DbDescriptor db, Projection' f db (RestrictionHolder v c) a, Embedded a) => f -> Selector a a' -> SubField db v c a'
- Database.Groundhog.Core: ConstructorDef :: Int -> String -> Maybe String -> [(String, DbType)] -> [UniqueDef] -> ConstructorDef
+ Database.Groundhog.Core: ConstructorDef :: str -> Maybe str -> [(str, dbType)] -> [UniqueDef' str (Either (str, dbType) str)] -> ConstructorDef' str dbType
- Database.Groundhog.Core: DbBlob :: DbTypePrimitive
+ Database.Groundhog.Core: DbBlob :: DbTypePrimitive' str
- Database.Groundhog.Core: DbBool :: DbTypePrimitive
+ Database.Groundhog.Core: DbBool :: DbTypePrimitive' str
- Database.Groundhog.Core: DbDay :: DbTypePrimitive
+ Database.Groundhog.Core: DbDay :: DbTypePrimitive' str
- Database.Groundhog.Core: DbDayTime :: DbTypePrimitive
+ Database.Groundhog.Core: DbDayTime :: DbTypePrimitive' str
- Database.Groundhog.Core: DbDayTimeZoned :: DbTypePrimitive
+ Database.Groundhog.Core: DbDayTimeZoned :: DbTypePrimitive' str
- Database.Groundhog.Core: DbInt32 :: DbTypePrimitive
+ Database.Groundhog.Core: DbInt32 :: DbTypePrimitive' str
- Database.Groundhog.Core: DbInt64 :: DbTypePrimitive
+ Database.Groundhog.Core: DbInt64 :: DbTypePrimitive' str
- Database.Groundhog.Core: DbOther :: OtherTypeDef -> DbTypePrimitive
+ Database.Groundhog.Core: DbOther :: (OtherTypeDef' str) -> DbTypePrimitive' str
- Database.Groundhog.Core: DbReal :: DbTypePrimitive
+ Database.Groundhog.Core: DbReal :: DbTypePrimitive' str
- Database.Groundhog.Core: DbString :: DbTypePrimitive
+ Database.Groundhog.Core: DbString :: DbTypePrimitive' str
- Database.Groundhog.Core: DbTime :: DbTypePrimitive
+ Database.Groundhog.Core: DbTime :: DbTypePrimitive' str
- Database.Groundhog.Core: EmbeddedDef :: Bool -> [(String, DbType)] -> EmbeddedDef
+ Database.Groundhog.Core: EmbeddedDef :: Bool -> [(str, dbType)] -> EmbeddedDef' str dbType
- Database.Groundhog.Core: EntityDef :: String -> Maybe String -> [DbType] -> [ConstructorDef] -> EntityDef
+ Database.Groundhog.Core: EntityDef :: str -> Maybe str -> [dbType] -> [ConstructorDef' str dbType] -> EntityDef' str dbType
- Database.Groundhog.Core: OtherTypeDef :: ((DbTypePrimitive -> String) -> String) -> OtherTypeDef
+ Database.Groundhog.Core: OtherTypeDef :: ([Either str (DbTypePrimitive' str)]) -> OtherTypeDef' str
- Database.Groundhog.Core: SubField :: FieldChain -> SubField v a
+ Database.Groundhog.Core: SubField :: FieldChain -> SubField db v a
- Database.Groundhog.Core: UniqueDef :: String -> UniqueType -> [(String, DbType)] -> UniqueDef
+ Database.Groundhog.Core: UniqueDef :: Maybe str -> UniqueType -> [field] -> UniqueDef' str field
- Database.Groundhog.Core: class (PersistField v, PurePersistField (AutoKey v)) => PersistEntity v where data family Field v :: ((* -> *) -> *) -> * -> * data family Key v :: * -> * type family AutoKey v type family DefaultKey v type family IsSumType v
+ Database.Groundhog.Core: class (PurePersistField (AutoKey v), PurePersistField (DefaultKey v)) => PersistEntity v where data family Field v :: ((* -> *) -> *) -> * -> * data family Key v :: * -> * type family AutoKey v type family DefaultKey v type family IsSumType v
- Database.Groundhog.Core: class PersistField a => Projection p a | p -> a where type family ProjectionDb p db :: Constraint type family ProjectionRestriction p r :: Constraint
+ Database.Groundhog.Core: class Projection p a | p -> a where type family ProjectionDb p db :: Constraint type family ProjectionRestriction p r :: Constraint
- Database.Groundhog.Core: constrAutoKeyName :: ConstructorDef -> Maybe String
+ Database.Groundhog.Core: constrAutoKeyName :: ConstructorDef' str dbType -> Maybe str
- Database.Groundhog.Core: constrName :: ConstructorDef -> String
+ Database.Groundhog.Core: constrName :: ConstructorDef' str dbType -> str
- Database.Groundhog.Core: constrParams :: ConstructorDef -> [(String, DbType)]
+ Database.Groundhog.Core: constrParams :: ConstructorDef' str dbType -> [(str, dbType)]
- Database.Groundhog.Core: constrUniques :: ConstructorDef -> [UniqueDef]
+ Database.Groundhog.Core: constrUniques :: ConstructorDef' str dbType -> [UniqueDef' str (Either (str, dbType) str)]
- Database.Groundhog.Core: constructors :: EntityDef -> [ConstructorDef]
+ Database.Groundhog.Core: constructors :: EntityDef' str dbType -> [ConstructorDef' str dbType]
- Database.Groundhog.Core: dbType :: PersistField a => a -> DbType
+ Database.Groundhog.Core: dbType :: (PersistField a, DbDescriptor db) => proxy db -> a -> DbType
- Database.Groundhog.Core: entityDef :: PersistEntity v => v -> EntityDef
+ Database.Groundhog.Core: entityDef :: (PersistEntity v, DbDescriptor db) => proxy db -> v -> EntityDef
- Database.Groundhog.Core: entityFieldChain :: PersistEntity v => Field v c a -> FieldChain
+ Database.Groundhog.Core: entityFieldChain :: (PersistEntity v, DbDescriptor db) => proxy db -> Field v c a -> FieldChain
- Database.Groundhog.Core: entityName :: EntityDef -> String
+ Database.Groundhog.Core: entityName :: EntityDef' str dbType -> str
- Database.Groundhog.Core: entitySchema :: EntityDef -> Maybe String
+ Database.Groundhog.Core: entitySchema :: EntityDef' str dbType -> Maybe str
- Database.Groundhog.Core: fieldChain :: FieldLike f a => f -> FieldChain
+ Database.Groundhog.Core: fieldChain :: (FieldLike f a, DbDescriptor db, ProjectionDb f db) => proxy db -> f -> FieldChain
- Database.Groundhog.Core: newtype SubField v (c :: (* -> *) -> *) a
+ Database.Groundhog.Core: newtype SubField db v (c :: (* -> *) -> *) a
- Database.Groundhog.Core: projectionExprs :: (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => p -> [UntypedExpr db r] -> [UntypedExpr db r]
+ Database.Groundhog.Core: projectionExprs :: (Projection p a, DbDescriptor db, ProjectionDb p db, ProjectionRestriction p r) => p -> [UntypedExpr db r] -> [UntypedExpr db r]
- Database.Groundhog.Core: typeParams :: EntityDef -> [DbType]
+ Database.Groundhog.Core: typeParams :: EntityDef' str dbType -> [dbType]
- Database.Groundhog.Generic: PSFieldDef :: String -> Maybe String -> Maybe String -> Maybe String -> Maybe [PSFieldDef] -> Maybe String -> Maybe (Maybe (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType) -> PSFieldDef
+ Database.Groundhog.Generic: PSFieldDef :: str -> Maybe str -> Maybe str -> Maybe str -> Maybe [PSFieldDef str] -> Maybe str -> Maybe (Maybe (Maybe str, str, [str]), Maybe ReferenceActionType, Maybe ReferenceActionType) -> PSFieldDef str
- Database.Groundhog.Generic: applyDbTypeSettings :: PSFieldDef -> DbType -> DbType
+ Database.Groundhog.Generic: applyDbTypeSettings :: PSFieldDef String -> DbType -> DbType
- Database.Groundhog.Generic: data PSFieldDef
+ Database.Groundhog.Generic: data PSFieldDef str
- Database.Groundhog.Generic: findOne :: (Eq c, Show c) => String -> (a -> c) -> (b -> c) -> a -> [b] -> b
+ Database.Groundhog.Generic: findOne :: (Eq x, Show x) => String -> (a -> x) -> x -> [a] -> a
- Database.Groundhog.Generic: psDbFieldName :: PSFieldDef -> Maybe String
+ Database.Groundhog.Generic: psDbFieldName :: PSFieldDef str -> Maybe str
- Database.Groundhog.Generic: psDbTypeName :: PSFieldDef -> Maybe String
+ Database.Groundhog.Generic: psDbTypeName :: PSFieldDef str -> Maybe str
- Database.Groundhog.Generic: psDefaultValue :: PSFieldDef -> Maybe String
+ Database.Groundhog.Generic: psDefaultValue :: PSFieldDef str -> Maybe str
- Database.Groundhog.Generic: psEmbeddedDef :: PSFieldDef -> Maybe [PSFieldDef]
+ Database.Groundhog.Generic: psEmbeddedDef :: PSFieldDef str -> Maybe [PSFieldDef str]
- Database.Groundhog.Generic: psExprName :: PSFieldDef -> Maybe String
+ Database.Groundhog.Generic: psExprName :: PSFieldDef str -> Maybe str
- Database.Groundhog.Generic: psFieldName :: PSFieldDef -> String
+ Database.Groundhog.Generic: psFieldName :: PSFieldDef str -> str
- Database.Groundhog.Generic: psReferenceParent :: PSFieldDef -> Maybe (Maybe (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)
+ Database.Groundhog.Generic: psReferenceParent :: PSFieldDef str -> Maybe (Maybe (Maybe str, str, [str]), Maybe ReferenceActionType, Maybe ReferenceActionType)
- Database.Groundhog.Generic: replaceOne :: (Eq c, Show c) => String -> (a -> c) -> (b -> c) -> (a -> b -> b) -> a -> [b] -> [b]
+ Database.Groundhog.Generic: replaceOne :: (Eq x, Show x) => String -> (a -> x) -> (b -> x) -> (a -> b -> b) -> a -> [b] -> [b]
- Database.Groundhog.Generic.Migration: AddUnique :: UniqueDef' -> AlterTable
+ Database.Groundhog.Generic.Migration: AddUnique :: UniqueDefInfo -> AlterTable
- Database.Groundhog.Generic.Migration: MigrationPack :: (DbTypePrimitive -> DbTypePrimitive -> Bool) -> ((Maybe String, Reference) -> (Maybe String, Reference) -> Bool) -> (UniqueDef' -> UniqueDef' -> Bool) -> (String -> String -> Bool) -> (Maybe String -> String -> [(String, String)] -> m (Bool, [AlterDB])) -> (Maybe String -> String -> [(String, String)] -> m [(Bool, [AlterDB])]) -> (MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)) -> (String -> String) -> String -> String -> Int -> ([UniqueDef'] -> [Reference] -> ([String], [AlterTable])) -> (Column -> String) -> (AlterDB -> SingleMigration) -> ReferenceActionType -> MigrationPack m
+ Database.Groundhog.Generic.Migration: MigrationPack :: (DbTypePrimitive -> DbTypePrimitive -> Bool) -> ((Maybe String, Reference) -> (Maybe String, Reference) -> Bool) -> (UniqueDefInfo -> UniqueDefInfo -> Bool) -> (String -> String -> Bool) -> (Maybe String -> String -> [(String, String)] -> m (Bool, [AlterDB])) -> (Maybe String -> String -> [(String, String)] -> m [(Bool, [AlterDB])]) -> (MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)) -> (String -> String) -> String -> String -> Int -> ([UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])) -> (DbTypePrimitive -> String) -> (Column -> String) -> (AlterDB -> SingleMigration) -> ReferenceActionType -> ReferenceActionType -> MigrationPack m
- Database.Groundhog.Generic.Migration: TableInfo :: [Column] -> [UniqueDef'] -> [(Maybe String, Reference)] -> TableInfo
+ Database.Groundhog.Generic.Migration: TableInfo :: [Column] -> [UniqueDefInfo] -> [(Maybe String, Reference)] -> TableInfo
- Database.Groundhog.Generic.Migration: addUniquesReferences :: MigrationPack m -> [UniqueDef'] -> [Reference] -> ([String], [AlterTable])
+ Database.Groundhog.Generic.Migration: addUniquesReferences :: MigrationPack m -> [UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])
- Database.Groundhog.Generic.Migration: compareUniqs :: MigrationPack m -> UniqueDef' -> UniqueDef' -> Bool
+ Database.Groundhog.Generic.Migration: compareUniqs :: MigrationPack m -> UniqueDefInfo -> UniqueDefInfo -> Bool
- Database.Groundhog.Generic.Migration: defaultMigConstr :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)
+ Database.Groundhog.Generic.Migration: defaultMigConstr :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)
- Database.Groundhog.Generic.Migration: migrateEntity :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> m SingleMigration
+ Database.Groundhog.Generic.Migration: migrateEntity :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> EntityDef -> m SingleMigration
- Database.Groundhog.Generic.Migration: migrateList :: SchemaAnalyzer m => MigrationPack m -> DbType -> m SingleMigration
+ Database.Groundhog.Generic.Migration: migrateList :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> DbType -> m SingleMigration
- Database.Groundhog.Generic.Migration: migrateRecursively :: (Monad m, PersistEntity v) => (String -> m SingleMigration) -> (EntityDef -> m SingleMigration) -> (DbType -> m SingleMigration) -> v -> StateT NamedMigrations m ()
+ Database.Groundhog.Generic.Migration: migrateRecursively :: (PersistBackend m, PersistEntity v) => (String -> m SingleMigration) -> (EntityDef -> m SingleMigration) -> (DbType -> m SingleMigration) -> v -> StateT NamedMigrations m ()
- Database.Groundhog.Generic.Migration: tableUniques :: TableInfo -> [UniqueDef']
+ Database.Groundhog.Generic.Migration: tableUniques :: TableInfo -> [UniqueDefInfo]
- Database.Groundhog.Generic.Sql: flatten :: (Utf8 -> Utf8) -> (String, DbType) -> ([Utf8] -> [Utf8])
+ Database.Groundhog.Generic.Sql: flatten :: StringLike s => (s -> s) -> (String, DbType) -> ([s] -> [s])
- Database.Groundhog.Generic.Sql: renderFields :: (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8
+ Database.Groundhog.Generic.Sql: renderFields :: StringLike s => (s -> s) -> [(String, DbType)] -> s

Files

Database/Groundhog/Core.hs view
@@ -48,16 +48,23 @@   , orderBy   , distinct   -- * Type description-  , DbTypePrimitive(..)+  -- $types+  , DbTypePrimitive'(..)+  , DbTypePrimitive   , DbType(..)-  , EntityDef(..)-  , EmbeddedDef(..)-  , OtherTypeDef(..)-  , ConstructorDef(..)+  , EntityDef'(..)+  , EntityDef+  , EmbeddedDef'(..)+  , EmbeddedDef+  , OtherTypeDef'(..)+  , OtherTypeDef+  , ConstructorDef'(..)+  , ConstructorDef   , Constructor(..)   , EntityConstr(..)   , IsUniqueKey(..)-  , UniqueDef(..)+  , UniqueDef'(..)+  , UniqueDef   , UniqueType(..)   , ReferenceActionType(..)   , ParentTableReference@@ -96,7 +103,7 @@ import GHC.Exts (Constraint)  -- | Only instances of this class can be persisted in a database-class (PersistField v, PurePersistField (AutoKey v)) => PersistEntity v where+class (PurePersistField (AutoKey v), PurePersistField (DefaultKey v)) => PersistEntity v where   -- | This type is used for typesafe manipulation of separate fields of datatype v.   -- Each constructor in 'Field' corresponds to its field in a datatype v.   -- It is parametrised by constructor phantom type and field value type.@@ -110,7 +117,7 @@   -- | It is HFalse for entity with one constructor and HTrue for sum types.   type IsSumType v   -- | Returns a complete description of the type-  entityDef :: v -> EntityDef+  entityDef :: DbDescriptor db => proxy db -> v -> EntityDef   -- | Marshalls value to a list of 'PersistValue' ready for insert to a database   toEntityPersistValues :: PersistBackend m => v -> m ([PersistValue] -> [PersistValue])   -- | Constructs the value from the list of 'PersistValue'@@ -119,7 +126,7 @@   getUniques :: DbDescriptor db => proxy db -> v -> (Int, [(String, [PersistValue] -> [PersistValue])])   -- | Is internally used by FieldLike Field instance   -- We could avoid this function if class FieldLike allowed FieldLike Fields Data or FieldLike (Fields Data). However that would require additional extensions in user-space code-  entityFieldChain :: Field v c a -> FieldChain+  entityFieldChain :: DbDescriptor db => proxy db -> Field v c a -> FieldChain  -- | A holder for Unique constraints data Unique (u :: (* -> *) -> *)@@ -130,10 +137,10 @@ -- | A phantom datatype to make instance head different @u (UniqueMarker v)@ data UniqueMarker v a --- | It allows to store autogenerated keys of one database in another+-- | It allows to store autogenerated keys of one database in another if they have different datatype. data KeyForBackend db v = (DbDescriptor db, PersistEntity v) => KeyForBackend (AutoKeyType db) -{-# DEPRECATED Proxy "use polymophic proxy or another data constructor like [] instead" #-}+{-# DEPRECATED Proxy "use polymorphic proxy or another data constructor like [] instead" #-} data Proxy a  data HFalse@@ -160,11 +167,11 @@ type FieldChain = ((String, DbType), [(String, EmbeddedDef)])  -- | Any data that can be fetched from a database-class PersistField a => Projection p a | p -> a where+class Projection p a | p -> a where   type ProjectionDb p db :: Constraint   type ProjectionRestriction p r :: Constraint   -- | It returns multiple expressions that can be transformed into values which can be selected. Difflist is used for concatenation efficiency.-  projectionExprs :: (ProjectionDb p db, ProjectionRestriction p r) => p -> [UntypedExpr db r] -> [UntypedExpr db r]+  projectionExprs :: (DbDescriptor db, ProjectionDb p db, ProjectionRestriction p r) => p -> [UntypedExpr db r] -> [UntypedExpr db r]   -- | It is like 'fromPersistValues'. However, we cannot use it for projections in all cases. For the 'PersistEntity' instances 'fromPersistValues' expects entity id instead of the entity values.   projectionResult :: PersistBackend m => p -> [PersistValue] -> m (a, [PersistValue]) @@ -176,7 +183,7 @@  -- | This subset of Assignable is for plain database fields. class Assignable f a => FieldLike f a | f -> a where-  fieldChain :: f -> FieldChain+  fieldChain :: (DbDescriptor db, ProjectionDb f db) => proxy db -> f -> FieldChain  class PersistField v => Embedded v where   data Selector v :: * -> *@@ -184,13 +191,15 @@  infixl 5 ~> -- | Accesses fields of the embedded datatypes. For example, @SomeField ==. (\"abc\", \"def\") ||. SomeField ~> Tuple2_0Selector ==. \"def\"@-(~>) :: (EntityConstr v c, FieldLike f a, ProjectionRestriction f (RestrictionHolder v c), Embedded a) => f -> Selector a a' -> SubField v c a'-field ~> sel = case fieldChain field of-  ((name, typ), prefix) -> case typ of-    DbEmbedded emb@(EmbeddedDef _ ts) _ -> SubField (ts !! selectorNum sel, (name, emb):prefix)-    other -> error $ "(~>): cannot get subfield of non-embedded type " ++ show other+(~>) :: (EntityConstr v c, FieldLike f a, DbDescriptor db, Projection' f db (RestrictionHolder v c) a, Embedded a) => f -> Selector a a' -> SubField db v c a'+field ~> sel = subField where+  subField = case fieldChain db field of+    ((name, typ), prefix) -> case typ of+      DbEmbedded emb@(EmbeddedDef _ ts) _ -> SubField (ts !! selectorNum sel, (name, emb):prefix)+      other -> error $ "(~>): cannot get subfield of non-embedded type " ++ show other+  db = (undefined :: SubField db v c a' -> proxy db) subField -newtype SubField v (c :: (* -> *) -> *) a = SubField FieldChain+newtype SubField db v (c :: (* -> *) -> *) a = SubField FieldChain  -- | It can be used in expressions like a regular field. -- For example, @delete (AutoKeyField ==. k)@@@ -219,14 +228,14 @@   type HasDistinct a   getSelectOptions :: a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a) -instance HasSelectOptions (Cond db r) db r where+instance db' ~ db => HasSelectOptions (Cond db r) db' r where   type HasLimit (Cond db r) = HFalse   type HasOffset (Cond db r) = HFalse   type HasOrder (Cond db r) = HFalse   type HasDistinct (Cond db r) = HFalse   getSelectOptions a = SelectOptions a Nothing Nothing [] False [] -instance HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db r where+instance db' ~ db => HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db' r where   type HasLimit (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasLimit   type HasOffset (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasOffset   type HasOrder (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasOrder@@ -345,32 +354,37 @@ -- | Either error messages or migration queries with safety flag and execution order type SingleMigration = Either [String] [(Bool, Int, String)] +-- $types+-- These types describe the mapping between database schema and datatype. They hold table names, columns, constraints, etc. Some types below are parameterized by string type str and dbType. This is done to make them promotable to kind level.+ -- | Describes an ADT.-data EntityDef = EntityDef {+data EntityDef' str dbType = EntityDef {   -- | Entity name. @entityName (entityDef v) == persistName v@-    entityName   :: String+    entityName   :: str   -- | Database schema for the entity table and tables of its constructors-  , entitySchema :: Maybe String+  , entitySchema :: Maybe str   -- | Named types of the instantiated polymorphic type parameters-  , typeParams   :: [DbType]+  , typeParams   :: [dbType]   -- | List of entity constructors definitions-  , constructors :: [ConstructorDef]+  , constructors :: [ConstructorDef' str dbType] } deriving (Show, Eq) +type EntityDef = EntityDef' String DbType+ -- | Describes an entity constructor-data ConstructorDef = ConstructorDef {-  -- | Number of the constructor in the ADT-    constrNum     :: Int+data ConstructorDef' str dbType = ConstructorDef {   -- | Constructor name-  , constrName    :: String+    constrName    :: str   -- | Autokey name if any-  , constrAutoKeyName :: Maybe String+  , constrAutoKeyName :: Maybe str   -- | Parameter names with their named type-  , constrParams  :: [(String, DbType)]+  , constrParams  :: [(str, dbType)]   -- | Uniqueness constraints on the constructor fiels-  , constrUniques :: [UniqueDef]+  , constrUniques :: [UniqueDef' str (Either (str, dbType) str)] } deriving (Show, Eq) +type ConstructorDef = ConstructorDef' String DbType+ -- | Phantom constructors are made instances of this class. This class should be used only by Template Haskell codegen class Constructor c where   -- returning ConstructorDef seems more logical, but it would require the value datatype@@ -391,13 +405,16 @@   -- | Ordinal number of the unique constraint in the list returned by 'constrUniques'   uniqueNum :: uKey -> Int --- | Unique name and list of the field names that form a unique combination-data UniqueDef = UniqueDef {-    uniqueName :: String-  , uniqueType :: UniqueType-  , uniqueFields :: [(String, DbType)]+-- | Unique name and list of the fields that form a unique combination. The fields are parametrized to reuse this datatype both with field and DbType and with column name+data UniqueDef' str field = UniqueDef {+    uniqueDefName :: Maybe str+  , uniqueDefType :: UniqueType+  , uniqueDefFields :: [field] } deriving (Show, Eq) +-- | Field is either a pair of entity field name and its type or an expression which will be used in query as-is.+type UniqueDef = UniqueDef' String (Either (String, DbType) String)+ -- | Defines how to treat the unique set of fields for a datatype data UniqueType = UniqueConstraint                 | UniqueIndex@@ -414,7 +431,7 @@ -- | A DB data type. Naming attempts to reflect the underlying Haskell -- datatypes, eg DbString instead of DbVarchar. Different databases may -- have different representations for these types.-data DbTypePrimitive =+data DbTypePrimitive' str =       DbString     | DbInt32     | DbInt64@@ -425,9 +442,11 @@     | DbDayTime     | DbDayTimeZoned     | DbBlob         -- ^ ByteString-    | DbOther OtherTypeDef-    | DbAutoKey+    | DbOther (OtherTypeDef' str)   deriving (Eq, Show)++type DbTypePrimitive = DbTypePrimitive' String+ data DbType =      -- | type, nullable, default value, reference       DbTypePrimitive DbTypePrimitive Bool (Maybe String) (Maybe ParentTableReference)@@ -441,19 +460,17 @@ -- Reference to a table that is not mapped = (Right (schema, tableName, columns), onDelete, onUpdate) type ParentTableReference = (Either (EntityDef, Maybe String) (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType) --- | Stores name for a database type-newtype OtherTypeDef = OtherTypeDef ((DbTypePrimitive -> String) -> String)--instance Eq OtherTypeDef where-  OtherTypeDef f1 == OtherTypeDef f2 = f1 show == f2 show+-- | Stores a database type. It needs to be formatted by backend. For example, @[Right DbInt64, Left "[]"]@ should become integer[] in PostgreSQL+newtype OtherTypeDef' str = OtherTypeDef ([Either str (DbTypePrimitive' str)]) deriving (Eq, Show) -instance Show OtherTypeDef where-  showsPrec p (OtherTypeDef f) = showParen (p > 10) $ showString "OtherTypeDef " . showsPrec 11 (f show)+type OtherTypeDef = OtherTypeDef' String  -- | The first argument is a flag which defines if the field names should be concatenated with the outer field name (False) or used as is which provides full control over table column names (True). -- Value False should be the default value so that a datatype can be embedded without name conflict concern. The second argument list of field names and field types.-data EmbeddedDef = EmbeddedDef Bool [(String, DbType)] deriving (Eq, Show)+data EmbeddedDef' str dbType = EmbeddedDef Bool [(str, dbType)] deriving (Eq, Show) +type EmbeddedDef = EmbeddedDef' String DbType+ -- | Datatype for incremental building SQL queries newtype Utf8 = Utf8 Builder instance Eq Utf8 where@@ -516,8 +533,8 @@   toPersistValues :: PersistBackend m => a -> m ([PersistValue] -> [PersistValue])   -- | Constructs a value from a 'PersistValue'. For complex datatypes it may query the database   fromPersistValues :: PersistBackend m => [PersistValue] -> m (a, [PersistValue])-  -- | Description of value type-  dbType :: a -> DbType+  -- | Description of value type. It depends on database so that we can have, for example, xml column type in Postgres and varchar type in other databases+  dbType :: DbDescriptor db => proxy db -> a -> DbType  -- | Represents all datatypes that map into a single column. Getting value for that column might require monadic actions to access other tables. class PersistField a => SinglePersistField a where
Database/Groundhog/Expression.hs view
@@ -41,18 +41,23 @@ instance (PersistField a, db' ~ db, r' ~ r) => Expression db' r' (Expr db r a) where
   toExpr (Expr e) = e
 
-instance (EntityConstr v c, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (Field v c a) where
-  toExpr = ExprField . fieldChain
+fieldHelper :: (FieldLike f a, DbDescriptor db, ProjectionDb f db) => f -> UntypedExpr db r
+fieldHelper f = result where
+  result = ExprField $ fieldChain db f
+  db = (undefined :: UntypedExpr db r -> proxy db) result
 
-instance (EntityConstr v c, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (SubField v c a) where
-  toExpr = ExprField . fieldChain
+instance (EntityConstr v c, DbDescriptor db, PersistField a, RestrictionHolder v c ~ r') => Expression db r' (Field v c a) where
+  toExpr = fieldHelper
 
-instance (EntityConstr v c, RestrictionHolder v c ~ r') => Expression db r' (AutoKeyField v c) where
-  toExpr = ExprField . fieldChain
+instance (EntityConstr v c, DbDescriptor db, PersistField a, db' ~ db, RestrictionHolder v c ~ r') => Expression db' r' (SubField db v c a) where
+  toExpr = fieldHelper
 
-instance (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u), RestrictionHolder v c ~ r')
+instance (EntityConstr v c, DbDescriptor db, RestrictionHolder v c ~ r') => Expression db r' (AutoKeyField v c) where
+  toExpr = fieldHelper
+
+instance (PersistEntity v, DbDescriptor db, IsUniqueKey k, k ~ Key v (Unique u), RestrictionHolder v c ~ r')
       => Expression db r' (u (UniqueMarker v)) where
-  toExpr = ExprField . fieldChain
+  toExpr = fieldHelper
 
 instance (db' ~ db, r' ~ r) => Expression db' r' (Cond db r) where
   toExpr = ExprCond
@@ -67,8 +72,8 @@ class Normalize counterpart t r | t -> r
 instance NormalizeValue a (isPlain, r) => Normalize HFalse (Field v c a) (HFalse, r)
 instance r ~ (HFalse, a)               => Normalize HTrue  (Field v c a) r
-instance NormalizeValue a (isPlain, r) => Normalize HFalse (SubField v c a) (HFalse, r)
-instance r ~ (HFalse, a)               => Normalize HTrue  (SubField v c a) r
+instance NormalizeValue a (isPlain, r) => Normalize HFalse (SubField db v c a) (HFalse, r)
+instance r ~ (HFalse, a)               => Normalize HTrue  (SubField db v c a) r
 instance NormalizeValue a (isPlain, r) => Normalize HFalse (Expr db r' a) (HFalse, r)
 instance r ~ (HFalse, a)               => Normalize HTrue  (Expr db r' a) r
 instance NormalizeValue (Key v (Unique u)) (isPlain, r) => Normalize HFalse (u (UniqueMarker v)) (HFalse, r)
@@ -139,7 +144,7 @@   , Unifiable a b)
   => a -> b -> Cond db r
 
-infix 4 ==., <., <=., >., >=.
+infix 4 ==., /=., <., <=., >., >=.
 a ==. b = Compare Eq (toExpr a) (toExpr b)
 a /=. b = Compare Ne (toExpr a) (toExpr b)
 a <.  b = Compare Lt (toExpr a) (toExpr b)
Database/Groundhog/Generic.hs view
@@ -15,6 +15,7 @@   , silentMigrationLogger   , defaultMigrationLogger   , failMessage+  , failMessageNamed   -- * Helpers for running Groundhog actions   , HasConn   , runDb@@ -50,6 +51,8 @@   , haveSameElems   , mapAllRows   , phantomDb+  , getAutoKeyType+  , getUniqueFields   , isSimple   , deleteByKey   ) where@@ -142,8 +145,11 @@        else Left  (concat errors)  failMessage :: PersistField a => a -> [PersistValue] -> String-failMessage a xs = "Invalid list for " ++ persistName a ++ ": " ++ show xs+failMessage a = failMessageNamed (persistName a) +failMessageNamed :: String -> [PersistValue] -> String+failMessageNamed name xs = "Invalid list for " ++ name ++ ": " ++ show xs+ finally :: MonadBaseControl IO m         => m a -- ^ computation to run first         -> m b -- ^ computation to run afterward (even if an exception was raised)@@ -166,19 +172,19 @@         -> m a onException io what = control $ \runInIO -> E.onException (runInIO io) (runInIO what) -data PSFieldDef = PSFieldDef {-    psFieldName :: String -- bar-  , psDbFieldName :: Maybe String -- SQLbar-  , psDbTypeName :: Maybe String -- inet, NUMERIC(5,2), VARCHAR(50)-  , psExprName :: Maybe String -- BarField-  , psEmbeddedDef :: Maybe [PSFieldDef]-  , psDefaultValue :: Maybe String-  , psReferenceParent :: Maybe (Maybe (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)+data PSFieldDef str = PSFieldDef {+    psFieldName :: str -- bar+  , psDbFieldName :: Maybe str -- SQLbar+  , psDbTypeName :: Maybe str -- inet, NUMERIC(5,2), VARCHAR(50)+  , psExprName :: Maybe str -- BarField+  , psEmbeddedDef :: Maybe [PSFieldDef str]+  , psDefaultValue :: Maybe str+  , psReferenceParent :: Maybe (Maybe (Maybe str, str, [str]), Maybe ReferenceActionType, Maybe ReferenceActionType) } deriving Show -applyDbTypeSettings :: PSFieldDef -> DbType -> DbType+applyDbTypeSettings :: PSFieldDef String -> DbType -> DbType applyDbTypeSettings (PSFieldDef _ _ dbTypeName _ Nothing def psRef) typ = case typ of-  DbTypePrimitive t nullable def' ref -> DbTypePrimitive (maybe t (DbOther . OtherTypeDef . const) dbTypeName) nullable (def <|> def') (applyReferencesSettings psRef ref)+  DbTypePrimitive t nullable def' ref -> DbTypePrimitive (maybe t (\typeName -> DbOther $ OtherTypeDef [Left typeName]) dbTypeName) nullable (def <|> def') (applyReferencesSettings psRef ref)   DbEmbedded emb ref -> DbEmbedded emb (applyReferencesSettings psRef ref)   t -> t applyDbTypeSettings (PSFieldDef _ _ _ _ (Just subs) _ psRef) typ = (case typ of@@ -257,18 +263,18 @@                               => PersistValue -> m v fromSinglePersistValueAutoKey x = phantomDb >>= \p -> get (fromPrimitivePersistValue p x :: Key v BackendSpecific) >>= maybe (fail $ "No data with id " ++ show x) return -replaceOne :: (Eq c, Show c) => String -> (a -> c) -> (b -> c) -> (a -> b -> b) -> a -> [b] -> [b]-replaceOne what getter1 getter2 apply a bs = case length (filter ((getter1 a ==) . getter2) bs) of-  1 -> map (\b -> if getter1 a == getter2 b then apply a b else b) bs-  0 -> error $ "Not found " ++ what ++ " with name " ++ show (getter1 a)-  _ -> error $ "Found more than one " ++ what ++ " with name " ++ show (getter1 a)--findOne :: (Eq c, Show c) => String -> (a -> c) -> (b -> c) -> a -> [b] -> b-findOne what getter1 getter2 a bs = case filter ((getter1 a ==) . getter2) bs of-  [b] -> b+replaceOne :: (Eq x, Show x) => String -> (a -> x) -> (b -> x) -> (a -> b -> b) -> a -> [b] -> [b]+replaceOne what getter1 getter2 apply a bs = case filter ((getter1 a ==) . getter2) bs of+  [_] -> map (\b -> if getter1 a == getter2 b then apply a b else b) bs   []  -> error $ "Not found " ++ what ++ " with name " ++ show (getter1 a)   _   -> error $ "Found more than one " ++ what ++ " with name " ++ show (getter1 a) +findOne :: (Eq x, Show x) => String -> (a -> x) -> x -> [a] -> a+findOne what getter x as = case filter ((x ==) . getter) as of+  [a] -> a+  []  -> error $ "Not found " ++ what ++ " with name " ++ show x+  _   -> error $ "Found more than one " ++ what ++ " with name " ++ show x+ -- | Returns only old elements, only new elements, and matched pairs (old, new). -- The new ones exist only in datatype, the old are present only in DB, match is typically by name (the properties of the matched elements may differ). matchElements :: Show a => (a -> b -> Bool) -> [a] -> [b] -> ([a], [b], [(a, b)])@@ -289,6 +295,14 @@  phantomDb :: PersistBackend m => m (proxy (PhantomDb m)) phantomDb = return $ error "phantomDb"++getAutoKeyType :: DbDescriptor db => proxy db -> DbTypePrimitive+getAutoKeyType proxy = case dbType proxy ((undefined :: proxy db -> AutoKeyType db) proxy) of+  DbTypePrimitive t _ _ _ -> t+  t -> error $ "autoKeyType: unexpected key type " ++ show t++getUniqueFields :: UniqueDef' str (Either field str) -> [field]+getUniqueFields (UniqueDef _ _ uFields) = map (either id (error "A unique key may not contain expressions")) uFields  isSimple :: [ConstructorDef] -> Bool isSimple [_] = True
Database/Groundhog/Generic/Migration.hs view
@@ -2,15 +2,14 @@ -- | This helper module is intended for use by the backend creators module Database.Groundhog.Generic.Migration   ( Column(..)-  , UniqueDef'(..)   , Reference(..)   , TableInfo(..)+  , UniqueDefInfo   , AlterColumn(..)   , AlterTable(..)   , AlterDB(..)   , MigrationPack(..)   , SchemaAnalyzer(..)-  , mkColumns   , migrateRecursively   , migrateSchema   , migrateEntity@@ -23,13 +22,14 @@  import Database.Groundhog.Core import Database.Groundhog.Generic-import Database.Groundhog.Generic.Sql (mainTableName, tableName)+import Database.Groundhog.Generic.Sql (flatten, mainTableName, tableName)  import Control.Applicative (Applicative) import Control.Arrow ((***), (&&&)) import Control.Monad (liftM, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT (..), gets, modify)+import Data.Either (lefts) import Data.Function (on) import qualified Data.Map as Map import Data.List (group, intercalate)@@ -50,9 +50,11 @@   , referenceOnUpdate :: Maybe ReferenceActionType   } deriving Show +-- | Either column name or expression+type UniqueDefInfo = UniqueDef' String (Either String String) data TableInfo = TableInfo {     tableColumns :: [Column]-  , tableUniques :: [UniqueDef']+  , tableUniques :: [UniqueDefInfo]     -- | constraint name and reference   , tableReferences :: [(Maybe String, Reference)] } deriving Show@@ -60,7 +62,7 @@ data AlterColumn = Type DbTypePrimitive | IsNull | NotNull                  | Default String | NoDefault | UpdateValue String deriving Show -data AlterTable = AddUnique UniqueDef'+data AlterTable = AddUnique UniqueDefInfo                 | DropConstraint String                 | DropIndex String                 | AddReference Reference@@ -86,41 +88,37 @@              | CreateSchema String Bool   deriving Show -data UniqueDef' = UniqueDef' {-    uniqueDefName :: Maybe String-  , uniqueDefType :: UniqueType-  , uniqueDefColumns :: [String]-} deriving (Show, Eq, Ord)- data MigrationPack m = MigrationPack {     compareTypes :: DbTypePrimitive -> DbTypePrimitive -> Bool   , compareRefs :: (Maybe String, Reference) -> (Maybe String, Reference) -> Bool-  , compareUniqs :: UniqueDef' -> UniqueDef' -> Bool+  , compareUniqs :: UniqueDefInfo -> UniqueDefInfo -> Bool   , compareDefaults :: String -> String -> Bool   , migTriggerOnDelete :: Maybe String -> String -> [(String, String)] -> m (Bool, [AlterDB])   , migTriggerOnUpdate :: Maybe String -> String -> [(String, String)] -> m [(Bool, [AlterDB])]   , migConstr :: MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)   , escape :: String -> String-  , primaryKeyTypeName :: String+  , autoincrementedKeyTypeName :: String   , mainTableId :: String   , defaultPriority :: Int   -- | Sql pieces for the create table statement that add constraints and alterations for running after the table is created-  , addUniquesReferences :: [UniqueDef'] -> [Reference] -> ([String], [AlterTable])+  , addUniquesReferences :: [UniqueDefInfo] -> [Reference] -> ([String], [AlterTable])+  , showSqlType :: DbTypePrimitive -> String   , showColumn :: Column -> String   , showAlterDb :: AlterDB -> SingleMigration-  , defaultReferenceActionType :: ReferenceActionType+  , defaultReferenceOnDelete :: ReferenceActionType+  , defaultReferenceOnUpdate :: ReferenceActionType } -mkColumns :: (String, DbType) -> ([Column] -> [Column])-mkColumns = go "" where+mkColumns :: DbTypePrimitive -> (String, DbType) -> ([Column] -> [Column])+mkColumns autoKeyType field = go "" field where   go prefix (fname, typ) acc = (case typ of     DbEmbedded (EmbeddedDef flag ts) _ -> foldr (go prefix') acc ts where prefix' = if flag then "" else prefix ++ fname ++ [delim]-    DbList _ _ -> Column fullName False DbAutoKey Nothing : acc+    DbList _ _ -> Column fullName False autoKeyType Nothing : acc     DbTypePrimitive t nullable def _ -> Column fullName nullable t def : acc) where       fullName = prefix ++ fname -mkReferences :: (String, DbType) -> [Reference]-mkReferences = concat . traverseDbType f where+mkReferences :: DbTypePrimitive -> (String, DbType) -> [Reference]+mkReferences autoKeyType field = concat $ traverseDbType f field where   f (DbEmbedded _ ref) cols = maybe [] (return . mkReference cols) ref   f (DbList lName _) cols = [mkReference cols (Right (Nothing, lName, ["id"]), Nothing, Nothing)]   f (DbTypePrimitive _ _ _ ref) cols = maybe [] (return . mkReference cols) ref@@ -134,16 +132,16 @@       cDef = case constructors e of         [cDef'] -> cDef'         _       -> error "mkReferences: datatype with unique key cannot have more than one constructor"-      UniqueDef _ _ uFields = findOne "unique" id uniqueName uName $ constrUniques cDef-      fields = map (\(fName, _) -> findOne "field" id fst fName $ constrParams cDef) uFields-      parentColumns = foldr mkColumns [] fields+      uDef = findOne "unique" uniqueDefName (Just uName) $ constrUniques cDef+      fields = map (\(fName, _) -> findOne "field" fst fName $ constrParams cDef) $ getUniqueFields uDef+      parentColumns = foldr (mkColumns autoKeyType) [] fields     Right (sch, table, parentColumns) -> Reference sch table (zipWith' (,) cols parentColumns) onDel onUpd   zipWith' _ [] [] = []   zipWith' g (x:xs) (y:ys) = g x y: zipWith' g xs ys   zipWith' _ _ _ = error "mkReferences: the lists have different length"  traverseDbType :: (DbType -> [String] -> a) -> (String, DbType) -> [a]-traverseDbType f (columnName, dbtype) = snd $ go "" (columnName, dbtype) where+traverseDbType f field = snd $ go "" field where   go prefix (fname, typ) = (case typ of     t@(DbEmbedded (EmbeddedDef flag ts) _) -> (cols, f t cols : xs) where       prefix' = if flag then "" else prefix ++ fname ++ [delim]@@ -156,27 +154,30 @@ -- | Create migration for a given entity and all entities it depends on. -- The stateful Map is used to avoid duplicate migrations when an entity type -- occurs several times in a datatype-migrateRecursively :: (Monad m, PersistEntity v) => +migrateRecursively :: (PersistBackend m, PersistEntity v) =>       (String    -> m SingleMigration)    -- ^ migrate schema   -> (EntityDef -> m SingleMigration) -- ^ migrate entity   -> (DbType    -> m SingleMigration) -- ^ migrate list   -> v                                -- ^ initial entity   -> StateT NamedMigrations m ()-migrateRecursively migS migE migL = go . dbType where+migrateRecursively migS migE migL v = result where+  result = migEntity $ entityDef proxy v+  proxy = (undefined :: t m a -> proxy (PhantomDb m)) result   go l@(DbList lName t) = f ("list " ++ lName) (migL l) (go t)   go (DbEmbedded (EmbeddedDef _ ts) ref) = mapM_ (go . snd) ts >> migRef ref   go (DbTypePrimitive _ _ _ ref) = migRef ref   allSubtypes = map snd . concatMap constrParams . constructors   migRef ref = case ref of-    Just (Left (e, _), _, _) -> do-      case entitySchema e of-        Just name -> f ("schema " ++ name) (migS name) (return ())-        Nothing -> return ()-      f ("entity " ++ mainTableName id e) (migE e) (mapM_ go (allSubtypes e))+    Just (Left (e, _), _, _) -> migEntity e     _ -> return ()+  migEntity e = do+    case entitySchema e of+      Just name -> f ("schema " ++ name) (migS name) (return ())+      Nothing -> return ()+    f ("entity " ++ mainTableName id e) (migE e) (mapM_ go (allSubtypes e))   f name mig cont = do-    v <- gets (Map.lookup name)-    when (v == Nothing) $+    a <- gets (Map.lookup name)+    when (a == Nothing) $       lift mig >>= modify . Map.insert name >> cont  migrateSchema :: SchemaAnalyzer m => MigrationPack m -> String -> m SingleMigration@@ -186,12 +187,13 @@     then Right []     else showAlterDb $ CreateSchema schema False -migrateEntity :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> m SingleMigration+migrateEntity :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> EntityDef -> m SingleMigration migrateEntity m@MigrationPack{..} e = do+  autoKeyType <- fmap getAutoKeyType phantomDb   let name = entityName e       constrs = constructors e-      mainTableQuery = "CREATE TABLE " ++ escape name ++ " (" ++ mainTableId ++ " " ++ primaryKeyTypeName ++ ", discr INTEGER NOT NULL)"-      expectedMainStructure = TableInfo [Column "id" False DbAutoKey Nothing, Column "discr" False DbInt32 Nothing] [UniqueDef' Nothing (UniquePrimary True) ["id"]] []+      mainTableQuery = "CREATE TABLE " ++ escape name ++ " (" ++ mainTableId ++ " " ++ autoincrementedKeyTypeName ++ ", discr INTEGER NOT NULL)"+      expectedMainStructure = TableInfo [Column "id" False autoKeyType Nothing, Column "discr" False DbInt32 Nothing] [UniqueDef Nothing (UniquePrimary True) [Left "id"]] []    if isSimple constrs     then do@@ -223,16 +225,17 @@                in mergeMigrations $ Right updateDiscriminators: map snd res           else Left ["Unexpected structure of main table for Datatype: " ++ name ++ ". Table info: " ++ show mainStructure'] -migrateList :: SchemaAnalyzer m => MigrationPack m -> DbType -> m SingleMigration+migrateList :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> DbType -> m SingleMigration migrateList m@MigrationPack{..} (DbList mainName t) = do+  autoKeyType <- fmap getAutoKeyType phantomDb   let valuesName = mainName ++ delim : "values"-      (valueCols, valueRefs) = (($ []) . mkColumns) &&& mkReferences $ ("value", t)+      (valueCols, valueRefs) = (($ []) . mkColumns autoKeyType) &&& mkReferences autoKeyType $ ("value", t)       refs' = Reference Nothing mainName [("id", "id")] (Just Cascade) Nothing : valueRefs-      expectedMainStructure = TableInfo [Column "id" False DbAutoKey Nothing] [UniqueDef' Nothing (UniquePrimary True) ["id"]] []-      mainQuery = "CREATE TABLE " ++ escape mainName ++ " (id " ++ primaryKeyTypeName ++ ")"+      expectedMainStructure = TableInfo [Column "id" False autoKeyType Nothing] [UniqueDef Nothing (UniquePrimary True) [Left "id"]] []+      mainQuery = "CREATE TABLE " ++ escape mainName ++ " (id " ++ autoincrementedKeyTypeName ++ ")"       (addInCreate, addInAlters) = addUniquesReferences [] refs'       expectedValuesStructure = TableInfo valueColumns [] (map (\x -> (Nothing, x)) refs')-      valueColumns = Column "id" False DbAutoKey Nothing : Column "ord" False DbInt32 Nothing : valueCols+      valueColumns = Column "id" False autoKeyType Nothing : Column "ord" False DbInt32 Nothing : valueCols       valuesQuery = "CREATE TABLE " ++ escape valuesName ++ " (" ++ intercalate ", " (map showColumn valueColumns ++ addInCreate) ++ ")"   -- TODO: handle case when outer entity has a schema   mainStructure <- analyzeTable Nothing mainName@@ -262,7 +265,7 @@     (oldOnlyColumns, newOnlyColumns, commonColumns) = matchElements ((==) `on` colName) oldColumns newColumns     (oldOnlyUniques, newOnlyUniques, commonUniques) = matchElements compareUniqs oldUniques newUniques     (oldOnlyRefs, newOnlyRefs, _) = matchElements compareRefs oldRefs newRefs-    primaryColumns = concatMap uniqueDefColumns $ filter ((== UniquePrimary True) . uniqueDefType) oldUniques+    primaryColumns = lefts $ concatMap uniqueDefFields $ filter ((== UniquePrimary True) . uniqueDefType) oldUniques      colAlters = mapMaybe (\(a, b) -> mkAlterColumn b $ migrateColumn m a b) (filter ((`notElem` primaryColumns) . colName . fst) commonColumns)     mkAlterColumn col alters = if null alters then Nothing else Just $ AlterColumn col alters@@ -292,24 +295,25 @@     _ -> [maybe NoDefault Default def2]  -- from database, from datatype-migrateUniq :: UniqueDef' -> UniqueDef' -> [AlterTable]-migrateUniq u1@(UniqueDef' _ _ cols1) u2@(UniqueDef' _ _ cols2) = if haveSameElems (==) cols1 cols2+migrateUniq :: UniqueDefInfo -> UniqueDefInfo -> [AlterTable]+migrateUniq u1@(UniqueDef _ _ cols1) u2@(UniqueDef _ _ cols2) = if haveSameElems (==) cols1 cols2   then []   else [dropUnique u1, AddUnique u2] -dropUnique :: UniqueDef' -> AlterTable-dropUnique (UniqueDef' name typ _) = (case typ of+dropUnique :: UniqueDefInfo -> AlterTable+dropUnique (UniqueDef name typ _) = (case typ of   UniqueConstraint -> DropConstraint name'   UniqueIndex -> DropIndex name'   UniquePrimary _ -> DropConstraint name') where   name' = fromMaybe (error $ "dropUnique: constraint which should be dropped does not have a name") name   -defaultMigConstr :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)-defaultMigConstr migPack@MigrationPack{..} e constr = do+defaultMigConstr :: (SchemaAnalyzer m, PersistBackend m) => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)+defaultMigConstr m@MigrationPack{..} e constr = do   let simple = isSimple $ constructors e       name = entityName e       schema = entitySchema e       cName = if simple then name else name ++ [delim] ++ constrName constr+  autoKeyType <- fmap getAutoKeyType phantomDb   tableStructure <- analyzeTable schema cName   let dels = concatMap (mkDeletes escape) $ constrParams constr   (triggerExisted, delTrigger) <- migTriggerOnDelete schema cName dels@@ -317,16 +321,16 @@      let (expectedTableStructure, (addTable, addInAlters)) = (case constrAutoKeyName constr of         Nothing -> (TableInfo columns uniques (mkRefs refs), f [] columns uniques refs)-        Just keyName -> let keyColumn = Column keyName False DbAutoKey Nothing +        Just keyName -> let keyColumn = Column keyName False autoKeyType Nothing                          in if simple-          then (TableInfo (keyColumn:columns) (uniques ++ [UniqueDef' Nothing (UniquePrimary True) [keyName]]) (mkRefs refs)-               , f [escape keyName ++ " " ++ primaryKeyTypeName] columns uniques refs)+          then (TableInfo (keyColumn:columns) (uniques ++ [UniqueDef Nothing (UniquePrimary True) [Left keyName]]) (mkRefs refs)+               , f [escape keyName ++ " " ++ autoincrementedKeyTypeName] columns uniques refs)           else let columns' = keyColumn:columns                    refs' = refs ++ [Reference schema name [(keyName, mainTableId)] (Just Cascade) Nothing]-                   uniques' = uniques ++ [UniqueDef' Nothing UniqueConstraint [keyName]]+                   uniques' = uniques ++ [UniqueDef Nothing UniqueConstraint [Left keyName]]                in (TableInfo columns' uniques' (mkRefs refs'), f [] columns' uniques' refs')) where-        (columns, refs) = foldr mkColumns [] &&& concatMap mkReferences $ constrParams constr-        uniques = map (\(UniqueDef uName uType cols) -> UniqueDef' (Just uName) uType (map colName $ foldr mkColumns [] cols)) $ constrUniques constr+        (columns, refs) = foldr (mkColumns autoKeyType) [] &&& concatMap (mkReferences autoKeyType) $ constrParams constr+        uniques = map (\u -> u {uniqueDefFields = concatMap (either (map Left . ($ []) . flatten id) (return . Right)) $ uniqueDefFields u}) $ constrUniques constr         f autoKey cols uniqs refs' = (addTable', addInAlters') where           (addInCreate, addInAlters') = addUniquesReferences uniqs refs'           items = autoKey ++ map showColumn cols ++ addInCreate@@ -338,7 +342,7 @@           rest = AlterTable schema cName addTable expectedTableStructure expectedTableStructure addInAlters           in ([], False, [AddTable addTable, rest])         Just oldTableStructure -> let-          alters = getAlters migPack oldTableStructure expectedTableStructure+          alters = getAlters m oldTableStructure expectedTableStructure           alterTable = if null alters             then []             else [AlterTable schema cName addTable oldTableStructure expectedTableStructure alters]@@ -392,3 +396,4 @@   analyzeFunction :: Maybe String -- ^ Schema name                   -> String -- ^ Function name                   -> m (Maybe String)+  getMigrationPack :: m (MigrationPack m)
Database/Groundhog/Generic/PersistBackendHelpers.hs view
@@ -27,15 +27,16 @@ import Database.Groundhog.Generic.Sql  import Control.Monad (liftM, forM, (>=>))-import Data.Maybe (catMaybes, fromJust)+import Data.Either (rights)+import Data.Maybe (catMaybes, fromJust, mapMaybe) import Data.Monoid  {-# INLINABLE get #-} get :: forall m v . (PersistBackend m, PersistEntity v, PrimitivePersistField (Key v BackendSpecific))     => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Key v BackendSpecific -> m (Maybe v) get RenderConfig{..} queryFunc (k :: Key v BackendSpecific) = do-  let e = entityDef (undefined :: v)-  let proxy = undefined :: proxy (PhantomDb m)+  let e = entityDef proxy (undefined :: v)+      proxy = undefined :: proxy (PhantomDb m)   if isSimple (constructors e)     then do       let constr = head $ constructors e@@ -66,7 +67,7 @@ select conf@RenderConfig{..} queryFunc preColumns noLimit options = doSelectQuery where   SelectOptions cond limit offset ords dist _ = getSelectOptions options -  e = entityDef (undefined :: v)+  e = entityDef proxy (undefined :: v)   proxy = undefined :: proxy (PhantomDb m)   orders = renderOrders conf ords   lim = case (limit, offset) of@@ -96,7 +97,7 @@         let fields = fromJust (constrId esc constr) <> fromChar ',' <> renderFields esc (constrParams constr)         let query = "SELECT " <> fields <> " FROM " <> tableName esc e constr         queryFunc query [] $ mapAllRows $ mkEntity proxy cNum-  e = entityDef (undefined :: v)+  e = entityDef proxy (undefined :: v)   proxy = undefined :: proxy (PhantomDb m)  getBy :: forall m v u . (PersistBackend m, PersistEntity v, IsUniqueKey (Key v (Unique u)))@@ -106,9 +107,10 @@       -> m (Maybe v) getBy conf@RenderConfig{..} queryFunc (k :: Key v (Unique u)) = do   uniques <- toPersistValues k-  let e = entityDef (undefined :: v)+  let e = entityDef proxy (undefined :: v)+      proxy = undefined :: proxy (PhantomDb m)       u = (undefined :: Key v (Unique u) -> u (UniqueMarker v)) k-      uFields = renderChain conf (fieldChain u) []+      uFields = renderChain conf (fieldChain proxy u) []       RenderS cond vals = intercalateS " AND " $ mkUniqueCond uFields uniques       constr = head $ constructors e       fields = renderFields esc (constrParams constr)@@ -122,7 +124,7 @@         => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> (opts -> RenderS db r) -> Utf8 -> p -> opts -> m [a'] project conf@RenderConfig{..} queryFunc preColumns noLimit p options = doSelectQuery where   SelectOptions cond limit offset ords dist _ = getSelectOptions options-  e = entityDef (undefined :: v)+  e = entityDef proxy (undefined :: v)   proxy = undefined :: proxy (PhantomDb m)   orders = renderOrders conf ords   lim = case (limit, offset) of@@ -142,7 +144,7 @@ count :: forall m db r v c . (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c)       => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Cond db r -> m Int count conf@RenderConfig{..} queryFunc cond = do-  let e = entityDef (undefined :: v)+  let e = entityDef proxy (undefined :: v)       proxy = undefined :: proxy (PhantomDb m)       cond' = renderCond conf cond       constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)@@ -159,7 +161,7 @@         -> Key v BackendSpecific -> v -> m () replace RenderConfig{..} queryFunc execFunc insertIntoConstructorTable k v = do   vals <- toEntityPersistValues' v-  let e = entityDef v+  let e = entityDef proxy v       proxy = undefined :: proxy (PhantomDb m)       constructorNum = fromPrimitivePersistValue proxy (head vals)       constr = constructors e !! constructorNum@@ -201,8 +203,9 @@ replaceBy conf@RenderConfig{..} execFunc u v = do   uniques <- toPersistValues $ (extractUnique v `asTypeOf` ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u))   vals <- toEntityPersistValues' v-  let e = entityDef (undefined :: v)-      uFields = renderChain conf (fieldChain u) []+  let e = entityDef proxy (undefined :: v)+      proxy = undefined :: proxy (PhantomDb m)+      uFields = renderChain conf (fieldChain proxy u) []       RenderS cond condVals = intercalateS " AND " $ mkUniqueCond uFields uniques       constr = head $ constructors e       RenderS upds updsVals = commasJoin $ zipWith f fields $ tail vals where@@ -214,7 +217,8 @@ update :: forall m db r v c . (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c)        => RenderConfig -> (Utf8 -> [PersistValue] -> m ()) -> [Update db r] -> Cond db r -> m () update conf@RenderConfig{..} execFunc upds cond = do-  let e = entityDef (undefined :: v)+  let e = entityDef proxy (undefined :: v)+      proxy = undefined :: proxy (PhantomDb m)   case renderUpdates conf upds of     Just upds' -> do       let cond' = renderCond conf cond@@ -227,7 +231,8 @@ delete :: forall m db r v c . (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c)        => RenderConfig -> (Utf8 -> [PersistValue] -> m ()) -> Cond db r -> m () delete conf@RenderConfig{..} execFunc cond = execFunc query (maybe [] (($ []) . getValues) cond') where-  e = entityDef (undefined :: v)+  e = entityDef proxy (undefined :: v)+  proxy = undefined :: proxy (PhantomDb m)   constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)   cond' = renderCond conf cond   whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'@@ -242,15 +247,17 @@             -> Bool -- ^ allow multiple duplication of uniques with nulls             -> v -> m (Either (AutoKey v) (AutoKey v)) insertByAll RenderConfig{..} queryFunc manyNulls v = do-  let e = entityDef v+  let e = entityDef proxy v       proxy = undefined :: proxy (PhantomDb m)       (constructorNum, uniques) = getUniques proxy v       constr = constructors e !! constructorNum       uniqueDefs = constrUniques constr        query = "SELECT " <> maybe "1" id (constrId esc constr) <> " FROM " <> tableName esc e constr <> " WHERE " <> cond-      conds = catMaybes $ zipWith (\u (_, uVals) -> checkNulls uVals $ intercalateS " AND " $ mkUniqueCond (f u) uVals) uniqueDefs uniques where-        f = foldr (flatten esc) [] . uniqueFields+      conds = catMaybes $ zipWith (\uFields (_, uVals) -> checkNulls uVals $ intercalateS " AND " $ mkUniqueCond uFields uVals) (mapMaybe f uniqueDefs) uniques where+        f u@(UniqueDef _ _ uFields) = if null $ rights uFields+          then Just $ foldr (flatten esc) [] $ getUniqueFields u+          else Nothing       -- skip condition if any value is NULL. It allows to insert many values with duplicate unique key       checkNulls uVals x = if manyNulls && any (== PersistNull) (uVals []) then Nothing else Just x       RenderS cond vals = intercalateS " OR " conds@@ -265,7 +272,7 @@ deleteBy :: forall m v . (PersistBackend m, PersistEntity v, PrimitivePersistField (Key v BackendSpecific))             => RenderConfig -> (Utf8 -> [PersistValue] -> m ()) -> Key v BackendSpecific -> m () deleteBy RenderConfig{..} execFunc k = execFunc query [toPrimitivePersistValue proxy k] where-  e = entityDef ((undefined :: Key v u -> v) k)+  e = entityDef proxy ((undefined :: Key v u -> v) k)   proxy = undefined :: proxy (PhantomDb m)   constr = head $ constructors e   idName = if isSimple (constructors e)@@ -276,15 +283,15 @@  deleteAll :: forall m v . (PersistBackend m, PersistEntity v)           => RenderConfig -> (Utf8 -> [PersistValue] -> m ()) -> v -> m ()-deleteAll RenderConfig{..} execFunc (_ :: v) = do-  let e = entityDef (undefined :: v)-      query = "DELETE FROM " <> mainTableName esc e-  execFunc query []+deleteAll RenderConfig{..} execFunc (_ :: v) = execFunc query [] where+  e = entityDef proxy (undefined :: v)+  proxy = undefined :: proxy (PhantomDb m)+  query = "DELETE FROM " <> mainTableName esc e  countAll :: forall m v . (PersistBackend m, PersistEntity v)          => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> v -> m Int countAll RenderConfig{..} queryFunc (_ :: v) = do-  let e = entityDef (undefined :: v)+  let e = entityDef proxy (undefined :: v)       proxy = undefined :: proxy (PhantomDb m)       query = "SELECT COUNT(*) FROM " <> mainTableName esc e   x <- queryFunc query [] id@@ -300,9 +307,9 @@          -> u (UniqueMarker v) -> v -> m (Either (AutoKey v) (AutoKey v)) insertBy conf@RenderConfig{..} queryFunc manyNulls u v = do   uniques <- toPersistValues $ (extractUnique v `asTypeOf` ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u))-  let e = entityDef v+  let e = entityDef proxy v       proxy = undefined :: proxy (PhantomDb m)-      uFields = renderChain conf (fieldChain u) []+      uFields = renderChain conf (fieldChain proxy u) []       RenderS cond vals = intercalateS " AND " $ mkUniqueCond uFields uniques       -- skip condition if any value is NULL. It allows to insert many values with duplicate unique key       checkNulls uVals = manyNulls && any (== PersistNull) (uVals [])
Database/Groundhog/Generic/Sql.hs view
@@ -263,11 +263,13 @@ -- Returns string with comma separated escaped fields like "name,age" -- If there are other columns before renderFields result, do not put comma because the result might be an empty string. This happens when the fields have no columns like (). -- One of the solutions is to add one more field with datatype that is known to have columns, eg renderFields id (("id", namedType (0 :: Int64)) : constrParams constr)-renderFields :: (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8+{-# SPECIALIZE renderFields :: (Utf8 -> Utf8) -> [(String, DbType)] -> Utf8 #-}+renderFields :: StringLike s => (s -> s) -> [(String, DbType)] -> s renderFields escape = commasJoin . foldr (flatten escape) []  -- TODO: merge code of flatten and flattenP-flatten :: (Utf8 -> Utf8) -> (String, DbType) -> ([Utf8] -> [Utf8])+{-# SPECIALIZE flatten :: (Utf8 -> Utf8) -> (String, DbType) -> ([Utf8] -> [Utf8]) #-}+flatten :: StringLike s => (s -> s) -> (String, DbType) -> ([s] -> [s]) flatten escape (fname, typ) acc = go typ where   go typ' = case typ' of     DbEmbedded emb _ -> handleEmb emb@@ -276,7 +278,8 @@   handleEmb (EmbeddedDef False ts) = foldr (flattenP escape fullName) acc ts   handleEmb (EmbeddedDef True  ts) = foldr (flatten escape) acc ts -flattenP :: (Utf8 -> Utf8) -> Utf8 -> (String, DbType) -> ([Utf8] -> [Utf8])+{-# SPECIALIZE flattenP :: (Utf8 -> Utf8) -> Utf8 -> (String, DbType) -> ([Utf8] -> [Utf8]) #-}+flattenP :: StringLike s => (s -> s) -> s -> (String, DbType) -> ([s] -> [s]) flattenP escape prefix (fname, typ) acc = go typ where   go typ' = case typ' of     DbEmbedded emb _ -> handleEmb emb
Database/Groundhog/Instances.hs view
@@ -3,7 +3,7 @@ module Database.Groundhog.Instances (Selector(..)) where  import Database.Groundhog.Core-import Database.Groundhog.Generic (primToPersistValue, primFromPersistValue, primToPurePersistValues, primFromPurePersistValues, primToSinglePersistValue, primFromSinglePersistValue, phantomDb)+import Database.Groundhog.Generic (primToPersistValue, primFromPersistValue, primToPurePersistValues, primFromPurePersistValues, primToSinglePersistValue, primFromSinglePersistValue, phantomDb, getUniqueFields)  import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -214,7 +214,7 @@   fromPrimitivePersistValue _ PersistNull = Nothing   fromPrimitivePersistValue p x = Just $ fromPrimitivePersistValue p x -instance (DbDescriptor db, PersistEntity v) => PrimitivePersistField (KeyForBackend db v) where+instance (DbDescriptor db, PersistEntity v, PersistField v) => PrimitivePersistField (KeyForBackend db v) where   toPrimitivePersistValue p (KeyForBackend a) = toPrimitivePersistValue p a   fromPrimitivePersistValue p x = KeyForBackend (fromPrimitivePersistValue p x) @@ -236,7 +236,7 @@ instance NeverNull Day instance NeverNull TimeOfDay instance NeverNull UTCTime-instance NeverNull (Key v u)+instance PrimitivePersistField (Key v u) => NeverNull (Key v u) instance NeverNull (KeyForBackend db v)  readHelper :: Read a => PersistValue -> String -> a@@ -253,25 +253,25 @@   persistName _ = "ByteString"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbBlob False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbBlob False Nothing Nothing  instance PersistField String where   persistName _ = "String"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbString False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbString False Nothing Nothing  instance PersistField T.Text where   persistName _ = "Text"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbString False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbString False Nothing Nothing  instance PersistField Int where   persistName _ = "Int"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType a = DbTypePrimitive (if finiteBitSize a == 32 then DbInt32 else DbInt64) False Nothing Nothing where+  dbType _ a = DbTypePrimitive (if finiteBitSize a == 32 then DbInt32 else DbInt64) False Nothing Nothing where #if !MIN_VERSION_base(4, 7, 0)     finiteBitSize = bitSize #endif@@ -281,85 +281,85 @@   persistName _ = "Int8"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt32 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt32 False Nothing Nothing  instance PersistField Int16 where   persistName _ = "Int16"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt32 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt32 False Nothing Nothing  instance PersistField Int32 where   persistName _ = "Int32"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt32 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt32 False Nothing Nothing  instance PersistField Int64 where   persistName _ = "Int64"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt64 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt64 False Nothing Nothing  instance PersistField Word8 where   persistName _ = "Word8"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt32 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt32 False Nothing Nothing  instance PersistField Word16 where   persistName _ = "Word16"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt32 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt32 False Nothing Nothing  instance PersistField Word32 where   persistName _ = "Word32"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt64 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt64 False Nothing Nothing  instance PersistField Word64 where   persistName _ = "Word64"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbInt64 False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbInt64 False Nothing Nothing  instance PersistField Double where   persistName _ = "Double"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbReal False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbReal False Nothing Nothing  instance PersistField Bool where   persistName _ = "Bool"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbBool False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbBool False Nothing Nothing  instance PersistField Day where   persistName _ = "Day"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbDay False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbDay False Nothing Nothing  instance PersistField TimeOfDay where   persistName _ = "TimeOfDay"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbTime False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbTime False Nothing Nothing  instance PersistField UTCTime where   persistName _ = "UTCTime"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbDayTime False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbDayTime False Nothing Nothing  instance PersistField ZonedTime where   persistName _ = "ZonedTime"   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType _ = DbTypePrimitive DbDayTimeZoned False Nothing Nothing+  dbType _ _ = DbTypePrimitive DbDayTimeZoned False Nothing Nothing  -- There is a weird bug in GHC 7.4.1 which causes program to hang. See ticket 7126. -- instance (PersistField a, NeverNull a) => PersistField (Maybe a) where -- OK@@ -371,7 +371,7 @@   fromPersistValues [] = fail "fromPersistValues Maybe: empty list"   fromPersistValues (PersistNull:xs) = return (Nothing, xs)   fromPersistValues xs = fromPersistValues xs >>= \(x, xs') -> return (Just x, xs')-  dbType a = case dbType ((undefined :: Maybe a -> a) a) of+  dbType db a = case dbType db ((undefined :: Maybe a -> a) a) of     DbTypePrimitive t _ def ref -> DbTypePrimitive t True def ref     t -> error $ "dbType " ++ persistName a ++ ": expected DbTypePrimitive, got " ++ show t @@ -380,13 +380,13 @@   toPersistValues l = insertList l >>= toPersistValues   fromPersistValues [] = fail "fromPersistValues []: empty list"   fromPersistValues (x:xs) = phantomDb >>= \p -> getList (fromPrimitivePersistValue p x) >>= \l -> return (l, xs)-  dbType a = DbList (persistName a) $ dbType ((undefined :: [] a -> a) a)+  dbType db a = DbList (persistName a) $ dbType db ((undefined :: [] a -> a) a)  instance PersistField () where   persistName _ = "Unit" ++ [delim]   toPersistValues _ = return id   fromPersistValues xs = return ((), xs)-  dbType _ = DbEmbedded (EmbeddedDef False []) Nothing+  dbType _ _ = DbEmbedded (EmbeddedDef False []) Nothing  instance (PersistField a, PersistField b) => PersistField (a, b) where   persistName a = "Tuple2" ++ delim : delim : persistName ((undefined :: (a, b) -> a) a) ++ delim : persistName ((undefined :: (a, b) -> b) a)@@ -398,7 +398,7 @@     (a, rest0) <- fromPersistValues xs     (b, rest1) <- fromPersistValues rest0     return ((a, b), rest1)-  dbType a = DbEmbedded (EmbeddedDef False [("val0", dbType ((undefined :: (a, b) -> a) a)), ("val1", dbType ((undefined :: (a, b) -> b) a))]) Nothing+  dbType db a = DbEmbedded (EmbeddedDef False [("val0", dbType db ((undefined :: (a, b) -> a) a)), ("val1", dbType db ((undefined :: (a, b) -> b) a))]) Nothing    instance (PersistField a, PersistField b, PersistField c) => PersistField (a, b, c) where   persistName a = "Tuple3" ++ delim : delim : persistName ((undefined :: (a, b, c) -> a) a) ++ delim : persistName ((undefined :: (a, b, c) -> b) a) ++ delim : persistName ((undefined :: (a, b, c) -> c) a)@@ -412,7 +412,7 @@     (b, rest1) <- fromPersistValues rest0     (c, rest2) <- fromPersistValues rest1     return ((a, b, c), rest2)-  dbType a = DbEmbedded (EmbeddedDef False [("val0", dbType ((undefined :: (a, b, c) -> a) a)), ("val1", dbType ((undefined :: (a, b, c) -> b) a)), ("val2", dbType ((undefined :: (a, b, c) -> c) a))]) Nothing+  dbType db a = DbEmbedded (EmbeddedDef False [("val0", dbType db ((undefined :: (a, b, c) -> a) a)), ("val1", dbType db ((undefined :: (a, b, c) -> b) a)), ("val2", dbType db ((undefined :: (a, b, c) -> c) a))]) Nothing    instance (PersistField a, PersistField b, PersistField c, PersistField d) => PersistField (a, b, c, d) where   persistName a = "Tuple4" ++ delim : delim : persistName ((undefined :: (a, b, c, d) -> a) a) ++ delim : persistName ((undefined :: (a, b, c, d) -> b) a) ++ delim : persistName ((undefined :: (a, b, c, d) -> c) a) ++ delim : persistName ((undefined :: (a, b, c, d) -> d) a)@@ -428,7 +428,7 @@     (c, rest2) <- fromPersistValues rest1     (d, rest3) <- fromPersistValues rest2     return ((a, b, c, d), rest3)-  dbType a = DbEmbedded (EmbeddedDef False [("val0", dbType ((undefined :: (a, b, c, d) -> a) a)), ("val1", dbType ((undefined :: (a, b, c, d) -> b) a)), ("val2", dbType ((undefined :: (a, b, c, d) -> c) a)), ("val3", dbType ((undefined :: (a, b, c, d) -> d) a))]) Nothing+  dbType db a = DbEmbedded (EmbeddedDef False [("val0", dbType db ((undefined :: (a, b, c, d) -> a) a)), ("val1", dbType db ((undefined :: (a, b, c, d) -> b) a)), ("val2", dbType db ((undefined :: (a, b, c, d) -> c) a)), ("val3", dbType db ((undefined :: (a, b, c, d) -> d) a))]) Nothing    instance (PersistField a, PersistField b, PersistField c, PersistField d, PersistField e) => PersistField (a, b, c, d, e) where   persistName a = "Tuple5" ++ delim : delim : persistName ((undefined :: (a, b, c, d, e) -> a) a) ++ delim : persistName ((undefined :: (a, b, c, d, e) -> b) a) ++ delim : persistName ((undefined :: (a, b, c, d, e) -> c) a) ++ delim : persistName ((undefined :: (a, b, c, d, e) -> d) a) ++ delim : persistName ((undefined :: (a, b, c, d, e) -> e) a)@@ -446,24 +446,28 @@     (d, rest3) <- fromPersistValues rest2     (e, rest4) <- fromPersistValues rest3     return ((a, b, c, d, e), rest4)-  dbType a = DbEmbedded (EmbeddedDef False [("val0", dbType ((undefined :: (a, b, c, d, e) -> a) a)), ("val1", dbType ((undefined :: (a, b, c, d, e) -> b) a)), ("val2", dbType ((undefined :: (a, b, c, d, e) -> c) a)), ("val3", dbType ((undefined :: (a, b, c, d, e) -> d) a)), ("val4", dbType ((undefined :: (a, b, c, d, e) -> e) a))]) Nothing+  dbType db a = DbEmbedded (EmbeddedDef False [("val0", dbType db ((undefined :: (a, b, c, d, e) -> a) a)), ("val1", dbType db ((undefined :: (a, b, c, d, e) -> b) a)), ("val2", dbType db ((undefined :: (a, b, c, d, e) -> c) a)), ("val3", dbType db ((undefined :: (a, b, c, d, e) -> d) a)), ("val4", dbType db ((undefined :: (a, b, c, d, e) -> e) a))]) Nothing -instance (DbDescriptor db, PersistEntity v) => PersistField (KeyForBackend db v) where+instance (DbDescriptor db, PersistEntity v, PersistField v) => PersistField (KeyForBackend db v) where   persistName a = "KeyForBackend" ++ delim : persistName ((undefined :: KeyForBackend db v -> v) a)   toPersistValues = primToPersistValue   fromPersistValues = primFromPersistValue-  dbType a = dbType ((undefined :: KeyForBackend db v -> v) a)+  dbType db a = dbType db ((undefined :: KeyForBackend db v -> DefaultKey v) a)  instance (EntityConstr v c, PersistField a) => Projection (Field v c a) a where   type ProjectionDb (Field v c a) db = ()   type ProjectionRestriction (Field v c a) r = r ~ RestrictionHolder v c-  projectionExprs f = (ExprField (fieldChain f):)+  projectionExprs f = result where+    result = (ExprField (fieldChain db f):)+    db = (undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) result   projectionResult _ = fromPersistValues -instance (EntityConstr v c, PersistField a) => Projection (SubField v c a) a where-  type ProjectionDb (SubField v c a) db = ()-  type ProjectionRestriction (SubField v c a) r = r ~ RestrictionHolder v c-  projectionExprs f = (ExprField (fieldChain f):)+instance (EntityConstr v c, PersistField a) => Projection (SubField db v c a) a where+  type ProjectionDb (SubField db v c a) db' = db ~ db'+  type ProjectionRestriction (SubField db v c a) r = r ~ RestrictionHolder v c+  projectionExprs f = result where+    result = (ExprField (fieldChain db f):)+    db = (undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) result   projectionResult _ = fromPersistValues  instance PersistField a => Projection (Expr db r a) a where@@ -481,17 +485,21 @@ instance (EntityConstr v c, a ~ AutoKey v) => Projection (AutoKeyField v c) a where   type ProjectionDb (AutoKeyField v c) db = ()   type ProjectionRestriction (AutoKeyField v c) r = r ~ RestrictionHolder v c-  projectionExprs f = (ExprField (fieldChain f):)+  projectionExprs f = result where+    result = (ExprField (fieldChain db f):)+    db = (undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) result   projectionResult _ = fromPersistValues  instance EntityConstr v c => Projection (c (ConstructorMarker v)) v where   type ProjectionDb (c (ConstructorMarker v)) db = ()   type ProjectionRestriction (c (ConstructorMarker v)) r = r ~ RestrictionHolder v c-  projectionExprs c = ((map ExprField chains)++) where+  projectionExprs c = result where+    result = ((map ExprField chains) ++)     chains = map (\f -> (f, [])) $ constrParams constr-    e = entityDef ((undefined :: c (ConstructorMarker v) -> v) c)+    e = entityDef db ((undefined :: c (ConstructorMarker v) -> v) c)     cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> proxy v) c) c     constr = constructors e !! cNum+    db = (undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) result   projectionResult c xs = toSinglePersistValue cNum >>= \cNum' -> fromEntityPersistValues (cNum':xs) where     cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> proxy v) c) c @@ -499,10 +507,12 @@       => Projection (u (UniqueMarker v)) k where   type ProjectionDb (u (UniqueMarker v)) db = ()   type ProjectionRestriction (u (UniqueMarker v)) (RestrictionHolder v' c) = v ~ v'-  projectionExprs u = ((map ExprField chains)++) where-    UniqueDef _ _ uFields = constrUniques constr !! uniqueNum ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u)-    chains = map (\f -> (f, [])) uFields-    constr = head $ constructors (entityDef ((undefined :: u (UniqueMarker v) -> v) u))+  projectionExprs u = result where+    result = ((map ExprField chains) ++)+    uDef = constrUniques constr !! uniqueNum ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u)+    chains = map (\f -> (f, [])) $ getUniqueFields uDef+    constr = head $ constructors (entityDef db ((undefined :: u (UniqueMarker v) -> v) u))+    db = (undefined :: ([UntypedExpr db r] -> [UntypedExpr db r]) -> proxy db) result   projectionResult _ = fromPersistValues  instance (Projection a1 a1', Projection a2 a2') => Projection (a1, a2) (a1', a2') where@@ -548,32 +558,32 @@     return ((a, b, c, d, e), rest4)  instance (EntityConstr v c, a ~ AutoKey v) => Assignable (AutoKeyField v c) a-instance (EntityConstr v c, PersistField a) => Assignable (SubField v c a) a+instance (EntityConstr v c, PersistField a) => Assignable (SubField db v c a) a instance (EntityConstr v c, PersistField a) => Assignable (Field v c a) a instance (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u)) => Assignable (u (UniqueMarker v)) k  instance (EntityConstr v c, a ~ AutoKey v) => FieldLike (AutoKeyField v c) a where-  fieldChain a = chain where-    chain = ((name, dbType k), [])+  fieldChain db a = chain where+    chain = ((name, dbType db k), [])     -- if it is Nothing, the name would not be used because the type will be () with no columns     name = maybe "will_be_ignored" id $ constrAutoKeyName $ constructors e !! cNum     k = (undefined :: AutoKeyField v c -> AutoKey v) a -    e = entityDef ((undefined :: AutoKeyField v c -> v) a)+    e = entityDef db ((undefined :: AutoKeyField v c -> v) a)     cNum = entityConstrNum ((undefined :: AutoKeyField v c -> proxy v) a) ((undefined :: AutoKeyField v c -> c (ConstructorMarker v)) a) -instance (EntityConstr v c, PersistField a) => FieldLike (SubField v c a) a where-  fieldChain (SubField a) = a+instance (EntityConstr v c, PersistField a) => FieldLike (SubField db v c a) a where+  fieldChain _ (SubField a) = a  instance (EntityConstr v c, PersistField a) => FieldLike (Field v c a) a where   fieldChain = entityFieldChain  instance (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u))       => FieldLike (u (UniqueMarker v)) k where-  fieldChain u = chain where-    UniqueDef _ _ uFields = constrUniques constr !! uniqueNum ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u)-    chain = (("will_be_ignored", DbEmbedded (EmbeddedDef True uFields) Nothing), [])-    constr = head $ constructors (entityDef ((undefined :: u (UniqueMarker v) -> v) u))+  fieldChain db u = chain where+    uDef = constrUniques constr !! uniqueNum ((undefined :: u (UniqueMarker v) -> Key v (Unique u)) u)+    chain = (("will_be_ignored", DbEmbedded (EmbeddedDef True $ getUniqueFields uDef) Nothing), [])+    constr = head $ constructors (entityDef db ((undefined :: u (UniqueMarker v) -> v) u))  instance (PersistEntity v, EntityConstr' (IsSumType v) c) => EntityConstr v c where   entityConstrNum v = entityConstrNum' $ (undefined :: proxy v -> IsSumType v) v
changelog view
@@ -1,7 +1,13 @@+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 * DISTINCT select option * Support entities with no fields-* Add getCurrentSchema function into SchemaAnalyzer+* Added getCurrentSchema function into SchemaAnalyzer  0.5.0 * Reimplemented projections with constraint kinds
groundhog.cabal view
@@ -1,5 +1,5 @@ name:            groundhog-version:         0.5.1+version:         0.6.0 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -22,7 +22,7 @@                    , mtl                      >= 2.0                    , time                     >= 1.1.4                    , text                     >= 0.8-                   , blaze-builder            >= 0.3.0.0    && < 0.4+                   , blaze-builder            >= 0.3        && < 0.4                    , containers               >= 0.2                    , monad-control            >= 0.3        && < 0.4                    , monad-logger             >= 0.3        && < 0.4