75dc576 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Merge branch 'sqlerror-ex' of https://github.com/sopvop/postgresql-simple into 0.3

75dc576Leon P Smith14 years ago

src/Database/PostgreSQL/Simple.hs+2−5

compare with master

unifiedsplit

@@ -68,6 +68,7 @@ module Database.PostgreSQL.Simple

68 , (:.)(..)

69 -- ** Exceptions

70 , SqlError(..)

71+ , PQ.ExecStatus(..)

71 , FormatError(fmtMessage, fmtQuery, fmtParams)

72 , FormatError(fmtMessage, fmtQuery, fmtParams)

72 , QueryError(qeMessage, qeQuery)

73 , QueryError(qeMessage, qeQuery)

73 , ResultError(errSQLType, errHaskellType, errMessage)

74 , ResultError(errSQLType, errHaskellType, errMessage)

@@ -1035,11 +1036,7 @@ getTypeInfo conn@Connection{..} oid =

1035 WHERE p.oid = ?

1036 WHERE p.oid = ?

1036 |] (Only oid)

1037 |] (Only oid)

1037 typinf <- case names of

1038 typinf <- case names of

1038− [] -> return $ throw SqlError {

1039− sqlNativeError = -1,

1040− sqlErrorMsg = "invalid type oid",

1039+ [] -> return $ throw (fatalError "invalid type oid")

1041− sqlState = ""

1042− }

1043 [(pOid, pTypName, mbCOid, mbCTypName)] ->

1040 [(pOid, pTypName, mbCOid, mbCTypName)] ->

1044 return $! TypeInfo { typ = NamedOid pOid pTypName

1041 return $! TypeInfo { typ = NamedOid pOid pTypName

1045 , typelem = do

1042 , typelem = do

src/Database/PostgreSQL/Simple/Internal.hs+22−19

@@ -25,16 +25,17 @@ import Control.Applicative

25import Control.Exception

26import Control.Concurrent.MVar

27import Data.ByteString(ByteString)

28−import qualified Data.ByteString as B

29import qualified Data.ByteString.Char8 as B8

28import qualified Data.ByteString.Char8 as B8

30import Data.Char (ord)

29import Data.Char (ord)

31import Data.Int (Int64)

30import Data.Int (Int64)

32import qualified Data.IntMap as IntMap

31import qualified Data.IntMap as IntMap

32+import Data.Maybe(fromMaybe)

33import Data.String

34import Data.Typeable

35import Data.Word

36import Database.PostgreSQL.LibPQ(Oid(..))

37import qualified Database.PostgreSQL.LibPQ as PQ

38+import Database.PostgreSQL.LibPQ(ExecStatus(..))

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

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

39import Database.PostgreSQL.Simple.Ok

40import Database.PostgreSQL.Simple.Ok

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

41import Database.PostgreSQL.Simple.Types (Query(..))

@@ -95,10 +96,15 @@ data SqlType

96data SqlError = SqlError {

97data SqlError = SqlError {

97 sqlState :: ByteString

98 sqlState :: ByteString

98− , sqlNativeError :: Int

99+ , sqlExecStatus :: ExecStatus

99 , sqlErrorMsg :: ByteString

100 , sqlErrorMsg :: ByteString

101+ , sqlErrorDetail :: ByteString

102+ , sqlErrorHint :: ByteString

100 } deriving (Show, Typeable)

103 } deriving (Show, Typeable)

101

104

105+fatalError :: ByteString -> SqlError

106+fatalError msg = SqlError "" FatalError msg "" ""

107+

102instance Exception SqlError

108instance Exception SqlError

103

109

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

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

@@ -172,9 +178,7 @@ connectPostgreSQL connstr = do

172 return wconn

178 return wconn

173 _ -> do

179 _ -> do

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

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

175− throwIO $ SqlError { sqlNativeError = -1 -- FIXME?

181+ throwIO $ fatalError msg

176− , sqlErrorMsg = msg

177− , sqlState = "" }

178

182

179-- | Turns a 'ConnectInfo' data structure into a libpq connection string.

183-- | Turns a 'ConnectInfo' data structure into a libpq connection string.

180

184

@@ -223,9 +227,7 @@ exec conn sql =

223 case mres of

227 case mres of

224 Nothing -> do

228 Nothing -> do

225 msg <- maybe "execute error" id <$> PQ.errorMessage h

229 msg <- maybe "execute error" id <$> PQ.errorMessage h

226− throwIO $ SqlError { sqlNativeError = -1 -- FIXME?

230+ throwIO $ fatalError msg

227− , sqlErrorMsg = msg

228− , sqlState = "" }

229 Just res -> do

231 Just res -> do

230 return res

232 return res

231

233

@@ -270,21 +272,22 @@ finishExecute _conn q result = do

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

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

271

273

272throwResultError :: ByteString -> PQ.Result -> PQ.ExecStatus -> IO a

274throwResultError :: ByteString -> PQ.Result -> PQ.ExecStatus -> IO a

273−throwResultError context result status = do

275+throwResultError _ result status = do

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

276+ errormsg <- fromMaybe "" <$>

275− statusmsg <- PQ.resStatus status

277+ PQ.resultErrorField result PQ.DiagMessagePrimary

278+ detail <- fromMaybe "" <$>

279+ PQ.resultErrorField result PQ.DiagMessageDetail

280+ hint <- fromMaybe "" <$>

281+ PQ.resultErrorField result PQ.DiagMessageHint

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

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

277 throwIO $ SqlError { sqlState = state

283 throwIO $ SqlError { sqlState = state

278− , sqlNativeError = fromEnum status

284+ , sqlExecStatus = status

279− , sqlErrorMsg = B.concat [ context, ": ", statusmsg

280− , ": ", errormsg ]}

285+ , sqlErrorMsg = errormsg

286+ , sqlErrorDetail = detail

287+ , sqlErrorHint = hint }

281

288

282disconnectedError :: SqlError

289disconnectedError :: SqlError

283−disconnectedError = SqlError {

284− sqlNativeError = -1,

285− sqlErrorMsg = "connection disconnected",

290+disconnectedError = fatalError "connection disconnected"

286− sqlState = ""

287− }

288

291

289-- | Atomically perform an action with the database handle, if there is one.

292-- | Atomically perform an action with the database handle, if there is one.

290withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a

293withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a

src/Database/PostgreSQL/Simple/LargeObjects.hs+1−3

@@ -51,9 +51,7 @@ liftPQ str conn m = withConnection conn $ \c -> do

51 case res of

52 Nothing -> do

53 msg <- maybe str id <$> PQ.errorMessage c

54− throwIO $ SqlError { sqlNativeError = -1 -- FIXME?

54+ throwIO $ fatalError msg

55− , sqlErrorMsg = msg

56− , sqlState = "" }

57 Just x -> return x

55 Just x -> return x

59loCreat :: Connection -> IO Oid

57loCreat :: Connection -> IO Oid