diff --git a/Database/Groundhog/Postgresql.hs b/Database/Groundhog/Postgresql.hs --- a/Database/Groundhog/Postgresql.hs +++ b/Database/Groundhog/Postgresql.hs @@ -36,10 +36,11 @@ import Control.Exception (throw) import Control.Monad (forM, liftM, liftM2, (>=>)) import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Logger (MonadLogger, logDebugS) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Reader (ask) +import Control.Monad.Trans.State (mapStateT) +import Data.Acquire (mkAcquire) import Data.ByteString.Char8 (pack, unpack, copy) import Data.Char (isAlphaNum, isSpace, toUpper) import Data.Function (on) @@ -70,45 +71,47 @@ log' x = mkExpr $ function "ln" [toExpr x] logBase' b x = log (liftExpr x) / log (liftExpr b) -instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => PersistBackend (DbPersist Postgresql m) where - type PhantomDb (DbPersist Postgresql m) = Postgresql - insert v = insert' v - insert_ v = insert_' v - insertBy u v = H.insertBy renderConfig queryRaw' True u v - 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' preColumns "" options - selectAll = H.selectAll renderConfig queryRaw' - get k = H.get renderConfig queryRaw' k - getBy k = H.getBy renderConfig queryRaw' k - update upds cond = H.update renderConfig executeRaw' upds cond - delete cond = H.delete renderConfig executeRaw' cond - deleteBy k = H.deleteBy renderConfig executeRaw' k - 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' preColumns "" p options - migrate fakeV = migrate' fakeV +instance PersistBackendConn Postgresql where + insert v = runDb' $ insert' v + insert_ v = runDb' $ insert_' v + insertBy u v = runDb' $ H.insertBy renderConfig queryRaw' True u v + insertByAll v = runDb' $ H.insertByAll renderConfig queryRaw' True v + replace k v = runDb' $ H.replace renderConfig queryRaw' executeRaw' (insertIntoConstructorTable False) k v + replaceBy k v = runDb' $ H.replaceBy renderConfig executeRaw' k v + select options = runDb' $ H.select renderConfig queryRaw' preColumns "" options + selectStream options = runDb' $ H.selectStream renderConfig queryRaw' preColumns "" options + selectAll = runDb' $ H.selectAll renderConfig queryRaw' + selectAllStream = runDb' $ H.selectAllStream renderConfig queryRaw' + get k = runDb' $ H.get renderConfig queryRaw' k + getBy k = runDb' $ H.getBy renderConfig queryRaw' k + update upds cond = runDb' $ H.update renderConfig executeRaw' upds cond + delete cond = runDb' $ H.delete renderConfig executeRaw' cond + deleteBy k = runDb' $ H.deleteBy renderConfig executeRaw' k + deleteAll v = runDb' $ H.deleteAll renderConfig executeRaw' v + count cond = runDb' $ H.count renderConfig queryRaw' cond + countAll fakeV = runDb' $ H.countAll renderConfig queryRaw' fakeV + project p options = runDb' $ H.project renderConfig queryRaw' preColumns "" p options + projectStream p options = runDb' $ H.projectStream renderConfig queryRaw' preColumns "" p options + migrate fakeV = mapStateT runDb' $ migrate' fakeV - executeRaw _ query ps = executeRaw' (fromString query) ps - queryRaw _ query ps f = queryRaw' (fromString query) ps f + executeRaw _ query ps = runDb' $ executeRaw' (fromString query) ps + queryRaw _ query ps = runDb' $ queryRaw' (fromString query) ps - insertList l = insertList' l - getList k = getList' k + insertList l = runDb' $ insertList' l + getList k = runDb' $ getList' k -instance (MonadBaseControl IO m, MonadIO m, MonadLogger m) => SchemaAnalyzer (DbPersist Postgresql m) where - schemaExists schema = queryRaw' "SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname=?" [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 name = queryRaw' "SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,current_schema()) AND event_object_table=?" (toPurePersistValues proxy name []) (mapAllRows $ return . fst . fromPurePersistValues proxy) - analyzeTable = analyzeTable' - analyzeTrigger name = do - x <- queryRaw' "SELECT action_statement FROM information_schema.triggers WHERE trigger_schema=coalesce(?,current_schema()) AND trigger_name=?" (toPurePersistValues proxy name []) id +instance SchemaAnalyzer Postgresql where + schemaExists schema = runDb' $ queryRaw' "SELECT 1 FROM pg_catalog.pg_namespace WHERE nspname=?" [toPrimitivePersistValue schema] >>= firstRow >>= return . isJust + getCurrentSchema = runDb' $ queryRaw' "SELECT current_schema()" [] >>= firstRow >>= return . (>>= fst . fromPurePersistValues) + listTables schema = runDb' $ queryRaw' "SELECT table_name FROM information_schema.tables WHERE table_schema=coalesce(?,current_schema())" [toPrimitivePersistValue schema] >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList + listTableTriggers name = runDb' $ queryRaw' "SELECT trigger_name FROM information_schema.triggers WHERE event_object_schema=coalesce(?,current_schema()) AND event_object_table=?" (toPurePersistValues name []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList + analyzeTable = runDb' . analyzeTable' + analyzeTrigger name = runDb' $ do + x <- queryRaw' "SELECT action_statement FROM information_schema.triggers WHERE trigger_schema=coalesce(?,current_schema()) AND trigger_name=?" (toPurePersistValues name []) >>= firstRow return $ case x of Nothing -> Nothing - Just src -> fst $ fromPurePersistValues proxy src - analyzeFunction name = do + Just src -> fst $ fromPurePersistValues src + analyzeFunction name = runDb' $ do let query = "SELECT arg_types.typname, arg_types.typndims, arg_types_te.typname, ret.typname, ret.typndims, ret_te.typname, p.prosrc\ \ FROM pg_catalog.pg_namespace n\ \ INNER JOIN pg_catalog.pg_proc p ON p.pronamespace = n.oid\ @@ -118,16 +121,16 @@ \ INNER JOIN pg_type ret ON p.prorettype = ret.oid\ \ LEFT JOIN pg_type ret_te ON ret_te.oid = ret.typelem\ \ WHERE n.nspname = coalesce(?,current_schema()) AND p.proname = ?" - result <- queryRaw' query (toPurePersistValues proxy name []) (mapAllRows $ return . fst . fromPurePersistValues proxy) + result <- queryRaw' query (toPurePersistValues name []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList let read' (typ, arr) = readSqlType typ (Nothing, Nothing, Nothing, Nothing, Nothing) arr return $ case result of [] -> Nothing ((_, (ret, src)):_) -> Just $ (Just $ map read' args, Just $ read' ret, src) where args = mapMaybe (\(typ, arr) -> fmap (\typ' -> (typ', arr)) typ) $ map fst result - getMigrationPack = fmap (migrationPack . fromJust) getCurrentSchema + getMigrationPack = liftM (migrationPack . fromJust) getCurrentSchema withPostgresqlPool :: (MonadBaseControl IO m, MonadIO m) - => String -- ^ connection string + => String -- ^ connection string in keyword\/value format like "host=localhost port=5432 dbname=mydb". For more details and options see http://www.postgresql.org/docs/9.4/static/libpq-connect.html#LIBPQ-PARAMKEYWORDS -> Int -- ^ number of connections to open -> (Pool Postgresql -> m a) -> m a @@ -153,19 +156,18 @@ liftIO $ PG.execute_ c $ "RELEASE SAVEPOINT" <> name' return x -instance ConnectionManager Postgresql Postgresql where +instance ConnectionManager Postgresql where withConn f conn@(Postgresql c) = do liftIO $ PG.begin c x <- onException (f conn) (liftIO $ PG.rollback c) liftIO $ PG.commit c return x - withConnNoTransaction f conn = f conn -instance ConnectionManager (Pool Postgresql) Postgresql where - withConn f pconn = withResource pconn (withConn f) - withConnNoTransaction f pconn = withResource pconn (withConnNoTransaction f) +instance ExtractConnection Postgresql Postgresql where + extractConn f conn = f conn -instance SingleConnectionManager Postgresql Postgresql +instance ExtractConnection (Pool Postgresql) Postgresql where + extractConn f pconn = withResource pconn f open' :: String -> IO Postgresql open' s = do @@ -176,12 +178,12 @@ close' :: Postgresql -> IO () close' (Postgresql conn) = PG.close conn -insert' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist Postgresql m (AutoKey v) +insert' :: (PersistEntity v) => v -> Action Postgresql (AutoKey v) insert' v = do -- constructor number and the rest of the field values vals <- toEntityPersistValues' v let e = entityDef proxy v - let constructorNum = fromPrimitivePersistValue proxy (head vals) + let constructorNum = fromPrimitivePersistValue (head vals) liftM fst $ if isSimple (constructors e) then do @@ -190,24 +192,24 @@ case constrAutoKeyName constr of Nothing -> executeRaw' query (vals' []) >> pureFromPersistValue [] Just _ -> do - x <- queryRaw' query (vals' []) id + x <- queryRaw' query (vals' []) >>= firstRow case x of Just xs -> pureFromPersistValue xs Nothing -> pureFromPersistValue [] else do let constr = constructors e !! constructorNum let query = "INSERT INTO " <> mainTableName escapeS e <> "(discr)VALUES(?)RETURNING(id)" - rowid <- queryRaw' query (take 1 vals) getKey + rowid <- queryRaw' query (take 1 vals) >>= getKey let RenderS cQuery vals' = insertIntoConstructorTable False True (tableName escapeS e constr) constr (rowid:tail vals) executeRaw' cQuery (vals' []) pureFromPersistValue [rowid] -insert_' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> DbPersist Postgresql m () +insert_' :: (PersistEntity v) => v -> Action Postgresql () insert_' v = do -- constructor number and the rest of the field values vals <- toEntityPersistValues' v let e = entityDef proxy v - let constructorNum = fromPrimitivePersistValue proxy (head vals) + let constructorNum = fromPrimitivePersistValue (head vals) if isSimple (constructors e) then do @@ -217,7 +219,7 @@ else do let constr = constructors e !! constructorNum let query = "INSERT INTO " <> mainTableName escapeS e <> "(discr)VALUES(?)RETURNING(id)" - rowid <- queryRaw' query (take 1 vals) getKey + rowid <- queryRaw' query (take 1 vals) >>= getKey let RenderS cQuery vals' = insertIntoConstructorTable False True (tableName escapeS e constr) constr (rowid:tail vals) executeRaw' cQuery (vals' []) @@ -234,41 +236,40 @@ 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 +insertList' :: forall a . PersistField a => [a] -> Action Postgresql Int64 insertList' (l :: [a]) = do let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a)) - k <- queryRaw' ("INSERT INTO " <> escapeS mainName <> " DEFAULT VALUES RETURNING(id)") [] getKey + k <- queryRaw' ("INSERT INTO " <> escapeS mainName <> " DEFAULT VALUES RETURNING(id)") [] >>= getKey let valuesName = mainName <> delim' <> "values" let fields = [("ord", dbType proxy (0 :: Int)), ("value", dbType proxy (undefined :: a))] let query = "INSERT INTO " <> escapeS valuesName <> "(id," <> renderFields escapeS fields <> ")VALUES(?," <> renderFields (const $ fromChar '?') fields <> ")" - let go :: Int -> [a] -> DbPersist Postgresql m () + let go :: Int -> [a] -> Action Postgresql () go n (x:xs) = do x' <- toPersistValues x - executeRaw' query $ (k:) . (toPrimitivePersistValue proxy n:) . x' $ [] + executeRaw' query $ (k:) . (toPrimitivePersistValue n:) . x' $ [] go (n + 1) xs go _ [] = return () go 0 l - return $ fromPrimitivePersistValue proxy k + return $ fromPrimitivePersistValue k -getList' :: forall m a.(MonadBaseControl IO m, MonadIO m, MonadLogger m, PersistField a) => Int64 -> DbPersist Postgresql m [a] +getList' :: forall a . PersistField a => Int64 -> Action Postgresql [a] getList' k = do let mainName = "List" <> delim' <> delim' <> fromString (persistName (undefined :: a)) let valuesName = mainName <> delim' <> "values" let value = ("value", dbType proxy (undefined :: a)) let query = "SELECT " <> renderFields escapeS [value] <> " FROM " <> escapeS valuesName <> " WHERE id=? ORDER BY ord" - queryRaw' query [toPrimitivePersistValue proxy k] $ mapAllRows (liftM fst . fromPersistValues) + queryRaw' query [toPrimitivePersistValue k] >>= mapStream (liftM fst . fromPersistValues) >>= streamToList --TODO: consider removal -{-# SPECIALIZE getKey :: RowPopper (DbPersist Postgresql IO) -> DbPersist Postgresql IO PersistValue #-} -getKey :: MonadIO m => RowPopper (DbPersist Postgresql m) -> DbPersist Postgresql m PersistValue -getKey pop = pop >>= \(Just [k]) -> return k +getKey :: RowStream [PersistValue] -> Action Postgresql PersistValue +getKey stream = firstRow stream >>= \(Just [k]) -> return k ---------- -executeRaw' :: (MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> DbPersist Postgresql m () +executeRaw' :: Utf8 -> [PersistValue] -> Action Postgresql () executeRaw' query vals = do - $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals - Postgresql conn <- DbPersist ask +-- $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals + Postgresql conn <- ask let stmt = getStatement query liftIO $ do _ <- PG.execute conn stmt (map P vals) @@ -285,35 +286,36 @@ delim' :: Utf8 delim' = fromChar delim -toEntityPersistValues' :: (MonadBaseControl IO m, MonadIO m, PersistEntity v, MonadLogger m) => v -> DbPersist Postgresql m [PersistValue] +toEntityPersistValues' :: PersistEntity v => v -> Action Postgresql [PersistValue] toEntityPersistValues' = liftM ($ []) . toEntityPersistValues --- MIGRATION -migrate' :: (PersistEntity v, MonadBaseControl IO m, MonadIO m, MonadLogger m) => v -> Migration (DbPersist Postgresql m) +migrate' :: (PersistEntity v) => v -> Migration (Action Postgresql) migrate' v = do migPack <- lift $ getMigrationPack migrateRecursively (migrateSchema migPack) (migrateEntity migPack) (migrateList migPack) v -migrationPack :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => String -> GM.MigrationPack (DbPersist Postgresql m) -migrationPack currentSchema = GM.MigrationPack - compareTypes - (compareRefs currentSchema) - compareUniqs - compareDefaults - migTriggerOnDelete - migTriggerOnUpdate - GM.defaultMigConstr - escape - "BIGSERIAL PRIMARY KEY UNIQUE" - mainTableId - defaultPriority - (\uniques refs -> ([], map AddUnique uniques ++ map AddReference refs)) - showSqlType - showColumn - showAlterDb - NoAction - NoAction +migrationPack :: String -> GM.MigrationPack Postgresql +migrationPack currentSchema = m where + m = GM.MigrationPack + compareTypes + (compareRefs currentSchema) + compareUniqs + compareDefaults + migTriggerOnDelete + migTriggerOnUpdate + (GM.defaultMigConstr m) + escape + "BIGSERIAL PRIMARY KEY UNIQUE" + mainTableId + defaultPriority + (\uniques refs -> ([], map AddUnique uniques ++ map AddReference refs)) + showSqlType + showColumn + showAlterDb + NoAction + NoAction showColumn :: Column -> String showColumn (Column n nu t def) = concat @@ -327,7 +329,7 @@ Just s -> " DEFAULT " ++ s ] -migTriggerOnDelete :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> [(String, String)] -> DbPersist Postgresql m (Bool, [AlterDB]) +migTriggerOnDelete :: QualifiedName -> [(String, String)] -> Action Postgresql (Bool, [AlterDB]) migTriggerOnDelete tName deletes = do let funcName = tName trigName = tName @@ -361,7 +363,7 @@ -- | Table name and a list of field names and according delete statements -- assume that this function is called only for ephemeral fields -migTriggerOnUpdate :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> [(String, String)] -> DbPersist Postgresql m [(Bool, [AlterDB])] +migTriggerOnUpdate :: QualifiedName -> [(String, String)] -> Action Postgresql [(Bool, [AlterDB])] migTriggerOnUpdate tName dels = forM dels $ \(fieldName, del) -> do let funcName = second (\name -> name ++ delim : fieldName) tName let trigName = second (\name -> name ++ delim : fieldName) tName @@ -387,9 +389,9 @@ else [DropTrigger trigName tName, addTrigger]) return (trigExisted, funcMig ++ trigMig) -analyzeTable' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> DbPersist Postgresql m (Maybe TableInfo) +analyzeTable' :: QualifiedName -> Action Postgresql (Maybe TableInfo) analyzeTable' name = do - table <- queryRaw' "SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, current_schema()) AND table_name = ?" (toPurePersistValues proxy name []) id + table <- queryRaw' "SELECT * FROM information_schema.tables WHERE table_schema = coalesce(?, current_schema()) AND table_name = ?" (toPurePersistValues name []) >>= firstRow case table of Just _ -> do 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\ @@ -402,11 +404,11 @@ \ WHERE c.table_schema = coalesce(?, current_schema()) AND c.table_name=?\ \ ORDER BY c.ordinal_position" - cols <- queryRaw' colQuery (toPurePersistValues proxy name []) (mapAllRows $ return . getColumn . fst . fromPurePersistValues proxy) + cols <- queryRaw' colQuery (toPurePersistValues name []) >>= mapStream (return . getColumn . fst . fromPurePersistValues) >>= streamToList let constraintQuery = "SELECT u.constraint_name, u.column_name FROM information_schema.table_constraints tc INNER JOIN information_schema.constraint_column_usage u ON tc.constraint_catalog=u.constraint_catalog AND tc.constraint_schema=u.constraint_schema AND tc.constraint_name=u.constraint_name WHERE tc.constraint_type=? AND tc.table_schema=coalesce(?,current_schema()) AND u.table_name=? ORDER BY u.constraint_name, u.column_name" - uniqConstraints <- queryRaw' constraintQuery (toPurePersistValues proxy ("UNIQUE" :: String, name) []) (mapAllRows $ return . fst . fromPurePersistValues proxy) - uniqPrimary <- queryRaw' constraintQuery (toPurePersistValues proxy ("PRIMARY KEY" :: String, name) []) (mapAllRows $ return . fst . fromPurePersistValues proxy) + uniqConstraints <- queryRaw' constraintQuery (toPurePersistValues ("UNIQUE" :: String, name) []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList + uniqPrimary <- queryRaw' constraintQuery (toPurePersistValues ("PRIMARY KEY" :: String, name) []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList -- indexes with system columns like oid are omitted let indexQuery = "WITH indexes as (\ \SELECT ic.oid, ic.relname,\ @@ -428,7 +430,7 @@ \ INNER JOIN (SELECT oid FROM indexes\ \ GROUP BY oid\ \ HAVING every(attnum > 0 OR attnum IS NULL)) non_system ON i.oid = non_system.oid" - uniqIndexes <- queryRaw' indexQuery (toPurePersistValues proxy name []) (mapAllRows $ return . fst . fromPurePersistValues proxy) + uniqIndexes <- queryRaw' indexQuery (toPurePersistValues name []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList let mkUniqs typ = map (\us -> UniqueDef (fst $ head us) typ (map snd us)) . groupBy ((==) `on` fst) isAutoincremented = case filter (\c -> colName c `elem` map snd uniqPrimary) cols of [c] -> colType c `elem` [DbInt32, DbInt64] && maybe False ("nextval" `isPrefixOf`) (colDefault c) @@ -444,7 +446,7 @@ getColumn ((column_name, is_nullable, udt_name, d), modifiers, arr_info) = Column column_name (is_nullable == "YES") t d where t = readSqlType udt_name modifiers arr_info -analyzeTableReferences :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => QualifiedName -> DbPersist Postgresql m [(Maybe String, Reference)] +analyzeTableReferences :: QualifiedName -> Action Postgresql [(Maybe String, Reference)] analyzeTableReferences tName = do let sql = "SELECT c.conname, sch_parent.nspname, cl_parent.relname, c. confdeltype, c.confupdtype, a_child.attname AS child, a_parent.attname AS parent FROM\ \ (SELECT r.conrelid, r.confrelid, unnest(r.conkey) AS conkey, unnest(r.confkey) AS confkey, r.conname, r.confupdtype, r.confdeltype\ @@ -458,7 +460,7 @@ \ INNER JOIN pg_namespace sch_child ON sch_child.oid = cl_child.relnamespace\ \ WHERE sch_child.nspname = coalesce(?, current_schema()) AND cl_child.relname = ?\ \ ORDER BY c.conname" - x <- queryRaw' sql (toPurePersistValues proxy tName []) $ mapAllRows (return . fst . fromPurePersistValues proxy) + x <- queryRaw' sql (toPurePersistValues tName []) >>= mapStream (return . fst . fromPurePersistValues) >>= streamToList -- (refName, ((parentTableSchema, parentTable, onDelete, onUpdate), (childColumn, parentColumn))) let mkReference xs = (Just refName, Reference parentTable pairs (mkAction onDelete) (mkAction onUpdate)) where pairs = map (snd . snd) xs @@ -685,63 +687,66 @@ getStatement :: Utf8 -> PG.Query getStatement sql = PG.Query $ fromUtf8 sql -queryRaw' :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) => Utf8 -> [PersistValue] -> (RowPopper (DbPersist Postgresql m) -> DbPersist Postgresql m a) -> DbPersist Postgresql m a -queryRaw' query vals f = do - $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals - Postgresql conn <- DbPersist ask - rawquery <- liftIO $ PG.formatQuery conn (getStatement query) (map P vals) - -- Take raw connection - (ret, rowRef, rowCount, getters) <- liftIO $ PG.withConnection conn $ \rawconn -> do - -- Execute query - mret <- LibPQ.exec rawconn rawquery - case mret of - Nothing -> do - merr <- LibPQ.errorMessage rawconn - fail $ case merr of - Nothing -> "Postgresql.withStmt': unknown error" - Just e -> "Postgresql.withStmt': " ++ unpack e - Just ret -> do - -- Check result status - status <- LibPQ.resultStatus ret - case status of - LibPQ.TuplesOk -> return () - _ -> do - msg <- LibPQ.resStatus status - merr <- LibPQ.errorMessage rawconn - fail $ "Postgresql.withStmt': bad result status " ++ - show status ++ " (" ++ show msg ++ ")" ++ - maybe "" ((". Error message: " ++) . unpack) merr +queryRaw' :: Utf8 -> [PersistValue] -> Action Postgresql (RowStream [PersistValue]) +queryRaw' query vals = do +-- $logDebugS "SQL" $ fromString $ show (fromUtf8 query) ++ " " ++ show vals + Postgresql conn <- ask + let open = do + rawquery <- PG.formatQuery conn (getStatement query) (map P vals) + -- Take raw connection + (ret, rowRef, rowCount, getters) <- PG.withConnection conn $ \rawconn -> do + -- Execute query + mret <- LibPQ.exec rawconn rawquery + case mret of + Nothing -> do + merr <- LibPQ.errorMessage rawconn + fail $ case merr of + Nothing -> "Postgresql.queryRaw': unknown error" + Just e -> "Postgresql.queryRaw': " ++ unpack e + Just ret -> do + -- Check result status + status <- LibPQ.resultStatus ret + case status of + LibPQ.TuplesOk -> return () + _ -> do + msg <- LibPQ.resStatus status + merr <- LibPQ.errorMessage rawconn + fail $ "Postgresql.queryRaw': bad result status " ++ + show status ++ " (" ++ show msg ++ ")" ++ + maybe "" ((". Error message: " ++) . unpack) merr - -- Get number and type of columns - cols <- LibPQ.nfields ret - getters <- forM [0..cols-1] $ \col -> do - oid <- LibPQ.ftype ret col - return $ getGetter oid $ PG.Field ret col oid - -- Ready to go! - rowRef <- newIORef (LibPQ.Row 0) - rowCount <- LibPQ.ntuples ret - return (ret, rowRef, rowCount, getters) + -- Get number and type of columns + cols <- LibPQ.nfields ret + getters <- forM [0..cols-1] $ \col -> do + oid <- LibPQ.ftype ret col + return $ getGetter oid $ PG.Field ret col oid + -- Ready to go! + rowRef <- newIORef (LibPQ.Row 0) + rowCount <- LibPQ.ntuples ret + return (ret, rowRef, rowCount, getters) - f $ liftIO $ do - row <- atomicModifyIORef rowRef (\r -> (r+1, r)) - if row == rowCount - then return Nothing - else liftM Just $ forM (zip getters [0..]) $ \(getter, col) -> do - mbs <- {-# SCC "getvalue'" #-} LibPQ.getvalue' ret row col - case mbs of - Nothing -> return PersistNull - Just bs -> do - ok <- PGFF.runConversion (getter mbs) conn - bs `seq` case ok of - Errors (exc:_) -> throw exc - Errors [] -> error "Got an Errors, but no exceptions" - Ok v -> return v + return $ do + row <- atomicModifyIORef rowRef (\r -> (r+1, r)) + if row == rowCount + then return Nothing + else liftM Just $ forM (zip getters [0..]) $ \(getter, col) -> do + mbs <- LibPQ.getvalue' ret row col + case mbs of + Nothing -> return PersistNull + Just bs -> do + ok <- PGFF.runConversion (getter mbs) conn + bs `seq` case ok of + Errors (exc:_) -> throw exc + Errors [] -> error "Got an Errors, but no exceptions" + Ok v -> return v + return $ mkAcquire open (const $ return ()) -- | Avoid orphan instances. newtype P = P PersistValue instance PGTF.ToField P where toField (P (PersistString t)) = PGTF.toField t + toField (P (PersistText t)) = PGTF.toField t toField (P (PersistByteString bs)) = PGTF.toField (PG.Binary bs) toField (P (PersistInt64 i)) = PGTF.toField i toField (P (PersistDouble d)) = PGTF.toField d @@ -762,19 +767,19 @@ getGetter (PG.Oid oid) = case oid of 16 -> convertPV PersistBool 17 -> convertPV (PersistByteString . unBinary) - 18 -> convertPV PersistString - 19 -> convertPV PersistString + 18 -> convertPV PersistText + 19 -> convertPV PersistText 20 -> convertPV PersistInt64 21 -> convertPV PersistInt64 23 -> convertPV PersistInt64 - 25 -> convertPV PersistString - 142 -> convertPV PersistString + 25 -> convertPV PersistText + 142 -> convertPV PersistText 700 -> convertPV PersistDouble 701 -> convertPV PersistDouble 702 -> convertPV PersistUTCTime 703 -> convertPV PersistUTCTime - 1042 -> convertPV PersistString - 1043 -> convertPV PersistString + 1042 -> convertPV PersistText + 1043 -> convertPV PersistText 1082 -> convertPV PersistDay 1083 -> convertPV PersistTimeOfDay 1114 -> convertPV (PersistUTCTime . localTimeToUTC utc) diff --git a/Database/Groundhog/Postgresql/Array.hs b/Database/Groundhog/Postgresql/Array.hs --- a/Database/Groundhog/Postgresql/Array.hs +++ b/Database/Groundhog/Postgresql/Array.hs @@ -32,6 +32,8 @@ import Blaze.ByteString.Builder (fromByteString, toByteString) import Blaze.ByteString.Builder.Word (fromWord8) import Control.Applicative +import Control.Monad (mzero) +import qualified Data.Aeson as A import Data.Attoparsec.ByteString.Char8 import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Zepto as Z @@ -40,11 +42,20 @@ import qualified Data.ByteString.Unsafe as B import Data.Monoid import Data.Word +import qualified Data.Vector as V +import Data.Traversable (traverse) import Prelude hiding (all, any) -- | Represents PostgreSQL arrays newtype Array a = Array [a] deriving (Eq, Show) +instance A.ToJSON a => A.ToJSON (Array a) where + toJSON (Array xs) = A.toJSON xs + +instance A.FromJSON a => A.FromJSON (Array a) where + parseJSON (A.Array xs) = fmap (Array . V.toList) (traverse A.parseJSON xs) + parseJSON _ = mzero + instance (ArrayElem a, PrimitivePersistField a) => PersistField (Array a) where persistName a = "Array" ++ delim : persistName ((undefined :: Array a -> a) a) toPersistValues = primToPersistValue @@ -58,22 +69,22 @@ t -> error $ "arrayType " ++ persistName a ++ ": expected DbTypePrimitive, got " ++ show t class ArrayElem a where - parseElem :: DbDescriptor db => proxy db -> Parser a + parseElem :: Parser a instance ArrayElem a => ArrayElem (Array a) where parseElem = parseArr instance PrimitivePersistField a => ArrayElem a where - parseElem p = fmap (fromPrimitivePersistValue p . PersistByteString) parseString + parseElem = fmap (fromPrimitivePersistValue . PersistByteString) parseString instance (ArrayElem a, PrimitivePersistField a) => PrimitivePersistField (Array a) where - toPrimitivePersistValue p (Array xs) = PersistCustom arr (vals []) where + toPrimitivePersistValue (Array xs) = PersistCustom arr (vals []) where arr = "ARRAY[" <> query <> "]::" <> fromString typ - RenderS query vals = commasJoin $ map (renderPersistValue . toPrimitivePersistValue p) xs - typ = showSqlType $ arrayType p $ Array xs - fromPrimitivePersistValue p a = parseHelper parser a where + RenderS query vals = commasJoin $ map (renderPersistValue . toPrimitivePersistValue) xs + typ = showSqlType $ arrayType (undefined :: p Postgresql) $ Array xs + fromPrimitivePersistValue a = parseHelper parser a where dimensions = char '[' *> takeWhile1 (/= '=') *> char '=' - parser = optional dimensions *> parseArr p + parser = optional dimensions *> parseArr parseString :: Parser ByteString parseString = (char '"' *> jstring_) @@ -121,8 +132,8 @@ doubleQuote = 34 backslash = 92 -parseArr :: (DbDescriptor db, ArrayElem a) => proxy db -> Parser (Array a) -parseArr p = Array <$> (char '{' *> parseElem p `sepBy` char ',' <* char '}') +parseArr :: ArrayElem a => Parser (Array a) +parseArr = Array <$> (char '{' *> parseElem `sepBy` char ',' <* char '}') (!) :: (ExpressionOf Postgresql r a (Array elem), ExpressionOf Postgresql r b Int) => a -> b -> Expr Postgresql r elem (!) arr i = mkExpr $ Snippet $ \conf _ -> [renderExpr conf (toExpr arr) <> "[" <> renderExpr conf (toExpr i) <> "]"] diff --git a/Database/Groundhog/Postgresql/Geometry.hs b/Database/Groundhog/Postgresql/Geometry.hs --- a/Database/Groundhog/Postgresql/Geometry.hs +++ b/Database/Groundhog/Postgresql/Geometry.hs @@ -73,8 +73,8 @@ points = point `sepBy1` char ',' instance PrimitivePersistField Point where - toPrimitivePersistValue _ (Point x y) = PersistString $ show (x, y) - fromPrimitivePersistValue _ = parseHelper point + toPrimitivePersistValue (Point x y) = toPrimitivePersistValue $ show (x, y) + fromPrimitivePersistValue = parseHelper point instance PersistField Point where persistName _ = "Point" @@ -83,8 +83,8 @@ dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "point"]) False Nothing Nothing instance PrimitivePersistField Line where - toPrimitivePersistValue _ (Line (Point x1 y1) (Point x2 y2)) = PersistString $ show ((x1, y1), (x2, y2)) - fromPrimitivePersistValue _ = error "fromPrimitivePersistValue Line is not supported yet" + toPrimitivePersistValue (Line (Point x1 y1) (Point x2 y2)) = toPrimitivePersistValue $ show ((x1, y1), (x2, y2)) + fromPrimitivePersistValue = error "fromPrimitivePersistValue Line is not supported yet" instance PersistField Line where persistName _ = "Line" @@ -93,8 +93,8 @@ dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "line"]) False Nothing Nothing instance PrimitivePersistField Lseg where - toPrimitivePersistValue _ (Lseg (Point x1 y1) (Point x2 y2)) = PersistString $ show ((x1, y1), (x2, y2)) - fromPrimitivePersistValue _ = parseHelper $ pair Lseg '[' ']' point + toPrimitivePersistValue (Lseg (Point x1 y1) (Point x2 y2)) = toPrimitivePersistValue $ show ((x1, y1), (x2, y2)) + fromPrimitivePersistValue = parseHelper $ pair Lseg '[' ']' point instance PersistField Lseg where persistName _ = "Lseg" @@ -103,8 +103,8 @@ dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "lseg"]) False Nothing Nothing instance PrimitivePersistField Box where - toPrimitivePersistValue _ (Box (Point x1 y1) (Point x2 y2)) = PersistString $ show ((x1, y1), (x2, y2)) - fromPrimitivePersistValue _ = parseHelper $ Box <$> (point <* char ',') <*> point + toPrimitivePersistValue (Box (Point x1 y1) (Point x2 y2)) = toPrimitivePersistValue $ show ((x1, y1), (x2, y2)) + fromPrimitivePersistValue = parseHelper $ Box <$> (point <* char ',') <*> point instance PersistField Box where persistName _ = "Box" @@ -123,10 +123,10 @@ showPoint (Point x y) = shows (x, y) instance PrimitivePersistField Path where - toPrimitivePersistValue _ path = PersistString $ case path of + toPrimitivePersistValue path = toPrimitivePersistValue $ case path of ClosedPath ps -> showPath '(' ')' ps "" OpenPath ps -> showPath '[' ']' ps "" - fromPrimitivePersistValue _ = parseHelper $ path' ClosedPath '(' ')' <|> path' OpenPath '[' ']' where + fromPrimitivePersistValue = parseHelper $ path' ClosedPath '(' ')' <|> path' OpenPath '[' ']' where path' f open close = f <$> (char open *> points <* char close) instance PersistField Path where @@ -136,8 +136,8 @@ dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "path"]) False Nothing Nothing instance PrimitivePersistField Polygon where - toPrimitivePersistValue _ (Polygon ps) = PersistString $ showPath '(' ')' ps "" - fromPrimitivePersistValue _ = parseHelper $ Polygon <$> (char '(' *> points <* char ')') + toPrimitivePersistValue (Polygon ps) = toPrimitivePersistValue $ showPath '(' ')' ps "" + fromPrimitivePersistValue = parseHelper $ Polygon <$> (char '(' *> points <* char ')') instance PersistField Polygon where persistName _ = "Polygon" @@ -146,8 +146,8 @@ dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "polygon"]) False Nothing Nothing instance PrimitivePersistField Circle where - toPrimitivePersistValue _ (Circle (Point x1 y1) r) = PersistString $ show ((x1, y1), r) - fromPrimitivePersistValue _ = parseHelper $ Circle <$> (char '<' *> point) <* char ',' <*> double <* char '>' + toPrimitivePersistValue (Circle (Point x1 y1) r) = toPrimitivePersistValue $ show ((x1, y1), r) + fromPrimitivePersistValue = parseHelper $ Circle <$> (char '<' *> point) <* char ',' <*> double <* char '>' instance PersistField Circle where persistName _ = "Circle" diff --git a/Database/Groundhog/Postgresql/HStore.hs b/Database/Groundhog/Postgresql/HStore.hs new file mode 100644 --- /dev/null +++ b/Database/Groundhog/Postgresql/HStore.hs @@ -0,0 +1,202 @@ +{-# LANGUAGE GADTs, OverloadedStrings, FlexibleContexts #-} +-- | See detailed documentation for PostgreSQL HStore at http://www.postgresql.org/docs/9.3/static/hstore.html +module Database.Groundhog.Postgresql.HStore + ( -- * HStore manipulation + HStore(..) + , (->.) + , lookupArr + , hstoreConcat + , deleteKey + , deleteKeys + , difference + , hstore_to_array + , hstore_to_matrix + , akeys + , avals + , slice + , hstore_to_json + , hstore_to_json_loose + -- * HStore conditions + , exist + , defined + , (?&) + , (?|) + , (@>) + , (<@) + ) where + +import Database.Groundhog.Core +import Database.Groundhog.Expression +import Database.Groundhog.Generic +import Database.Groundhog.Generic.Sql +import Database.Groundhog.Postgresql +import Database.Groundhog.Postgresql.Array (Array) + +import Database.PostgreSQL.Simple.HStore + +import Data.Aeson (Value) +import qualified Blaze.ByteString.Builder as B +import Control.Applicative +import qualified Data.Map as Map +import Data.String + +import Data.Text (Text) +import qualified Data.Text.Encoding as T + +newtype HStore = HStore (Map.Map Text Text) + deriving (Eq, Ord, Show) + +instance PersistField HStore where + persistName _ = "HStore" + toPersistValues = primToPersistValue + fromPersistValues = primFromPersistValue + dbType _ _ = DbTypePrimitive (DbOther $ OtherTypeDef $ [Left "hstore"]) False Nothing Nothing + +instance PrimitivePersistField HStore where + toPrimitivePersistValue (HStore a) = PersistCustom "E?::hstore" [toPrimitivePersistValue $ T.decodeUtf8 $ B.toByteString $ toBuilder (toHStore (HStoreMap a))] + fromPrimitivePersistValue x = case parseHStoreList $ fromPrimitivePersistValue x of + Left err -> error $ "HStore: " ++ err + Right (HStoreList val) -> HStore $ Map.fromList val + +---------------------------------------------------------------------- + +psqlOperatorExpr :: (db ~ Postgresql, Expression db r a, Expression db r b) => String -> a -> b -> Expr db r c +psqlOperatorExpr op x y = mkExpr $ operator 50 op x y + +psqlOperatorCond :: (db ~ Postgresql, Expression db r a, Expression db r b) => String -> a -> b -> Cond db r +psqlOperatorCond op x y = CondRaw $ operator 50 op x y + +-- | Get value for key (NULL if not present) +-- +-- @'a=>x, b=>y'::hstore -> 'a' == x@ +(->.) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') + => hstore -> key -> Expr db r (Maybe Text) +(->.) = psqlOperatorExpr "->" + +-- | Get values for keys array (NULL if not present) +-- +-- @'a=>x, b=>y, c=>z'::hstore == ARRAY['c','a'] {"z","x"}@ +lookupArr :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) + => hstore -> keys -> Expr db r (Array Text) +lookupArr = psqlOperatorExpr "->" + +-- | Concatenate hstores +-- +-- @'a=>b, c=>d'::hstore || 'c=>x, d=>q'::hstore == "a"=>"b", "c"=>"x", "d"=>"q"@ +hstoreConcat :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) + => hstore1 -> hstore2 -> Expr db r HStore +hstoreConcat = psqlOperatorExpr "||" + +-- | Does hstore contain key? Same as postgresql operator ?. +-- +-- @'a=>1'::hstore ? 'a' == True@ +exist :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') + => hstore -> key -> Cond db r +exist h k = CondRaw $ function "exist" [toExpr h, toExpr k] + +-- | Does hstore contain non-NULL value for key? +-- +-- @defined('a=>NULL','a') == f@ +defined :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') + => hstore -> key -> Cond db r +defined h k = CondRaw $ function "defined" [toExpr h, toExpr k] + +-- | Does hstore contain all specified keys? +-- +-- @'a=>1,b=>2'::hstore ?& ARRAY['a','b'] == True@ +(?&) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) + => hstore -> keys -> Cond db r +(?&) = psqlOperatorCond "?&" + +-- | Does hstore contain any of the specified keys? +-- +-- @'a=>1,b=>2'::hstore ?| ARRAY['b','c'] == True@ +(?|) :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) + => hstore -> keys -> Cond db r +(?|) = psqlOperatorCond "?|" + +-- | Does left operand contain right? +-- +-- @'a=>b, b=>1, c=>NULL'::hstore @> 'b=>1' == True@ +(@>) :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) + => hstore1 -> hstore2 -> Cond db r +(@>) = psqlOperatorCond "@>" + +-- | Is left operand contained in right? +-- +-- @'a=>c'::hstore <@ 'a=>b, b=>1, c=>NULL' == False@ +(<@) :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) + => hstore1 -> hstore2 -> Cond db r +(<@) = psqlOperatorCond "<@" + +-- | Delete key from left operand +-- +-- @'a=>1, b=>2, c=>3'::hstore - 'b'::text == "a"=>"1", "c"=>"3"@ +deleteKey :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r key key', IsString key') + => hstore -> key -> Expr db r HStore +deleteKey h k = mkExpr $ function "delete" [toExpr h, toExpr k] + +-- | Delete keys from left operand +-- +-- @'a=>1, b=>2, c=>3'::hstore - ARRAY['a','b'] == "c"=>"3"@ +deleteKeys :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) + => hstore -> keys -> Expr db r HStore +deleteKeys h k = mkExpr $ function "delete" [toExpr h, toExpr k] + +-- | Delete matching pairs from left operand +-- +-- @'a=>1, b=>2, c=>3'::hstore - 'a=>4, b=>2'::hstore == "a"=>"1", "c"=>"3"@ +difference :: (db ~ Postgresql, ExpressionOf db r hstore1 HStore, ExpressionOf db r hstore2 HStore) + => hstore1 -> hstore2 -> Expr db r HStore +difference h1 h2 = mkExpr $ function "delete" [toExpr h1, toExpr h2] + +-- | Convert hstore to array of alternating keys and values. Same as prefix operator %%. +-- +-- @hstore_to_array('a=>1,b=>2') == {a,1,b,2}@ +hstore_to_array :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r (Array Text) +hstore_to_array h = mkExpr $ function "hstore_to_array" [toExpr h] + +-- | Convert hstore to two-dimensional key/value array. Same as prefix operator %#. +-- +-- @hstore_to_matrix('a=>1,b=>2') == {{a,1},{b,2}}@ +hstore_to_matrix :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r (Array (Array Text)) +hstore_to_matrix h = mkExpr $ function "hstore_to_matrix" [toExpr h] + +-- | Get hstore's keys as an array +-- +-- @akeys('a=>1,b=>2') == {a,b}@ +akeys :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r (Array Text) +akeys h = mkExpr $ function "akeys" [toExpr h] + +-- | Get hstore's values as an array +-- +-- @avals('a=>1,b=>2') == {1,2}@ +avals :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r (Array Text) +avals h = mkExpr $ function "vals" [toExpr h] + +-- | Get hstore as a json value +-- +-- @hstore_to_json('"a key"=>1, b=>t, c=>null, d=>12345, e=>012345, f=>1.234, g=>2.345e+4') +-- == {"a key": "1", "b": "t", "c": null, "d": "12345", "e": "012345", "f": "1.234", "g": "2.345e+4"}@ +hstore_to_json :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r Value +hstore_to_json h = mkExpr $ function "hstore_to_json" [toExpr h] + +-- | Get hstore as a json value, but attempting to distinguish numerical and Boolean values so they are unquoted in the JSON +-- +-- @hstore_to_json_loose('"a key"=>1, b=>t, c=>null, d=>12345, e=>012345, f=>1.234, g=>2.345e+4') +-- == {"a key": 1, "b": true, "c": null, "d": 12345, "e": "012345", "f": 1.234, "g": 2.345e+4}@ +hstore_to_json_loose :: (db ~ Postgresql, ExpressionOf db r hstore HStore) + => hstore -> Expr db r Value +hstore_to_json_loose h = mkExpr $ function "hstore_to_json_loose" [toExpr h] + +-- | Extract a subset of an hstore +-- +-- @slice('a=>1,b=>2,c=>3'::hstore, ARRAY['b','c','x']) =="b"=>"2", "c"=>"3"@ +slice :: (db ~ Postgresql, ExpressionOf db r hstore HStore, ExpressionOf db r keys (Array Text)) + => hstore -> keys -> Expr db r HStore +slice h k = mkExpr $ function "slice" [toExpr h, toExpr k] diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.8 +* Support for GHC 8 +* Support for HStore + 0.7.0.2 * Bump blaze-builder dependency diff --git a/groundhog-postgresql.cabal b/groundhog-postgresql.cabal --- a/groundhog-postgresql.cabal +++ b/groundhog-postgresql.cabal @@ -1,5 +1,5 @@ name: groundhog-postgresql -version: 0.7.0.2 +version: 0.8 license: BSD3 license-file: LICENSE author: Boris Lykah @@ -16,20 +16,24 @@ library build-depends: base >= 4 && < 5 - , postgresql-simple >= 0.3 && < 0.5 + , aeson >= 0.8 && < 1.2 + , postgresql-simple >= 0.3 && < 0.6 , postgresql-libpq >= 0.6.1 , bytestring >= 0.9 , blaze-builder >= 0.3 && < 0.5 - , transformers >= 0.2.1 && < 0.5 - , groundhog >= 0.7 && < 0.8 + , transformers >= 0.2.1 && < 0.6 + , groundhog >= 0.8 && < 0.9 , monad-control >= 0.3 && < 1.1 - , monad-logger >= 0.3 , containers >= 0.2 , text >= 0.8 , attoparsec >= 0.8.5.3 + , aeson >= 0.7 , resource-pool >= 0.2.1 , time >= 1.1 + , vector >= 0.10 && < 0.13 + , resourcet >= 1.1.2 exposed-modules: Database.Groundhog.Postgresql Database.Groundhog.Postgresql.Array Database.Groundhog.Postgresql.Geometry + Database.Groundhog.Postgresql.HStore ghc-options: -Wall -fno-warn-unused-do-bind