@@ -62,6 +62,8 @@ module Squeal.PostgreSQL.PQ
6262 , LibPQ.ExecStatus (..)
6363 , resultStatus
6464 , resultErrorMessage
65+ , resultErrorCode
66+ , SquealException (..)
6567 ) where
6668
6769import Control.Exception.Lifted
@@ -400,7 +402,9 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
400402 case resultMaybe of
401403 Nothing -> error
402404 "manipulateParams: LibPQ.execParams returned no results"
403− Just result -> return $ K (K result)
405+ Just result -> do
406+ tryResult result
407+ return $ K (K result)
404408
405409 traversePrepared
406410 (UnsafeManipulation q :: Manipulation schema xs ys) (list :: list x) =
@@ -410,10 +414,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
410414 case prepResultMaybe of
411415 Nothing -> error
412416 "traversePrepared: LibPQ.prepare returned no results"
413− Just prepResult -> do
414− status <- LibPQ.resultStatus prepResult
415− unless (status == LibPQ.CommandOk) . error $
416− "traversePrepared: LibPQ.prepare status " <> show status
417+ Just prepResult -> tryResult prepResult
417418 results <- for list $ \ params -> do
418419 let
419420 toParam' bytes = (bytes,LibPQ.Binary)
@@ -422,15 +423,14 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
422423 case resultMaybe of
423424 Nothing -> error
424425 "traversePrepared: LibPQ.execParams returned no results"
425− Just result -> return $ K result
426+ Just result -> do
427+ tryResult result
428+ return $ K result
426429 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
427430 case deallocResultMaybe of
428431 Nothing -> error
429432 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
430− Just deallocResult -> do
431− status <- LibPQ.resultStatus deallocResult
432− unless (status == LibPQ.CommandOk) . error $
433− "traversePrepared: DEALLOCATE status " <> show status
433+ Just deallocResult -> tryResult deallocResult
434434 return (K results)
435435
436436 traversePrepared_
@@ -441,10 +441,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
441441 case prepResultMaybe of
442442 Nothing -> error
443443 "traversePrepared_: LibPQ.prepare returned no results"
444− Just prepResult -> do
445− status <- LibPQ.resultStatus prepResult
446− unless (status == LibPQ.CommandOk) . error $
447− "traversePrepared: LibPQ.prepare status " <> show status
444+ Just prepResult -> tryResult prepResult
448445 for_ list $ \ params -> do
449446 let
450447 toParam' bytes = (bytes,LibPQ.Binary)
@@ -453,15 +450,12 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)
453450 case resultMaybe of
454451 Nothing -> error
455452 "traversePrepared_: LibPQ.execParams returned no results"
456− Just _result -> return ()
453+ Just result -> tryResult result
457454 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")
458455 case deallocResultMaybe of
459456 Nothing -> error
460457 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"
461− Just deallocResult -> do
462− status <- LibPQ.resultStatus deallocResult
463− unless (status == LibPQ.CommandOk) . error $
464− "traversePrepared: DEALLOCATE status " <> show status
458+ Just deallocResult -> tryResult deallocResult
465459 return (K ())
466460
467461 liftPQ pq = PQ $ \ (K conn) -> do
@@ -609,3 +603,36 @@ resultStatus = liftResult LibPQ.resultStatus
609603resultErrorMessage
610604 :: MonadBase IO io => K LibPQ.Result results -> io (Maybe ByteString)
611605resultErrorMessage = liftResult LibPQ.resultErrorMessage
606+
607+-- | Returns the error code most recently generated by an operation
608+-- on the connection.
609+--
610+-- https://www.postgresql.org/docs/current/static/errcodes-appendix.html
611+resultErrorCode
612+ :: MonadBase IO io
613+ => K LibPQ.Result results
614+ -> io (Maybe ByteString)
615+resultErrorCode = liftResult (flip LibPQ.resultErrorField LibPQ.DiagSqlstate)
616+
617+data SquealException
618+ = SquealException
619+ { sqlExecStatus :: LibPQ.ExecStatus
620+ , sqlStateCode :: Maybe ByteString
621+ -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html
622+ , sqlErrorMessage :: Maybe ByteString
623+ } deriving (Eq, Show)
624+instance Exception SquealException
625+
626+tryResult
627+ :: MonadBase IO io
628+ => LibPQ.Result
629+ -> io ()
630+tryResult result = liftBase $ do
631+ status <- LibPQ.resultStatus result
632+ case status of
633+ LibPQ.CommandOk -> return ()
634+ LibPQ.TuplesOk -> return ()
635+ _ -> do
636+ stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate
637+ msg <- LibPQ.resultErrorMessage result
638+ throw $ SquealException status stateCode msg