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 +69/−52
- Database/Groundhog/Expression.hs +16/−11
- Database/Groundhog/Generic.hs +34/−20
- Database/Groundhog/Generic/Migration.hs +60/−55
- Database/Groundhog/Generic/PersistBackendHelpers.hs +32/−25
- Database/Groundhog/Generic/Sql.hs +6/−3
- Database/Groundhog/Instances.hs +62/−52
- changelog +7/−1
- groundhog.cabal +2/−2
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