packages feed

groundhog 0.4.2.1 → 0.4.2.2

raw patch · 8 files changed

+131/−46 lines, 8 files

Files

Database/Groundhog/Core.hs view
@@ -112,7 +112,7 @@   -- | Constructs the value from the list of 'PersistValue'   fromEntityPersistValues :: PersistBackend m => [PersistValue] -> m (v, [PersistValue])   -- | Returns constructor number and a list of uniques names and corresponding field values-  getUniques :: DbDescriptor db => Proxy db -> v -> (Int, [(String, [PersistValue] -> [PersistValue])])+  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@@ -129,6 +129,7 @@ -- | It allows to store autogenerated keys of one database in another data KeyForBackend db v = (DbDescriptor db, PersistEntity v) => KeyForBackend (AutoKeyType db) +{-# DEPRECATED Proxy "use polymophic proxy or another data constructor like [] instead" #-} data Proxy a  data HFalse@@ -256,7 +257,7 @@   -- | Value of this type can be used as a part of a query. For example, it can be RenderS for relational databases, or BSON for MongoDB.   type QueryRaw db :: * -> *   -- | Name of backend-  backendName :: Proxy db -> String+  backendName :: proxy db -> String  class (Monad m, DbDescriptor (PhantomDb m)) => PersistBackend m where   -- | A token which defines the DB type. For example, different monads working with Sqlite, return may Sqlite type.@@ -365,7 +366,7 @@ -- define the constructor, but the entity has only one. -- For example, in @select $ AutoKeyField ==. k@ the condition would need type annotation with constructor name only if we select a sum type. class PersistEntity v => EntityConstr v c where-  entityConstrNum :: Proxy v -> c (a :: * -> *) -> Int+  entityConstrNum :: proxy v -> c (a :: * -> *) -> Int  class PurePersistField uKey => IsUniqueKey uKey where   -- | Creates value of unique key using the data extracted from the passed value@@ -505,13 +506,13 @@  -- | Represents all datatypes that map into several columns. Getting values for those columns is pure. class PersistField a => PurePersistField a where-  toPurePersistValues :: DbDescriptor db => Proxy db -> a -> ([PersistValue] -> [PersistValue])-  fromPurePersistValues :: DbDescriptor db => Proxy db -> [PersistValue] -> (a, [PersistValue])+  toPurePersistValues :: DbDescriptor db => proxy db -> a -> ([PersistValue] -> [PersistValue])+  fromPurePersistValues :: DbDescriptor db => proxy db -> [PersistValue] -> (a, [PersistValue]) --- | Datatypes which can be converted directly to 'PersistValue'. The no-value parameter @DbDescriptor db => Proxy db@ allows conversion depend the database details while keeping it pure. A type which has an instance of 'PrimitivePersistField' should be an instance of superclasses 'SinglePersistField' and 'PurePersistField' as well.+-- | Datatypes which can be converted directly to 'PersistValue'. The no-value parameter @DbDescriptor db => proxy db@ allows conversion depend the database details while keeping it pure. A type which has an instance of 'PrimitivePersistField' should be an instance of superclasses 'SinglePersistField' and 'PurePersistField' as well. class PersistField a => PrimitivePersistField a where-  toPrimitivePersistValue :: DbDescriptor db => Proxy db -> a -> PersistValue-  fromPrimitivePersistValue :: DbDescriptor db => Proxy db -> PersistValue -> a+  toPrimitivePersistValue :: DbDescriptor db => proxy db -> a -> PersistValue+  fromPrimitivePersistValue :: DbDescriptor db => proxy db -> PersistValue -> a  delim :: Char delim = '#'
Database/Groundhog/Generic.hs view
@@ -207,10 +207,10 @@ primFromPersistValue (x:xs) = phantomDb >>= \p -> return (fromPrimitivePersistValue p x, xs) primFromPersistValue xs = (\a -> fail (failMessage a xs) >> return (a, xs)) undefined -primToPurePersistValues :: (DbDescriptor db, PrimitivePersistField a) => Proxy db -> a -> ([PersistValue] -> [PersistValue])+primToPurePersistValues :: (DbDescriptor db, PrimitivePersistField a) => proxy db -> a -> ([PersistValue] -> [PersistValue]) primToPurePersistValues p a = (toPrimitivePersistValue p a:) -primFromPurePersistValues :: (DbDescriptor db, PrimitivePersistField a) => Proxy db -> [PersistValue] -> (a, [PersistValue])+primFromPurePersistValues :: (DbDescriptor db, PrimitivePersistField a) => proxy db -> [PersistValue] -> (a, [PersistValue]) primFromPurePersistValues p (x:xs) = (fromPrimitivePersistValue p x, xs) primFromPurePersistValues _ xs = (\a -> error (failMessage a xs) `asTypeOf` (a, xs)) undefined @@ -287,7 +287,7 @@ mapAllRows f pop = go where   go = pop >>= maybe (return []) (f >=> \a -> liftM (a:) go) -phantomDb :: PersistBackend m => m (Proxy (PhantomDb m))+phantomDb :: PersistBackend m => m (proxy (PhantomDb m)) phantomDb = return $ error "phantomDb"  isSimple :: [ConstructorDef] -> Bool
Database/Groundhog/Generic/Migration.hs view
@@ -12,6 +12,7 @@   , SchemaAnalyzer(..)   , mkColumns   , migrateRecursively+  , migrateSchema   , migrateEntity   , migrateList   , getAlters@@ -22,10 +23,10 @@  import Database.Groundhog.Core import Database.Groundhog.Generic-import Database.Groundhog.Generic.Sql (tableName)+import Database.Groundhog.Generic.Sql (mainTableName, tableName)  import Control.Arrow ((***), (&&&))-import Control.Monad (liftM)+import Control.Monad (liftM, when) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT (..), gets, modify) import Data.Function (on)@@ -80,6 +81,8 @@              | CreateOrReplaceFunction String              -- | Function schema, function name              | DropFunction (Maybe String) String+             -- | Schema name, if not exists+             | CreateSchema String Bool   deriving Show  data UniqueDef' = UniqueDef' {@@ -153,25 +156,35 @@ -- The stateful Map is used to avoid duplicate migrations when an entity type -- occurs several times in a datatype migrateRecursively :: (Monad m, PersistEntity v) => -     (EntityDef -> m SingleMigration) -- ^ migrate entity+     (String    -> m SingleMigration)    -- ^ migrate schema+  -> (EntityDef -> m SingleMigration) -- ^ migrate entity   -> (DbType    -> m SingleMigration) -- ^ migrate list   -> v                                -- ^ initial entity   -> StateT NamedMigrations m ()-migrateRecursively migE migL = go . dbType where-  go l@(DbList lName t) = f lName (migL l) (go t)+migrateRecursively migS migE migL = go . dbType where+  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-  f name mig cont = do-    v <- gets (Map.lookup name)-    case v of-      Nothing -> lift mig >>= modify . Map.insert name >> cont-      _ -> return ()   allSubtypes = map snd . concatMap constrParams . constructors-  -- TODO: use schema-qualified name   migRef ref = case ref of-    Just (Left (e, _), _, _) -> f (entityName e) (migE e) (mapM_ go (allSubtypes e))+    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))     _ -> return ()+  f name mig cont = do+    v <- gets (Map.lookup name)+    when (v == Nothing) $+      lift mig >>= modify . Map.insert name >> cont +migrateSchema :: (Monad m, 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 m@MigrationPack{..} e = do   let name = entityName e@@ -358,6 +371,8 @@   _ -> Nothing  class Monad m => SchemaAnalyzer m where+  schemaExists :: String -- ^ Schema name+               -> m Bool   listTables :: Maybe String -- ^ Schema name              -> m [String]   listTableTriggers :: Maybe String -- ^ Schema name
Database/Groundhog/Generic/PersistBackendHelpers.hs view
@@ -35,7 +35,7 @@     => 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 proxy = undefined :: proxy (PhantomDb m)   if isSimple (constructors e)     then do       let constr = head $ constructors e@@ -67,7 +67,7 @@   SelectOptions cond limit offset ords = getSelectOptions options    e = entityDef (undefined :: v)-  proxy = undefined :: Proxy (PhantomDb m)+  proxy = undefined :: proxy (PhantomDb m)   orders = renderOrders conf ords   (lim, limps) = case (limit, offset) of         (Nothing, Nothing) -> ("", [])@@ -80,7 +80,7 @@   whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'   doSelectQuery = queryFunc query binds $ mapAllRows $ liftM fst . fromEntityPersistValues . (toPrimitivePersistValue proxy cNum:)   binds = maybe id getValues cond' $ limps-  cNum = entityConstrNum (undefined :: Proxy v) (undefined :: c a)+  cNum = entityConstrNum (undefined :: proxy v) (undefined :: c a)   constr = constructors e !! cNum  selectAll :: forall m v . (PersistBackend m, PersistEntity v)@@ -97,7 +97,7 @@         let query = "SELECT " <> fields <> " FROM " <> tableName esc e constr         queryFunc query [] $ mapAllRows $ mkEntity proxy cNum   e = entityDef (undefined :: v)-  proxy = undefined :: Proxy (PhantomDb m)+  proxy = undefined :: proxy (PhantomDb m)  getBy :: forall m v u . (PersistBackend m, PersistEntity v, IsUniqueKey (Key v (Unique u)))       => RenderConfig@@ -123,7 +123,7 @@ project conf@RenderConfig{..} queryFunc noLimit p options = doSelectQuery where   SelectOptions cond limit offset ords = getSelectOptions options   e = entityDef (undefined :: v)-  proxy = undefined :: Proxy (PhantomDb m)+  proxy = undefined :: proxy (PhantomDb m)   orders = renderOrders conf ords   (lim, limps) = case (limit, offset) of         (Nothing, Nothing) -> ("", [])@@ -137,15 +137,15 @@   whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'   doSelectQuery = queryFunc query binds $ mapAllRows $ liftM fst . projectionResult p   binds = fieldVals . maybe id getValues cond' $ limps-  constr = constructors e !! entityConstrNum (undefined :: Proxy v) (undefined :: c a)+  constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)  count :: forall m db r v c . (SqlDb db, QueryRaw db ~ Snippet 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)-      proxy = undefined :: Proxy (PhantomDb m)+      proxy = undefined :: proxy (PhantomDb m)       cond' = renderCond conf cond-      constr = constructors e !! entityConstrNum (undefined :: Proxy v) (undefined :: c a)+      constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)       query = "SELECT COUNT(*) FROM " <> tableName esc e constr <> whereClause where       whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'   x <- queryFunc query (maybe [] (flip getValues []) cond') id@@ -160,7 +160,7 @@ replace RenderConfig{..} queryFunc execFunc insertIntoConstructorTable k v = do   vals <- toEntityPersistValues' v   let e = entityDef v-      proxy = undefined :: Proxy (PhantomDb m)+      proxy = undefined :: proxy (PhantomDb m)       constructorNum = fromPrimitivePersistValue proxy (head vals)       constr = constructors e !! constructorNum       k' = toPrimitivePersistValue proxy k@@ -218,7 +218,7 @@   case renderUpdates conf upds of     Just upds' -> do       let cond' = renderCond conf cond-          constr = constructors e !! entityConstrNum (undefined :: Proxy v) (undefined :: c a)+          constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)           query = "UPDATE " <> tableName esc e constr <> " SET " <> whereClause where           whereClause = maybe (getQuery upds') (\c -> getQuery upds' <> " WHERE " <> getQuery c) cond'       execFunc query (getValues upds' <> maybe mempty getValues cond' $ [])@@ -228,7 +228,7 @@        => RenderConfig -> (Utf8 -> [PersistValue] -> m ()) -> Cond db r -> m () delete conf@RenderConfig{..} execFunc cond = execFunc query (maybe [] (($ []) . getValues) cond') where   e = entityDef (undefined :: v)-  constr = constructors e !! entityConstrNum (undefined :: Proxy v) (undefined :: c a)+  constr = constructors e !! entityConstrNum (undefined :: proxy v) (undefined :: c a)   cond' = renderCond conf cond   whereClause = maybe "" (\c -> " WHERE " <> getQuery c) cond'   query = if isSimple (constructors e)@@ -243,7 +243,7 @@             -> v -> m (Either (AutoKey v) (AutoKey v)) insertByAll RenderConfig{..} queryFunc manyNulls v = do   let e = entityDef v-      proxy = undefined :: Proxy (PhantomDb m)+      proxy = undefined :: proxy (PhantomDb m)       (constructorNum, uniques) = getUniques proxy v       constr = constructors e !! constructorNum       uniqueDefs = constrUniques constr@@ -266,7 +266,7 @@             => 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)-  proxy = undefined :: Proxy (PhantomDb m)+  proxy = undefined :: proxy (PhantomDb m)   constr = head $ constructors e   idName = if isSimple (constructors e)     then fromJust $ constrId esc constr@@ -285,7 +285,7 @@          => RenderConfig -> (forall a . Utf8 -> [PersistValue] -> (RowPopper m -> m a) -> m a) -> v -> m Int countAll RenderConfig{..} queryFunc (_ :: v) = do   let e = entityDef (undefined :: v)-      proxy = undefined :: Proxy (PhantomDb m)+      proxy = undefined :: proxy (PhantomDb m)       query = "SELECT COUNT(*) FROM " <> mainTableName esc e   x <- queryFunc query [] id   case x of@@ -301,7 +301,7 @@ 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-      proxy = undefined :: Proxy (PhantomDb m)+      proxy = undefined :: proxy (PhantomDb m)       uFields = renderChain conf (fieldChain 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@@ -322,7 +322,7 @@ constrId escape = fmap (escape . fromString) . constrAutoKeyName  -- | receives constructor number and row of values from the constructor table-mkEntity :: (PersistEntity v, PersistBackend m) => Proxy (PhantomDb m) -> Int -> [PersistValue] -> m (AutoKey v, v)+mkEntity :: (PersistEntity v, PersistBackend m) => proxy (PhantomDb m) -> Int -> [PersistValue] -> m (AutoKey v, v) mkEntity proxy i xs = fromEntityPersistValues (toPrimitivePersistValue proxy i:xs') >>= \(v, _) -> return (k, v) where   (k, xs') = fromPurePersistValues proxy xs
Database/Groundhog/Generic/Sql.hs view
@@ -119,7 +119,7 @@   ExprCond  a -> case renderCondPriority conf p a of                    Nothing -> error "renderExprPriority: empty condition"                    Just x -> x) where-    proxy = (undefined :: f db r -> Proxy db) expr+    proxy = (undefined :: f db r -> proxy db) expr     ensureOne :: [a] -> (a -> b) -> b     ensureOne xs f = case xs of       [x] -> f x@@ -132,7 +132,7 @@   ExprPure a -> let vals = toPurePersistValues proxy a []                 in map renderPersistValue vals   ExprCond a -> maybeToList $ renderCondPriority conf p a) where-  proxy = (undefined :: f db r -> Proxy db) expr+  proxy = (undefined :: f db r -> proxy db) expr  renderPersistValue :: PersistValue -> RenderS db r renderPersistValue (PersistCustom s as) = RenderS s (as++)
Database/Groundhog/Instances.hs view
@@ -470,10 +470,10 @@   projectionExprs c = ((map ExprField chains)++) where     chains = map (\f -> (f, [])) $ constrParams constr     e = entityDef ((undefined :: c (ConstructorMarker v) -> v) c)-    cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> Proxy v) c) c+    cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> proxy v) c) c     constr = constructors e !! cNum   projectionResult c xs = toSinglePersistValue cNum >>= \cNum' -> fromEntityPersistValues (cNum':xs) where-    cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> Proxy v) c) c+    cNum = entityConstrNum ((undefined :: c (ConstructorMarker v) -> proxy v) c) c  instance (PersistEntity v, IsUniqueKey k, k ~ Key v (Unique u), r ~ RestrictionHolder v c)       => Projection (u (UniqueMarker v)) db r k where@@ -530,7 +530,7 @@     k = (undefined :: AutoKeyField v c -> AutoKey v) a      e = entityDef ((undefined :: AutoKeyField v c -> v) a)-    cNum = entityConstrNum ((undefined :: AutoKeyField v c -> Proxy v) a) ((undefined :: AutoKeyField v c -> c (ConstructorMarker 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) db (RestrictionHolder v c) a where   fieldChain (SubField a) = a@@ -546,7 +546,7 @@     constr = head $ constructors (entityDef ((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+  entityConstrNum v = entityConstrNum' $ (undefined :: proxy v -> IsSumType v) v class EntityConstr' flag c where   entityConstrNum' :: flag -> c (a :: * -> *) -> Int instance EntityConstr' HFalse c where
+ changelog view
@@ -0,0 +1,66 @@+0.4.2.2+* Create missing schemas (or databases in MySQL terminology) during migration+* Replace datatype Proxy with type variable++0.4.2+* Cond can be used as expression+* Expressions instances for Fractional, Floating, Integral+* Operator case_++0.4.1+* Added functions replaceBy and deleteAll+* Renamed deleteByKey to deleteBy+* Instances of UTCTime and ZonedTime can read both values with time zone and without it++0.4.0.3+* Added function runDbConnNoTransaction to run a monadic action without creating a transaction around it++0.4.0.2+* Fix for nullable fields in unique constraint++0.4.0.1+* Added migration helper function Database.Groundhog.Generic.getQueries+* Added comparison function Database.Groundhog.Expression.isFieldNothing++0.4.0+* References to tables not mapped by groundhog+* Default column values+* Better type inference for expressions+* Constructor for empty condition CondEmpty+* Logging queries based on monad-logger++0.3.1+* Removed superclass constraints SinglePersistField and PurePersistField for PrimitivePersistField+* Fixed prefixing columns of nested embedded datatypes when not all names are specified++0.3+* Custom compositional functions and operators+* ConnectionManager which helps to extract connections from pools, application state, etc.+* Support for savepoints+* Schema qualified tables+* Added unique constraints of type PRIMARY+* Reference clauses ON DELETE and ON UPDATE.+* Exposed database introspection capabilities with class SchemaAnalyzer++0.2+* Database indexes+* Support DB-specific column types+* Renaming and refactoring++0.1.0.2+* Removed overly restrictive upper bound for bytestring package++0.1.0.1+* Compatibility with GHC 7.6++0.1.0+The library was almost completely overhauled.+* Support for embedded datatypes+* New syntax for select+* Embedded datatypes+* Composite foreign keys and natural keys+* Projections of datatype fields+* Codegeneration modules are moved to groundhog-th package++0.0.1+The first release. It has support for polymorphic datatypes and sum types.
groundhog.cabal view
@@ -1,5 +1,5 @@ name:            groundhog-version:         0.4.2.1+version:         0.4.2.2 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -11,6 +11,9 @@ cabal-version:   >= 1.6 build-type:      Simple homepage:        http://github.com/lykahb/groundhog++extra-source-files:+    changelog  library     build-depends:   base                     >= 4       && < 5