b91ff6d · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge pull request #123 from morphismtech/dev-error

b91ff6dEitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−10

compare with dev

unifiedsplit

@@ -156,7 +156,6 @@ import Data.Function ((&))

156import Data.List ((\\))

157import Data.Text (Text)

158import Data.Time (UTCTime)

159−import Generics.SOP (K (..))

160import Prelude hiding ((.), id)

159import Prelude hiding ((.), id)

161import System.Environment

160import System.Environment

162import UnliftIO (MonadIO (..))

161import UnliftIO (MonadIO (..))

@@ -314,15 +313,6 @@ instance Migratory (Terminally PQ IO) where

314 okResult result

313 okResult result

315 ntuples result

314 ntuples result

316

315

317−okResult :: K Result results -> PQ schema schema IO ()

318−okResult result = do

319− status <- resultStatus result

320− when (not (status `elem` [CommandOk, TuplesOk])) $ do

321− errorMessageMaybe <- resultErrorMessage result

322− case errorMessageMaybe of

323− Nothing -> error "migration: unknown error"

324− Just msg -> error ("migration: " <> show msg)

325−

326unsafePQ :: (Functor m) => PQ db0 db1 m x -> PQ db0' db1' m x

316unsafePQ :: (Functor m) => PQ db0 db1 m x -> PQ db0' db1' m x

327unsafePQ (PQ pq) = PQ $ fmap (SOP.K . SOP.unK) . pq . SOP.K . SOP.unK

317unsafePQ (PQ pq) = PQ $ fmap (SOP.K . SOP.unK) . pq . SOP.K . SOP.unK

328

318

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+24−17

@@ -64,6 +64,8 @@ module Squeal.PostgreSQL.PQ

64 , resultErrorCode

65 -- * Exceptions

66 , SquealException (..)

67+ , PQState (..)

68+ , okResult

67 , catchSqueal

69 , catchSqueal

68 , handleSqueal

70 , handleSqueal

69 ) where

71 ) where

@@ -398,7 +400,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

398 Nothing -> throw $ ResultException

400 Nothing -> throw $ ResultException

399 "manipulateParams: LibPQ.execParams returned no results"

401 "manipulateParams: LibPQ.execParams returned no results"

400 Just result -> do

402 Just result -> do

401− tryResult result

403+ okResult_ result

402 return $ K (K result)

404 return $ K (K result)

403

405

404 traversePrepared

406 traversePrepared

@@ -409,7 +411,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

409 case prepResultMaybe of

411 case prepResultMaybe of

410 Nothing -> throw $ ResultException

412 Nothing -> throw $ ResultException

411 "traversePrepared: LibPQ.prepare returned no results"

413 "traversePrepared: LibPQ.prepare returned no results"

412− Just prepResult -> tryResult prepResult

414+ Just prepResult -> okResult_ prepResult

413 results <- for list $ \ params -> do

415 results <- for list $ \ params -> do

414 let

416 let

415 toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

417 toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

@@ -419,13 +421,13 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

419 Nothing -> throw $ ResultException

421 Nothing -> throw $ ResultException

420 "traversePrepared: LibPQ.execParams returned no results"

422 "traversePrepared: LibPQ.execParams returned no results"

421 Just result -> do

423 Just result -> do

422− tryResult result

424+ okResult_ result

423 return $ K result

425 return $ K result

424 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

426 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

425 case deallocResultMaybe of

427 case deallocResultMaybe of

426 Nothing -> throw $ ResultException

428 Nothing -> throw $ ResultException

427 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

429 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

428− Just deallocResult -> tryResult deallocResult

430+ Just deallocResult -> okResult_ deallocResult

429 return (K results)

431 return (K results)

430

432

431 traversePrepared_

433 traversePrepared_

@@ -436,7 +438,7 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

436 case prepResultMaybe of

438 case prepResultMaybe of

437 Nothing -> throw $ ResultException

439 Nothing -> throw $ ResultException

438 "traversePrepared_: LibPQ.prepare returned no results"

440 "traversePrepared_: LibPQ.prepare returned no results"

439− Just prepResult -> tryResult prepResult

441+ Just prepResult -> okResult_ prepResult

440 for_ list $ \ params -> do

442 for_ list $ \ params -> do

441 let

443 let

442 toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

444 toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

@@ -445,12 +447,12 @@ instance (MonadIO io, schemas0 ~ schemas, schemas1 ~ schemas)

445 case resultMaybe of

447 case resultMaybe of

446 Nothing -> throw $ ResultException

448 Nothing -> throw $ ResultException

447 "traversePrepared_: LibPQ.execParams returned no results"

449 "traversePrepared_: LibPQ.execParams returned no results"

448− Just result -> tryResult result

450+ Just result -> okResult_ result

449 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

451 deallocResultMaybe <- LibPQ.exec conn ("DEALLOCATE " <> temp <> ";")

450 case deallocResultMaybe of

452 case deallocResultMaybe of

451 Nothing -> throw $ ResultException

453 Nothing -> throw $ ResultException

452 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

454 "traversePrepared: LibPQ.exec DEALLOCATE returned no results"

453− Just deallocResult -> tryResult deallocResult

455+ Just deallocResult -> okResult_ deallocResult

454 return (K ())

456 return (K ())

455

457

456 liftPQ pq = PQ $ \ (K conn) -> do

458 liftPQ pq = PQ $ \ (K conn) -> do

@@ -613,24 +615,24 @@ resultErrorCode

613 -> io (Maybe ByteString)

615 -> io (Maybe ByteString)

614resultErrorCode = liftResult (flip LibPQ.resultErrorField LibPQ.DiagSqlstate)

616resultErrorCode = liftResult (flip LibPQ.resultErrorField LibPQ.DiagSqlstate)

615

617

616−-- | `Exception`s that can be thrown by Squeal.

618+-- | the state of LibPQ

617−data SquealException

619+data PQState = PQState

618− = PQException

619 { sqlExecStatus :: LibPQ.ExecStatus

620 { sqlExecStatus :: LibPQ.ExecStatus

620 , sqlStateCode :: Maybe ByteString

621 , sqlStateCode :: Maybe ByteString

621 -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html

622 -- ^ https://www.postgresql.org/docs/current/static/errcodes-appendix.html

622 , sqlErrorMessage :: Maybe ByteString

623 , sqlErrorMessage :: Maybe ByteString

623− }

624+ } deriving (Eq, Show)

625+

626+-- | `Exception`s that can be thrown by Squeal.

627+data SquealException

628+ = PQException PQState

624 | ResultException Text

629 | ResultException Text

625 | ParseException Text

630 | ParseException Text

626 deriving (Eq, Show)

631 deriving (Eq, Show)

627instance Exception SquealException

632instance Exception SquealException

628

633

629−tryResult

630− :: MonadIO io

631− => LibPQ.Result

634+okResult_ :: MonadIO io => LibPQ.Result -> io ()

632− -> io ()

633−tryResult result = liftIO $ do

635+okResult_ result = liftIO $ do

634 status <- LibPQ.resultStatus result

636 status <- LibPQ.resultStatus result

635 case status of

637 case status of

636 LibPQ.CommandOk -> return ()

638 LibPQ.CommandOk -> return ()

@@ -638,7 +640,12 @@ tryResult result = liftIO $ do

638 _ -> do

640 _ -> do

639 stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

641 stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

640 msg <- LibPQ.resultErrorMessage result

642 msg <- LibPQ.resultErrorMessage result

641− throw $ PQException status stateCode msg

643+ throw . PQException $ PQState status stateCode msg

644+

645+-- | Check if a `Result`'s status is either `LibPQ.CommandOk`

646+-- or `LibPQ.TuplesOk` otherwise `throw` a `PQException`.

647+okResult :: MonadIO io => K LibPQ.Result row -> io ()

648+okResult = okResult_ . unK

642

649

643-- | Catch `SquealException`s.

650-- | Catch `SquealException`s.

644catchSqueal

651catchSqueal

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+6−2

@@ -87,8 +87,12 @@ transactionallyRetry mode tx = mask $ \restore ->

87 loop attempt = do

88 begin mode

89 attempt >>= \case

90− Left (PQException _ (Just "40001") _) -> rollback >> loop attempt

90+ Left (PQException (PQState _ (Just "40001") _)) -> do

91+ rollback

92+ loop attempt

93+ Left err -> do

94+ rollback

91− Left err -> rollback >> throwIO err

95+ throwIO err

92 Right x -> return x

96 Right x -> return x

94-- | @BEGIN@ a transaction.

98-- | @BEGIN@ a transaction.

squeal-postgresql/test/Specs/ExceptionHandling.hs+1−1

@@ -114,7 +114,7 @@ specs = before_ setupDB $ after_ dropDB $

114 describe "Exceptions" $ do

115

116 let

117− dupKeyErr = PQException FatalError (Just "23505")

117+ dupKeyErr = PQException $ PQState FatalError (Just "23505")

118 (Just "ERROR: duplicate key value violates unique constraint \"unique_names\"\nDETAIL: Key (name)=(TestUser) already exists.\n")

119

120 it "should be thrown for unique constraint violation in a manipulation" $