groundhog-postgresql 0.5.0 → 0.5.1

raw patch · 3 files changed

+51/−30 lines, 3 filesdep ~blaze-builderdep ~monad-controldep ~transformersPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• Database/Groundhog/Postgresql.hs +32/−15
• changelog +4/−0
• groundhog-postgresql.cabal +15/−15

@@ -9,6 +9,7 @@     , module Database.Groundhog.Generic.Sql.Functions     , explicitType     , castType+    , distinctOn     ) where  import Database.Groundhog@@ -42,7 +43,7 @@ import Data.Function (on) import Data.Int (Int64) import Data.IORef-import Data.List (groupBy, intercalate, stripPrefix)+import Data.List (groupBy, intercalate, isPrefixOf, stripPrefix) import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Monoid import Data.Pool@@ -75,7 +76,7 @@   insertByAll v = H.insertByAll renderConfig queryRaw' True v   replace k v = H.replace renderConfig queryRaw' executeRaw' (insertIntoConstructorTable False) k v   replaceBy k v = H.replaceBy renderConfig executeRaw' k v-  select options = H.select renderConfig queryRaw' "" options+  select options = H.select renderConfig queryRaw' preColumns "" options   selectAll = H.selectAll renderConfig queryRaw'   get k = H.get renderConfig queryRaw' k   getBy k = H.getBy renderConfig queryRaw' k@@ -85,7 +86,7 @@   deleteAll v = H.deleteAll renderConfig executeRaw' v   count cond = H.count renderConfig queryRaw' cond   countAll fakeV = H.countAll renderConfig queryRaw' fakeV-  project p options = H.project renderConfig queryRaw' "" p options+  project p options = H.project renderConfig queryRaw' preColumns "" p options   migrate fakeV = migrate' fakeV    executeRaw _ query ps = executeRaw' (fromString query) ps@@ -96,6 +97,7 @@  instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => SchemaAnalyzer (DbPersist Postgresql m) where   schemaExists schema = queryRaw' "SELECT 1 FROM information_schema.schemata WHERE schema_name=?" [toPrimitivePersistValue proxy schema] (fmap isJust)+  getCurrentSchema = queryRaw' "SELECT current_schema()" [] (fmap (>>= fst . fromPurePersistValues proxy))   listTables schema = queryRaw' "SELECT table_name FROM information_schema.tables WHERE table_schema=coalesce(?,current_schema())" [toPrimitivePersistValue proxy schema] (mapAllRows $ return . fst . fromPurePersistValues proxy)   listTableTriggers schema name = queryRaw' "SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,current_schema()) AND event_object_table=?" [toPrimitivePersistValue proxy schema, toPrimitivePersistValue proxy name] (mapAllRows $ return . fst . fromPurePersistValues proxy)   analyzeTable = analyzeTable'@@ -207,13 +209,15 @@  insertIntoConstructorTable :: Bool -> Bool -> Utf8 -> ConstructorDef -> [PersistValue] -> RenderS db r insertIntoConstructorTable withRet withId tName c vals = RenderS query vals' where-  query = "INSERT INTO " <> tName <> "(" <> fieldNames <> ")VALUES(" <> placeholders <> ")" <> returning+  query = "INSERT INTO " <> tName <> columnsValues <> returning   (fields, returning) = case constrAutoKeyName c of     Just idName -> (fields', returning') where       fields' = if withId then (idName, dbType (0 :: Int64)):constrParams c else constrParams c-      returning' = if withRet then "RETURNING(" <> escapeS (fromString idName) <> ")" else mempty+      returning' = if withRet then " RETURNING(" <> escapeS (fromString idName) <> ")" else mempty     _           -> (constrParams c, mempty)-  fieldNames   = renderFields escapeS fields+  columnsValues = case foldr (flatten escapeS) [] fields of+    [] -> " DEFAULT VALUES"+    xs -> "(" <> commasJoin xs <> ") VALUES(" <> placeholders <> ")"   RenderS placeholders vals' = commasJoin $ map renderPersistValue vals  insertList' :: forall m a.(MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistField a) => [a] -> DbPersist Postgresql m Int64@@ -274,9 +278,8 @@  migrate' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> Migration (DbPersist Postgresql m) migrate' v = do-  x <- lift $ queryRaw' "SELECT current_schema()" [] id-  let schema = fst $ fromPurePersistValues proxy $ fromJust x-      migPack = migrationPack schema+  schema <- lift getCurrentSchema+  let migPack = migrationPack $ fromJust schema   migrateRecursively (migrateSchema migPack) (migrateEntity migPack) (migrateList migPack) v  migrationPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => String -> GM.MigrationPack (DbPersist Postgresql m)@@ -372,7 +375,6 @@   table <- queryRaw' "SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, current_schema()) AND table_name = ?" [toPrimitivePersistValue proxy schema, toPrimitivePersistValue proxy name] id   case table of     Just _ -> do-      -- omit primary keys       let colQuery = "SELECT c.column_name, c.is_nullable, c.udt_name, c.column_default, c.character_maximum_length, c.numeric_precision, c.numeric_scale, c.datetime_precision, c.interval_type, a.attndims AS array_dims, te.typname AS array_elem\ \  FROM pg_catalog.pg_attribute a\ \  INNER JOIN pg_catalog.pg_class cl ON cl.oid = a.attrelid\@@ -390,7 +392,10 @@       uniqPrimary <- queryRaw' constraintQuery [toPrimitivePersistValue proxy ("PRIMARY KEY" :: String), toPrimitivePersistValue proxy schema, toPrimitivePersistValue proxy name] (mapAllRows $ return . fst . fromPurePersistValues proxy)       uniqIndexes <- queryRaw' "SELECT ic.relname, a.attname FROM pg_catalog.pg_attribute a INNER JOIN pg_catalog.pg_class ic ON ic.oid = a.attrelid INNER JOIN pg_catalog.pg_index i ON i.indexrelid = ic.oid INNER JOIN pg_catalog.pg_class tc ON i.indrelid = tc.oid INNER JOIN pg_namespace sch ON sch.oid = tc.relnamespace WHERE sch.nspname = coalesce(?, current_schema()) AND tc.relname = ? AND a.attnum > 0 AND NOT a.attisdropped AND ic.oid NOT IN (SELECT conindid FROM pg_catalog.pg_constraint) AND NOT i.indisprimary AND i.indisunique ORDER BY ic.relname, a.attnum" [toPrimitivePersistValue proxy schema, toPrimitivePersistValue proxy name] (mapAllRows $ return . fst . fromPurePersistValues proxy)       let mkUniqs typ = map (\us -> UniqueDef' (fst $ head us) typ (map snd us)) . groupBy ((==) `on` fst)-      let uniqs = mkUniqs UniqueConstraint uniqConstraints ++ mkUniqs UniqueIndex uniqIndexes ++ mkUniqs UniquePrimary uniqPrimary+          isAutoincremented = case filter (\c -> colName c `elem` map snd uniqPrimary) cols of+                                [c] -> colType c `elem` [DbInt32, DbInt64] && maybe False ("nextval" `isPrefixOf`) (colDefault c)+                                _ -> False+      let uniqs = mkUniqs UniqueConstraint uniqConstraints ++ mkUniqs UniqueIndex uniqIndexes ++ mkUniqs (UniquePrimary isAutoincremented) uniqPrimary       references <- analyzeTableReferences schema name       return $ Just $ TableInfo cols uniqs references     Nothing -> return Nothing@@ -471,7 +476,7 @@   , intercalate "," $ map escape cols   , ")"   ])]-showAlterTable table (AddUnique (UniqueDef' uName UniquePrimary cols)) = [(False, defaultPriority, concat+showAlterTable table (AddUnique (UniqueDef' uName (UniquePrimary _) cols)) = [(False, defaultPriority, concat   [ "ALTER TABLE "   , table   , " ADD"@@ -600,9 +605,7 @@   DbAutoKey -> showSqlType DbInt64  compareUniqs :: UniqueDef' -> UniqueDef' -> Bool-compareUniqs (UniqueDef' _ UniquePrimary cols1) (UniqueDef' _ UniquePrimary cols2) = haveSameElems (==) cols1 cols2--- only one of the uniques is primary-compareUniqs (UniqueDef' _ type1 _) (UniqueDef' _ type2 _) | UniquePrimary `elem` [type1, type2] = False+compareUniqs (UniqueDef' _ (UniquePrimary _) cols1) (UniqueDef' _ (UniquePrimary _) cols2) = haveSameElems (==) cols1 cols2 compareUniqs (UniqueDef' name1 type1 cols1) (UniqueDef' name2 type2 cols2) = fromMaybe True (liftM2 (==) name1 name2) && type1 == type2 && haveSameElems (==) cols1 cols2  compareRefs :: String -> (Maybe String, Reference) -> (Maybe String, Reference) -> Bool@@ -765,3 +768,17 @@ -- | Casts expression to a type. @castType value \"INT\"@ results in @value::INT@. castType :: Expression Postgresql r a => a -> String -> Expr Postgresql r a castType a t = mkExpr $ Snippet $ \conf _ -> ["(" <> renderExpr conf (toExpr a) <> ")::" <> fromString t] where++-- | Distinct only on certain fields or expressions. For example, @select $ CondEmpty `distinctOn` (lower EmailField, IpField)@.+distinctOn :: (db ~ Postgresql, HasSelectOptions a db r, HasDistinct a ~ HFalse, Projection' p db r p') => a -> p -> SelectOptions db r (HasLimit a) (HasOffset a) (HasOrder a) HTrue+distinctOn opts p = opts' {dbSpecificOptions = ("DISTINCT_ON", clause): dbSpecificOptions opts'} where+  opts' = getSelectOptions opts+  clause = Snippet $ \conf _ -> [commasJoin $ concatMap (renderExprExtended conf 0) $ projectionExprs p []]++preColumns :: HasSelectOptions opts Postgresql r => opts -> RenderS Postgresql r+preColumns opts = clause where+  clause = apply "DISTINCT_ON" (\t -> "DISTINCT ON (" <> t <> ")")+  apply k f = case lookup k opts' of+    Nothing -> mempty+    Just (Snippet snippet) -> f $ head $ snippet renderConfig 0+  opts' = dbSpecificOptions $ getSelectOptions opts

@@ -1,3 +1,7 @@+0.5.1+* DISTINCT ON select option+* Add getCurrentSchema function into SchemaAnalyzer+ 0.5.0 * Simplified Geometry and Array function type signatures * Compatibility with GHC 7.8

@@ -1,5 +1,5 @@ name:            groundhog-postgresql-version:         0.5.0+version:         0.5.1 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -15,20 +15,20 @@     changelog  library-    build-depends:   base                    >= 4         && < 5-                   , postgresql-simple       >= 0.3       && < 0.5-                   , postgresql-libpq        >= 0.6.1-                   , bytestring              >= 0.9-                   , blaze-builder           >= 0.3.0.0-                   , transformers            >= 0.2.1-                   , groundhog               >= 0.5.0     && < 0.6.0-                   , monad-control           >= 0.3-                   , monad-logger            >= 0.3-                   , containers              >= 0.2-                   , text                    >= 0.8-                   , attoparsec              >= 0.8.5.3-                   , resource-pool           >= 0.2.1-                   , time                    >= 1.1+    build-depends:   base                     >= 4         && < 5+                   , postgresql-simple        >= 0.3       && < 0.5+                   , postgresql-libpq         >= 0.6.1+                   , bytestring               >= 0.9+                   , blaze-builder            >= 0.3.0.0   && < 0.4+                   , transformers             >= 0.2.1     && < 0.5+                   , groundhog                >= 0.5.0     && < 0.6.0+                   , monad-control            >= 0.3       && < 0.4+                   , monad-logger             >= 0.3+                   , containers               >= 0.2+                   , text                     >= 0.8+                   , attoparsec               >= 0.8.5.3+                   , resource-pool            >= 0.2.1+                   , time                     >= 1.1     exposed-modules: Database.Groundhog.Postgresql                      Database.Groundhog.Postgresql.Array                      Database.Groundhog.Postgresql.Geometry