014beee · squeal · git.iko.soy

git.iko.soy/squeal

okResult

commit014beee50131cdcc5a5a98ca653ff590c74e4e72 authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateSat 13 Apr 2019, 22:25 (8 years ago) parent1a65af7

2 files changed+15−22

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs−10 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+15−12

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

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

156156import Data.List ((\\))

157157import Data.Text (Text)

158158import Data.Time (UTCTime)

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

160159import Prelude hiding ((.), id)

161160import System.Environment

162161import UnliftIO (MonadIO (..))

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

314313 okResult result

315314 ntuples result

316315

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−

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

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

328318

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+15−12

@@ -65,6 +65,7 @@ module Squeal.PostgreSQL.PQ

6565 -- * Exceptions

6666 , SquealException (..)

6767 , PQState (..)

68+ , okResult

6869 , catchSqueal

6970 , handleSqueal

7071 ) where

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

399400 Nothing -> throw $ ResultException

400401 "manipulateParams: LibPQ.execParams returned no results"

401402 Just result -> do

402− tryResult result

403+ okResult_ result

403404 return $ K (K result)

404405

405406 traversePrepared

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

410411 case prepResultMaybe of

411412 Nothing -> throw $ ResultException

412413 "traversePrepared: LibPQ.prepare returned no results"

413− Just prepResult -> tryResult prepResult

414+ Just prepResult -> okResult_ prepResult

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

415416 let

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

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

420421 Nothing -> throw $ ResultException

421422 "traversePrepared: LibPQ.execParams returned no results"

422423 Just result -> do

423− tryResult result

424+ okResult_ result

424425 return $ K result

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

426427 case deallocResultMaybe of

427428 Nothing -> throw $ ResultException

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

429− Just deallocResult -> tryResult deallocResult

430+ Just deallocResult -> okResult_ deallocResult

430431 return (K results)

431432

432433 traversePrepared_

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

437438 case prepResultMaybe of

438439 Nothing -> throw $ ResultException

439440 "traversePrepared_: LibPQ.prepare returned no results"

440− Just prepResult -> tryResult prepResult

441+ Just prepResult -> okResult_ prepResult

441442 for_ list $ \ params -> do

442443 let

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

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

446447 case resultMaybe of

447448 Nothing -> throw $ ResultException

448449 "traversePrepared_: LibPQ.execParams returned no results"

449− Just result -> tryResult result

450+ Just result -> okResult_ result

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

451452 case deallocResultMaybe of

452453 Nothing -> throw $ ResultException

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

454− Just deallocResult -> tryResult deallocResult

455+ Just deallocResult -> okResult_ deallocResult

455456 return (K ())

456457

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

@@ -630,11 +631,8 @@ data SquealException

630631 deriving (Eq, Show)

631632instance Exception SquealException

632633

633−tryResult

634− :: MonadIO io

635− => LibPQ.Result

636− -> io ()

637−tryResult result = liftIO $ do

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

635+okResult_ result = liftIO $ do

638636 status <- LibPQ.resultStatus result

639637 case status of

640638 LibPQ.CommandOk -> return ()

@@ -644,6 +642,11 @@ tryResult result = liftIO $ do

644642 msg <- LibPQ.resultErrorMessage result

645643 throw . PQException $ PQState status stateCode msg

646644

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 xs -> io ()

648+okResult = okResult_ . unK

649+

647650-- | Catch `SquealException`s.

648651catchSqueal

649652 :: MonadUnliftIO io