ad560a7 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Turn on standard conforming strings by default

ad560a7Joey Adams14 years ago

src/Database/PostgreSQL/Simple.hs−54

compare with master

unifiedsplit

@@ -113,7 +113,6 @@ import Control.Exception

113 ( Exception, onException, throw, throwIO, finally )

114import Control.Monad (foldM)

115import Data.ByteString (ByteString)

116−import Data.Char(ord)

117import Data.Int (Int64)

116import Data.Int (Int64)

118import qualified Data.IntMap as IntMap

117import qualified Data.IntMap as IntMap

119import Data.List (intersperse)

118import Data.List (intersperse)

@@ -150,15 +149,6 @@ data FormatError = FormatError {

150

149

151instance Exception FormatError

150instance Exception FormatError

152

151

153−-- | Exception thrown if 'query' is used to perform an @INSERT@-like

154−-- operation, or 'execute' is used to perform a @SELECT@-like operation.

155−data QueryError = QueryError {

156− qeMessage :: String

157− , qeQuery :: Query

158− } deriving (Eq, Show, Typeable)

159−

160−instance Exception QueryError

161−

162-- | Format a query string.

152-- | Format a query string.

163--

153--

164-- This function is exposed to help with debugging and logging. Do not

154-- This function is exposed to help with debugging and logging. Do not

@@ -246,12 +236,6 @@ execute conn template qs = do

246 result <- exec conn =<< formatQuery conn template qs

236 result <- exec conn =<< formatQuery conn template qs

247 finishExecute conn template result

237 finishExecute conn template result

248

238

249−-- | A version of 'execute' that does not perform query substitution.

250−execute_ :: Connection -> Query -> IO Int64

251−execute_ conn q@(Query stmt) = do

252− result <- exec conn stmt

253− finishExecute conn q result

254−

255-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not

239-- | Execute a multi-row @INSERT@, @UPDATE@, or other SQL query that is not

256-- expected to return results.

240-- expected to return results.

257--

241--

@@ -264,44 +248,6 @@ executeMany conn q qs = do

264 result <- exec conn =<< formatMany conn q qs

248 result <- exec conn =<< formatMany conn q qs

265 finishExecute conn q result

249 finishExecute conn q result

266

250

267−finishExecute :: Connection -> Query -> PQ.Result -> IO Int64

268−finishExecute _conn q result = do

269− status <- PQ.resultStatus result

270− case status of

271− PQ.CommandOk -> do

272− ncols <- PQ.nfields result

273− if ncols /= 0

274− then throwIO $ QueryError ("execute resulted in " ++ show ncols ++

275− "-column result") q

276− else do

277− nstr <- PQ.cmdTuples result

278− return $ case nstr of

279− Nothing -> 0 -- is this appropriate?

280− Just str -> toInteger str

281− PQ.TuplesOk -> do

282− ncols <- PQ.nfields result

283− throwIO $ QueryError ("execute resulted in " ++ show ncols ++

284− "-column result") q

285− PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"

286− PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"

287− _ -> do

288− errormsg <- maybe "" id <$> PQ.resultErrorMessage result

289− statusmsg <- PQ.resStatus status

290− state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

291− throwIO $ SqlError { sqlState = state

292− , sqlNativeError = fromEnum status

293− , sqlErrorMsg = B.concat [ "execute: ", statusmsg

294− , ": ", errormsg ]}

295− where

296− toInteger str = B.foldl' delta 0 str

297− where

298− delta acc c =

299− if '0' <= c && c <= '9'

300− then 10 * acc + fromIntegral (ord c - ord '0')

301− else error ("finishExecute: not an int: " ++ B.unpack str)

302−

303−

304−

305-- | Perform a @SELECT@ or other SQL query that is expected to return

251-- | Perform a @SELECT@ or other SQL query that is expected to return

306-- results. All results are retrieved and converted before this

252-- results. All results are retrieved and converted before this

307-- function returns.

253-- function returns.

src/Database/PostgreSQL/Simple/Internal.hs+59

@@ -25,6 +25,10 @@ import Control.Applicative

25import Control.Exception

26import Control.Concurrent.MVar

27import Data.ByteString(ByteString)

28+import qualified Data.ByteString as B

29+import qualified Data.ByteString.Char8 as B8

30+import Data.Char (ord)

31+import Data.Int (Int64)

28import qualified Data.IntMap as IntMap

32import qualified Data.IntMap as IntMap

29import Data.String

33import Data.String

30import Data.Typeable

34import Data.Typeable

@@ -33,6 +37,7 @@ import Database.PostgreSQL.LibPQ(Oid(..))

33import qualified Database.PostgreSQL.LibPQ as PQ

37import qualified Database.PostgreSQL.LibPQ as PQ

34import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType)

38import Database.PostgreSQL.Simple.BuiltinTypes (BuiltinType)

35import Database.PostgreSQL.Simple.Ok

39import Database.PostgreSQL.Simple.Ok

40+import Database.PostgreSQL.Simple.Types (Query(..))

36import Control.Monad.Trans.State.Strict

41import Control.Monad.Trans.State.Strict

37import Control.Monad.Trans.Reader

42import Control.Monad.Trans.Reader

38import qualified Data.Vector as V

43import qualified Data.Vector as V

@@ -86,6 +91,15 @@ data SqlError = SqlError {

87instance Exception SqlError

92instance Exception SqlError

94+-- | Exception thrown if 'query' is used to perform an @INSERT@-like

95+-- operation, or 'execute' is used to perform a @SELECT@-like operation.

96+data QueryError = QueryError {

97+ qeMessage :: String

98+ , qeQuery :: Query

99+ } deriving (Eq, Show, Typeable)

100+

101+instance Exception QueryError

102+

89data ConnectInfo = ConnectInfo {

103data ConnectInfo = ConnectInfo {

90 connectHost :: String

104 connectHost :: String

91 , connectPort :: Word16

105 , connectPort :: Word16

@@ -138,6 +152,8 @@ connectPostgreSQL connstr = do

138 PQ.ConnectionOk -> do

152 PQ.ConnectionOk -> do

139 connectionHandle <- newMVar conn

153 connectionHandle <- newMVar conn

140 connectionObjects <- newMVar (IntMap.empty)

154 connectionObjects <- newMVar (IntMap.empty)

155+ let wconn = Connection{..}

156+ _ <- execute_ wconn "SET standard_conforming_strings TO on"

141 return Connection{..}

157 return Connection{..}

142 _ -> do

158 _ -> do

143 msg <- maybe "connectPostgreSQL error" id <$> PQ.errorMessage conn

159 msg <- maybe "connectPostgreSQL error" id <$> PQ.errorMessage conn

@@ -198,6 +214,49 @@ exec conn sql =

198 Just res -> do

214 Just res -> do

199 return res

215 return res

200

216

217+-- | A version of 'execute' that does not perform query substitution.

218+execute_ :: Connection -> Query -> IO Int64

219+execute_ conn q@(Query stmt) = do

220+ result <- exec conn stmt

221+ finishExecute conn q result

222+

223+finishExecute :: Connection -> Query -> PQ.Result -> IO Int64

224+finishExecute _conn q result = do

225+ status <- PQ.resultStatus result

226+ case status of

227+ PQ.CommandOk -> do

228+ ncols <- PQ.nfields result

229+ if ncols /= 0

230+ then throwIO $ QueryError ("execute resulted in " ++ show ncols ++

231+ "-column result") q

232+ else do

233+ nstr <- PQ.cmdTuples result

234+ return $ case nstr of

235+ Nothing -> 0 -- is this appropriate?

236+ Just str -> toInteger str

237+ PQ.TuplesOk -> do

238+ ncols <- PQ.nfields result

239+ throwIO $ QueryError ("execute resulted in " ++ show ncols ++

240+ "-column result") q

241+ PQ.CopyIn -> fail "FIXME: postgresql-simple does not currently support COPY IN"

242+ PQ.CopyOut -> fail "FIXME: postgresql-simple does not currently support COPY OUT"

243+ _ -> do

244+ errormsg <- maybe "" id <$> PQ.resultErrorMessage result

245+ statusmsg <- PQ.resStatus status

246+ state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

247+ throwIO $ SqlError { sqlState = state

248+ , sqlNativeError = fromEnum status

249+ , sqlErrorMsg = B.concat [ "execute: ", statusmsg

250+ , ": ", errormsg ]}

251+ where

252+ toInteger str = B8.foldl' delta 0 str

253+ where

254+ delta acc c =

255+ if '0' <= c && c <= '9'

256+ then 10 * acc + fromIntegral (ord c - ord '0')

257+ else error ("finishExecute: not an int: " ++ B8.unpack str)

258+

259+

201disconnectedError :: SqlError

260disconnectedError :: SqlError

202disconnectedError = SqlError {

261disconnectedError = SqlError {

203 sqlNativeError = -1,

262 sqlNativeError = -1,