packages feed

groundhog 0.5.0 → 0.5.1

raw patch · 7 files changed

+92/−61 lines, 7 filesdep ~basedep ~blaze-builderdep ~monad-controlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, blaze-builder, monad-control, monad-logger, transformers

API changes (from Hackage documentation)

- Database.Groundhog.Core: instance HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder) db r
+ Database.Groundhog.Core: class (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a
+ Database.Groundhog.Core: dbSpecificOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> [(String, QueryRaw db r)]
+ Database.Groundhog.Core: distinct :: (HasSelectOptions a db r, HasDistinct a ~ HFalse) => a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue
+ Database.Groundhog.Core: distinctOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> Bool
+ Database.Groundhog.Core: instance (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a
+ Database.Groundhog.Core: instance HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) db r
+ Database.Groundhog.Core: instance Ord UniqueType
+ Database.Groundhog.Generic.Migration: getCurrentSchema :: SchemaAnalyzer m => m (Maybe String)
+ Database.Groundhog.Generic.Migration: instance Eq UniqueDef'
+ Database.Groundhog.Generic.Migration: instance Ord UniqueDef'
- Database.Groundhog: limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a)
+ Database.Groundhog: limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a) (HasDistinct a)
- Database.Groundhog: offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a)
+ Database.Groundhog: offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a) (HasDistinct a)
- Database.Groundhog: orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue
+ Database.Groundhog: orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue (HasDistinct a)
- Database.Groundhog: project :: (PersistBackend m, PersistEntity v, EntityConstr v c, Projection p a, ProjectionDb p (PhantomDb m), ProjectionRestriction p (RestrictionHolder v c), HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => p -> opts -> m [a]
+ Database.Groundhog: project :: (PersistBackend m, PersistEntity v, EntityConstr v c, Projection' p (PhantomDb m) (RestrictionHolder v c) a, HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => p -> opts -> m [a]
- Database.Groundhog.Core: SelectOptions :: Cond db r -> Maybe Int -> Maybe Int -> [Order db r] -> SelectOptions db r hasLimit hasOffset hasOrder
+ Database.Groundhog.Core: SelectOptions :: Cond db r -> Maybe Int -> Maybe Int -> [Order db r] -> Bool -> [(String, QueryRaw db r)] -> SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
- Database.Groundhog.Core: UniquePrimary :: UniqueType
+ Database.Groundhog.Core: UniquePrimary :: Bool -> UniqueType
- Database.Groundhog.Core: class HasSelectOptions a db r | a -> db r where type family HasLimit a type family HasOffset a type family HasOrder a
+ Database.Groundhog.Core: class HasSelectOptions a db r | a -> db r where type family HasLimit a type family HasOffset a type family HasOrder a type family HasDistinct a
- Database.Groundhog.Core: condOptions :: SelectOptions db r hasLimit hasOffset hasOrder -> Cond db r
+ Database.Groundhog.Core: condOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> Cond db r
- Database.Groundhog.Core: data SelectOptions db r hasLimit hasOffset hasOrder
+ Database.Groundhog.Core: data SelectOptions db r hasLimit hasOffset hasOrder hasDistinct
- Database.Groundhog.Core: getSelectOptions :: HasSelectOptions a db r => a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a)
+ Database.Groundhog.Core: getSelectOptions :: HasSelectOptions a db r => a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)
- Database.Groundhog.Core: limitOptions :: SelectOptions db r hasLimit hasOffset hasOrder -> Maybe Int
+ Database.Groundhog.Core: limitOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> Maybe Int
- Database.Groundhog.Core: limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a)
+ Database.Groundhog.Core: limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a) (HasDistinct a)
- Database.Groundhog.Core: offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a)
+ Database.Groundhog.Core: offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a) (HasDistinct a)
- Database.Groundhog.Core: offsetOptions :: SelectOptions db r hasLimit hasOffset hasOrder -> Maybe Int
+ Database.Groundhog.Core: offsetOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> Maybe Int
- Database.Groundhog.Core: orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue
+ Database.Groundhog.Core: orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue (HasDistinct a)
- Database.Groundhog.Core: orderOptions :: SelectOptions db r hasLimit hasOffset hasOrder -> [Order db r]
+ Database.Groundhog.Core: orderOptions :: SelectOptions db r hasLimit hasOffset hasOrder hasDistinct -> [Order db r]
- Database.Groundhog.Core: project :: (PersistBackend m, PersistEntity v, EntityConstr v c, Projection p a, ProjectionDb p (PhantomDb m), ProjectionRestriction p (RestrictionHolder v c), HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => p -> opts -> m [a]
+ Database.Groundhog.Core: project :: (PersistBackend m, PersistEntity v, EntityConstr v c, Projection' p (PhantomDb m) (RestrictionHolder v c) a, HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c)) => p -> opts -> m [a]
- Database.Groundhog.Generic.Migration: class Monad m => SchemaAnalyzer m
+ Database.Groundhog.Generic.Migration: class (Applicative m, Monad m) => SchemaAnalyzer m
- Database.Groundhog.Generic.Migration: defaultMigConstr :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)
+ Database.Groundhog.Generic.Migration: defaultMigConstr :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)
- Database.Groundhog.Generic.Migration: migrateEntity :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> EntityDef -> m SingleMigration
+ Database.Groundhog.Generic.Migration: migrateEntity :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> m SingleMigration
- Database.Groundhog.Generic.Migration: migrateList :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> DbType -> m SingleMigration
+ Database.Groundhog.Generic.Migration: migrateList :: SchemaAnalyzer m => MigrationPack m -> DbType -> m SingleMigration
- Database.Groundhog.Generic.Migration: migrateSchema :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> String -> m SingleMigration
+ Database.Groundhog.Generic.Migration: migrateSchema :: SchemaAnalyzer m => MigrationPack m -> String -> m SingleMigration
- Database.Groundhog.Generic.PersistBackendHelpers: project :: (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, Projection p a', ProjectionDb p db, ProjectionRestriction p r, HasSelectOptions opts db r) => RenderConfig -> (forall a. Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Utf8 -> p -> opts -> m [a']
+ Database.Groundhog.Generic.PersistBackendHelpers: project :: (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, Projection p a', ProjectionDb p db, ProjectionRestriction p r, HasSelectOptions opts db r) => RenderConfig -> (forall a. Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> (opts -> RenderS db r) -> Utf8 -> p -> opts -> m [a']
- Database.Groundhog.Generic.PersistBackendHelpers: select :: (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, HasSelectOptions opts db r) => RenderConfig -> (forall a. Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Utf8 -> opts -> m [v]
+ Database.Groundhog.Generic.PersistBackendHelpers: select :: (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, HasSelectOptions opts db r) => RenderConfig -> (forall a. Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> (opts -> RenderS db r) -> Utf8 -> opts -> m [v]

Files

Database/Groundhog/Core.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE GADTs, TypeFamilies, ExistentialQuantification, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, EmptyDataDecls, ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-} -- Required for Projection' -- | This module defines the functions and datatypes used throughout the framework. -- Most of them are for the internal use module Database.Groundhog.Core@@ -12,6 +13,7 @@   , PrimitivePersistField(..)   , Embedded(..)   , Projection(..)+  , Projection'   , RestrictionHolder   , Unique   , KeyForBackend(..)@@ -44,6 +46,7 @@   , limitTo   , offsetBy   , orderBy+  , distinct   -- * Type description   , DbTypePrimitive(..)   , DbType(..)@@ -147,11 +150,11 @@  data ExprRelation = Eq | Ne | Gt | Lt | Ge | Le deriving Show -data Update db r = forall f a . (Assignable f a, ProjectionDb f db, ProjectionRestriction f r) => Update f (UntypedExpr db r)+data Update db r = forall f a . (Assignable f a, Projection' f db r a) => Update f (UntypedExpr db r)  -- | Defines sort order of a result-set-data Order db r = forall a f . (Projection f a, ProjectionDb f db, ProjectionRestriction f r) => Asc  f-                | forall a f . (Projection f a, ProjectionDb f db, ProjectionRestriction f r) => Desc f+data Order db r = forall a f . (Projection' f db r a) => Asc  f+                | forall a f . (Projection' f db r a) => Desc f  -- | It is used to map field to column names. It can be either a column name for a regular field of non-embedded type or a list of this field and the outer fields in reverse order. Eg, fieldChain $ SomeField ~> Tuple2_0Selector may result in [(\"val0\", DbString), (\"some\", DbEmbedded False [dbType \"\", dbType True])]. type FieldChain = ((String, DbType), [(String, EmbeddedDef)])@@ -165,6 +168,9 @@   -- | 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]) +class (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a+instance (Projection p a, ProjectionDb p db, ProjectionRestriction p r) => Projection' p db r a+ -- | This subset of Projection instances is for things that behave like fields. Namely, they can occur in condition expressions (for example, Field and SubField) and on the left side of update statements. For example \"lower(field)\" is a valid Projection, but not Field like because it cannot be on the left side. Datatypes that index PostgreSQL arrays \"arr[5]\" or access composites \"(comp).subfield\" are valid instances of Assignable. class Projection f a => Assignable f a | f -> a @@ -194,11 +200,15 @@  data RestrictionHolder v (c :: (* -> *) -> *) -data SelectOptions db r hasLimit hasOffset hasOrder = SelectOptions {-    condOptions   :: Cond db r-  , limitOptions  :: Maybe Int-  , offsetOptions :: Maybe Int-  , orderOptions  :: [Order db r]+data SelectOptions db r hasLimit hasOffset hasOrder hasDistinct = SelectOptions {+    condOptions     :: Cond db r+  , limitOptions    :: Maybe Int+  , offsetOptions   :: Maybe Int+  , orderOptions    :: [Order db r]+    -- ^ False - no DISTINCT, True - DISTINCT+  , distinctOptions :: Bool+    -- ^ The name of the option and part of the SQL which will be put later+  , dbSpecificOptions  :: [(String, QueryRaw db r)]   }  -- | This class helps to check that limit, offset, or order clauses are added to condition only once.@@ -206,32 +216,36 @@   type HasLimit a   type HasOffset a   type HasOrder a-  getSelectOptions :: a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a)+  type HasDistinct a+  getSelectOptions :: a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) (HasDistinct a)  instance 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-  getSelectOptions a = SelectOptions a Nothing Nothing []+  type HasDistinct (Cond db r) = HFalse+  getSelectOptions a = SelectOptions a Nothing Nothing [] False [] -instance HasSelectOptions (SelectOptions db r hasLimit hasOffset hasOrder) db r where-  type HasLimit (SelectOptions db r hasLimit hasOffset hasOrder) = hasLimit-  type HasOffset (SelectOptions db r hasLimit hasOffset hasOrder) = hasOffset-  type HasOrder (SelectOptions db r hasLimit hasOffset hasOrder) = hasOrder+instance 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+  type HasDistinct (SelectOptions db r hasLimit hasOffset hasOrder hasDistinct) = hasDistinct   getSelectOptions = id -limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a)-limitTo opts lim = case getSelectOptions opts of-  SelectOptions c _ off ord -> SelectOptions c (Just lim) off ord+limitTo :: (HasSelectOptions a db r, HasLimit a ~ HFalse) => a -> Int -> SelectOptions db r HTrue (HasOffset a) (HasOrder a) (HasDistinct a)+limitTo opts lim = (getSelectOptions opts) {limitOptions = Just lim} -offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a)-offsetBy opts off = case getSelectOptions opts of-  SelectOptions c lim _ ord -> SelectOptions c lim (Just off) ord+offsetBy :: (HasSelectOptions a db r, HasOffset a ~ HFalse) => a -> Int -> SelectOptions db r (HasLimit a) HTrue (HasOrder a) (HasDistinct a)+offsetBy opts off = (getSelectOptions opts) {offsetOptions = Just off} -orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue-orderBy opts ord = case getSelectOptions opts of-  SelectOptions c lim off _ -> SelectOptions c lim off ord+orderBy :: (HasSelectOptions a db r, HasOrder a ~ HFalse) => a -> [Order db r] -> SelectOptions db r (HasLimit a) (HasOffset a) HTrue (HasDistinct a)+orderBy opts ord = (getSelectOptions opts) {orderOptions = ord} +-- | Select DISTINCT rows. @select $ distinct CondEmpty@+distinct :: (HasSelectOptions a db r, HasDistinct a ~ HFalse) => a -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue+distinct opts = (getSelectOptions opts) {distinctOptions = True}+ newtype DbPersist conn m a = DbPersist { unDbPersist :: ReaderT conn m a }   deriving (Monad, MonadIO, Functor, Applicative, MonadTrans, MonadReader conn) @@ -301,7 +315,7 @@   -- | Count total number of records with all constructors. The entity parameter is used only for type inference   countAll      :: PersistEntity v => v -> m Int   -- | Fetch projection of some fields. Example: @project (SecondField, ThirdField) $ (FirstField ==. \"abc\" &&. SecondField >. \"def\") \`orderBy\` [Asc ThirdField] \`offsetBy\` 100@-  project       :: (PersistEntity v, EntityConstr v c, Projection p a, ProjectionDb p (PhantomDb m), ProjectionRestriction p (RestrictionHolder v c), HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c))+  project       :: (PersistEntity v, EntityConstr v c, Projection' p (PhantomDb m) (RestrictionHolder v c) a, HasSelectOptions opts (PhantomDb m) (RestrictionHolder v c))                 => p                 -> opts                 -> m [a]@@ -385,7 +399,10 @@ } deriving (Show, Eq)  -- | Defines how to treat the unique set of fields for a datatype-data UniqueType = UniqueConstraint | UniqueIndex | UniquePrimary deriving (Show, Eq)+data UniqueType = UniqueConstraint+                | UniqueIndex+                | UniquePrimary Bool -- ^ is autoincremented+  deriving (Show, Eq, Ord)  data ReferenceActionType = NoAction                          | Restrict
Database/Groundhog/Generic/Migration.hs view
@@ -25,6 +25,7 @@ import Database.Groundhog.Generic import Database.Groundhog.Generic.Sql (mainTableName, tableName) +import Control.Applicative (Applicative) import Control.Arrow ((***), (&&&)) import Control.Monad (liftM, when) import Control.Monad.Trans.Class (lift)@@ -89,7 +90,7 @@     uniqueDefName :: Maybe String   , uniqueDefType :: UniqueType   , uniqueDefColumns :: [String]-} deriving Show+} deriving (Show, Eq, Ord)  data MigrationPack m = MigrationPack {     compareTypes :: DbTypePrimitive -> DbTypePrimitive -> Bool@@ -178,19 +179,19 @@     when (v == Nothing) $       lift mig >>= modify . Map.insert name >> cont -migrateSchema :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> String -> m SingleMigration+migrateSchema :: SchemaAnalyzer m => MigrationPack m -> String -> m SingleMigration migrateSchema MigrationPack{..} schema = do   x <- schemaExists schema   return $ if x     then Right []     else showAlterDb $ CreateSchema schema False -migrateEntity :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> EntityDef -> m SingleMigration+migrateEntity :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> m SingleMigration migrateEntity m@MigrationPack{..} e = do   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 ["id"]] []+      expectedMainStructure = TableInfo [Column "id" False DbAutoKey Nothing, Column "discr" False DbInt32 Nothing] [UniqueDef' Nothing (UniquePrimary True) ["id"]] []    if isSimple constrs     then do@@ -222,12 +223,12 @@                in mergeMigrations $ Right updateDiscriminators: map snd res           else Left ["Unexpected structure of main table for Datatype: " ++ name ++ ". Table info: " ++ show mainStructure'] -migrateList :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> DbType -> m SingleMigration+migrateList :: SchemaAnalyzer m => MigrationPack m -> DbType -> m SingleMigration migrateList m@MigrationPack{..} (DbList mainName t) = do   let valuesName = mainName ++ delim : "values"       (valueCols, valueRefs) = (($ []) . mkColumns) &&& mkReferences $ ("value", t)       refs' = Reference Nothing mainName [("id", "id")] (Just Cascade) Nothing : valueRefs-      expectedMainStructure = TableInfo [Column "id" False DbAutoKey Nothing] [UniqueDef' Nothing UniquePrimary ["id"]] []+      expectedMainStructure = TableInfo [Column "id" False DbAutoKey Nothing] [UniqueDef' Nothing (UniquePrimary True) ["id"]] []       mainQuery = "CREATE TABLE " ++ escape mainName ++ " (id " ++ primaryKeyTypeName ++ ")"       (addInCreate, addInAlters) = addUniquesReferences [] refs'       expectedValuesStructure = TableInfo valueColumns [] (map (\x -> (Nothing, x)) refs')@@ -261,7 +262,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) . uniqueDefType) oldUniques+    primaryColumns = concatMap uniqueDefColumns $ 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@@ -300,10 +301,10 @@ dropUnique (UniqueDef' name typ _) = (case typ of   UniqueConstraint -> DropConstraint name'   UniqueIndex -> DropIndex name'-  UniquePrimary -> DropConstraint name') where+  UniquePrimary _ -> DropConstraint name') where   name' = fromMaybe (error $ "dropUnique: constraint which should be dropped does not have a name") name   -defaultMigConstr :: (Monad m, SchemaAnalyzer m) => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration)+defaultMigConstr :: SchemaAnalyzer m => MigrationPack m -> EntityDef -> ConstructorDef -> m (Bool, SingleMigration) defaultMigConstr migPack@MigrationPack{..} e constr = do   let simple = isSimple $ constructors e       name = entityName e@@ -314,23 +315,23 @@   (triggerExisted, delTrigger) <- migTriggerOnDelete schema cName dels   updTriggers <- liftM (concatMap snd) $ migTriggerOnUpdate schema cName dels   -  let (columns, refs) = foldr mkColumns [] &&& concatMap mkReferences $ constrParams constr-      (expectedTableStructure, (addTable, addInAlters)) = case constrAutoKeyName constr of+  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                          in if simple-          then (TableInfo (keyColumn:columns) (uniques ++ [UniqueDef' Nothing UniquePrimary [keyName]]) (mkRefs refs)+          then (TableInfo (keyColumn:columns) (uniques ++ [UniqueDef' Nothing (UniquePrimary True) [keyName]]) (mkRefs refs)                , f [escape keyName ++ " " ++ primaryKeyTypeName] columns uniques refs)           else let columns' = keyColumn:columns                    refs' = refs ++ [Reference schema name [(keyName, mainTableId)] (Just Cascade) Nothing]                    uniques' = uniques ++ [UniqueDef' Nothing UniqueConstraint [keyName]]-               in (TableInfo columns' uniques' (mkRefs refs'), f [] columns' uniques' refs')-      uniques = map (\(UniqueDef uName uType cols) -> UniqueDef' (Just uName) uType (map colName $ foldr mkColumns [] cols)) $ constrUniques constr-      f autoKey cols uniqs refs' = (addTable', addInAlters') where-        (addInCreate, addInAlters') = addUniquesReferences uniqs refs'-        items = autoKey ++ map showColumn cols ++ addInCreate-        addTable' = "CREATE TABLE " ++ tableName escape e constr ++ " (" ++ intercalate ", " items ++ ")"-      mkRefs = map (\r -> (Nothing, r))+               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+        f autoKey cols uniqs refs' = (addTable', addInAlters') where+          (addInCreate, addInAlters') = addUniquesReferences uniqs refs'+          items = autoKey ++ map showColumn cols ++ addInCreate+          addTable' = "CREATE TABLE " ++ tableName escape e constr ++ " (" ++ intercalate ", " items ++ ")"+        mkRefs = map (\r -> (Nothing, r))        (migErrs, constrExisted, mig) = case tableStructure of         Nothing -> let@@ -338,7 +339,10 @@           in ([], False, [AddTable addTable, rest])         Just oldTableStructure -> let           alters = getAlters migPack oldTableStructure expectedTableStructure-          in ([], True, [AlterTable schema cName addTable oldTableStructure expectedTableStructure alters])+          alterTable = if null alters+            then []+            else [AlterTable schema cName addTable oldTableStructure expectedTableStructure alters]+          in ([], True, alterTable)       -- this can happen when an ephemeral field was added. Consider doing something else except throwing an error       allErrs = if constrExisted == triggerExisted || (constrExisted && null dels)         then migErrs@@ -370,9 +374,10 @@   "SET DEFAULT" -> Just SetDefault   _ -> Nothing -class Monad m => SchemaAnalyzer m where+class (Applicative m, Monad m) => SchemaAnalyzer m where   schemaExists :: String -- ^ Schema name                -> m Bool+  getCurrentSchema :: m (Maybe String)   listTables :: Maybe String -- ^ Schema name              -> m [String]   listTableTriggers :: Maybe String -- ^ Schema name
Database/Groundhog/Generic/PersistBackendHelpers.hs view
@@ -62,9 +62,9 @@         Nothing -> return Nothing  select :: forall m db r v c opts . (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, HasSelectOptions opts db r)-       => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Utf8 -> opts -> m [v]-select conf@RenderConfig{..} queryFunc noLimit options = doSelectQuery where-  SelectOptions cond limit offset ords = getSelectOptions options+       => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> (opts -> RenderS db r) -> Utf8 -> opts -> m [v]+select conf@RenderConfig{..} queryFunc preColumns noLimit options = doSelectQuery where+  SelectOptions cond limit offset ords dist _ = getSelectOptions options    e = entityDef (undefined :: v)   proxy = undefined :: proxy (PhantomDb m)@@ -76,7 +76,8 @@           (l, o) -> RenderS " LIMIT ? OFFSET ?" (toPurePersistValues proxy (l, o))   cond' = renderCond conf cond   fields = RenderS (renderFields esc (constrParams constr)) id-  RenderS query binds = "SELECT " <> fields <> " FROM " <> RenderS (tableName esc e constr) id <> whereClause <> orders <> lim+  distinctClause = if dist then "DISTINCT " else mempty+  RenderS query binds = "SELECT " <> distinctClause <> preColumns options <> fields <> " FROM " <> RenderS (tableName esc e constr) id <> whereClause <> orders <> lim   whereClause = maybe "" (" WHERE " <>) cond'   doSelectQuery = queryFunc query (binds []) $ mapAllRows $ liftM fst . fromEntityPersistValues . (toPrimitivePersistValue proxy cNum:)   cNum = entityConstrNum (undefined :: proxy v) (undefined :: c a)@@ -118,9 +119,9 @@     Nothing -> return Nothing  project :: forall m db r v c p opts a'. (SqlDb db, db ~ PhantomDb m, r ~ RestrictionHolder v c, PersistBackend m, PersistEntity v, EntityConstr v c, Projection p a', ProjectionDb p db, ProjectionRestriction p r, HasSelectOptions opts db r)-        => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> Utf8 -> p -> opts -> m [a']-project conf@RenderConfig{..} queryFunc noLimit p options = doSelectQuery where-  SelectOptions cond limit offset ords = getSelectOptions options+        => 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)   proxy = undefined :: proxy (PhantomDb m)   orders = renderOrders conf ords@@ -132,7 +133,8 @@   cond' = renderCond conf cond   chains = projectionExprs p []   fields = commasJoin $ concatMap (renderExprExtended conf 0) chains-  RenderS query binds = "SELECT " <> fields <> " FROM " <> RenderS (tableName esc e constr) id <> whereClause <> orders <> lim+  distinctClause = if dist then "DISTINCT " else mempty+  RenderS query binds = "SELECT " <> distinctClause <> preColumns options <> fields <> " FROM " <> RenderS (tableName esc e constr) id <> whereClause <> orders <> lim   whereClause = maybe "" (" WHERE " <>) cond'   doSelectQuery = queryFunc query (binds []) $ mapAllRows $ liftM fst . projectionResult p   constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)
Database/Groundhog/Generic/Sql.hs view
@@ -186,6 +186,7 @@ renderCondPriority conf@RenderConfig{..} priority cond = go cond priority where   go (And a b)       p = perhaps andP p " AND " a b   go (Or a b)        p = perhaps orP p " OR " a b+  go (Not CondEmpty) _ = Just "(1=0)" -- special case for False   go (Not a)         p = fmap (\a' -> parens notP p $ "NOT " <> a') $ go a notP   go (Compare compOp f1 f2) p = (case compOp of     Eq -> renderComp andP " AND " 37 equalsOperator f1 f2@@ -206,6 +207,7 @@     [a] -> Just a     _ -> error "renderCond: cannot render CondRaw with many elements"   go CondEmpty _ = Nothing+    notP = 35   andP = 30   orP = 20
Database/Groundhog/Generic/Sql/Functions.hs view
@@ -25,7 +25,7 @@  in_ :: (SqlDb db, Expression db r a, Expression db r b, PrimitivePersistField b, Unifiable a b) =>     a -> [b] -> Cond db r-in_ _ [] = CondEmpty+in_ _ [] = Not CondEmpty in_ a bs = CondRaw $ Snippet $ \conf p -> [parens 45 p $ renderExpr conf (toExpr a) <> " IN (" <> commasJoin (map (renderExpr conf . toExpr) bs) <> ")"]  notIn_ :: (SqlDb db, Expression db r a, Expression db r b, PrimitivePersistField b, Unifiable a b) =>
changelog view
@@ -1,3 +1,8 @@+0.5.1+* DISTINCT select option+* Support entities with no fields+* Add getCurrentSchema function into SchemaAnalyzer+ 0.5.0 * Reimplemented projections with constraint kinds * Moved QueryRaw constraint into class SqlDb simplifying SQL function signatures
groundhog.cabal view
@@ -1,5 +1,5 @@ name:            groundhog-version:         0.5.0+version:         0.5.1 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -16,16 +16,16 @@     changelog  library-    build-depends:   base                     >= 4       && < 5+    build-depends:   base                     >= 4          && < 5                    , bytestring               >= 0.9-                   , transformers             >= 0.2.1+                   , transformers             >= 0.2.1      && < 0.5                    , mtl                      >= 2.0                    , time                     >= 1.1.4                    , text                     >= 0.8-                   , blaze-builder            >= 0.3.0.0+                   , blaze-builder            >= 0.3.0.0    && < 0.4                    , containers               >= 0.2-                   , monad-control            >= 0.3-                   , monad-logger             >= 0.3+                   , monad-control            >= 0.3        && < 0.4+                   , monad-logger             >= 0.3        && < 0.4                    , transformers-base     exposed-modules: Database.Groundhog                      Database.Groundhog.Core