groundhog-postgresql 0.7.0.2 → 0.8

raw patch · 6 files changed

+404/−178 lines, 6 filesdep +aesondep +resourcetdep +vectordep −monad-loggerdep ~groundhogdep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, resourcet, vector

Dependencies removed: monad-logger

Dependency ranges changed: groundhog, transformers

API changes (from Hackage documentation)

Files

• Database/Groundhog/Postgresql.hs +155/−150
• Database/Groundhog/Postgresql/Array.hs +20/−9
• Database/Groundhog/Postgresql/Geometry.hs +14/−14
• Database/Groundhog/Postgresql/HStore.hs +202/−0
• changelog +4/−0
• groundhog-postgresql.cabal +9/−5

@@ -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)

@@ -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) <> "]"]

@@ -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"

@@ -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]

@@ -1,3 +1,7 @@+0.8+* Support for GHC 8+* Support for HStore+ 0.7.0.2 * Bump blaze-builder dependency 

@@ -1,5 +1,5 @@ name:            groundhog-postgresql-version:         0.7.0.2+version:         0.8 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -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