Disable auto-transactions
This commit is contained in:
+5
-2
@@ -1,5 +1,6 @@
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
-- {{{ Imports
|
||||||
module Dbapi where
|
module Dbapi where
|
||||||
|
|
||||||
import Types (SqlRow)
|
import Types (SqlRow)
|
||||||
@@ -20,7 +21,7 @@ import Network.Wai
|
|||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
|
|
||||||
import Database.HDBC.PostgreSQL (connectPostgreSQL)
|
import Database.HDBC.PostgreSQL (connectPostgreSQL')
|
||||||
import Database.HDBC.Types (SqlError, seErrorMsg)
|
import Database.HDBC.Types (SqlError, seErrorMsg)
|
||||||
import PgStructure (printTables, printColumns)
|
import PgStructure (printTables, printColumns)
|
||||||
|
|
||||||
@@ -31,6 +32,8 @@ import PgQuery
|
|||||||
import RangeQuery
|
import RangeQuery
|
||||||
import Data.Ranged.Ranges (emptyRange)
|
import Data.Ranged.Ranges (emptyRange)
|
||||||
|
|
||||||
|
-- }}}
|
||||||
|
|
||||||
data AppConfig = AppConfig {
|
data AppConfig = AppConfig {
|
||||||
configDbUri :: String
|
configDbUri :: String
|
||||||
, configPort :: Int }
|
, configPort :: Int }
|
||||||
@@ -51,7 +54,7 @@ jsonBody = (fmap JSON.eitherDecode) . strictRequestBody
|
|||||||
|
|
||||||
app :: AppConfig -> Application
|
app :: AppConfig -> Application
|
||||||
app config req respond = do
|
app config req respond = do
|
||||||
conn <- connectPostgreSQL $ configDbUri config
|
conn <- connectPostgreSQL' $ configDbUri config
|
||||||
r <- try $
|
r <- try $
|
||||||
case (path, verb) of
|
case (path, verb) of
|
||||||
([], _) ->
|
([], _) ->
|
||||||
|
|||||||
@@ -109,7 +109,6 @@ insert schema table row conn = do
|
|||||||
query <- populateSql conn ("insert into %I.%I ("++colIds++")", map toSql $ (pack . show $ schema):table:cols)
|
query <- populateSql conn ("insert into %I.%I ("++colIds++")", map toSql $ (pack . show $ schema):table:cols)
|
||||||
stmt <- prepare conn (query ++ " values ("++phs++") returning *")
|
stmt <- prepare conn (query ++ " values ("++phs++") returning *")
|
||||||
_ <- execute stmt values
|
_ <- execute stmt values
|
||||||
commit conn
|
|
||||||
keys <- getColumnNames stmt
|
keys <- getColumnNames stmt
|
||||||
Just vals <- fetchRow stmt
|
Just vals <- fetchRow stmt
|
||||||
let rowMap = fromList $ zip keys vals
|
let rowMap = fromList $ zip keys vals
|
||||||
|
|||||||
Reference in New Issue
Block a user