014beee · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

okResult

014beeeEitan 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+15−12

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

65 -- * Exceptions

66 , SquealException (..)

67 , PQState (..)

68+ , okResult

68 , catchSqueal

69 , catchSqueal

69 , handleSqueal

70 , handleSqueal

70 ) where

71 ) where

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

399 Nothing -> throw $ ResultException

400 Nothing -> throw $ ResultException

400 "manipulateParams: LibPQ.execParams returned no results"

401 "manipulateParams: LibPQ.execParams returned no results"

401 Just result -> do

402 Just result -> do

402− tryResult result

403+ okResult_ result

403 return $ K (K result)

404 return $ K (K result)

404

405

405 traversePrepared

406 traversePrepared

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

410 case prepResultMaybe of

411 case prepResultMaybe of

411 Nothing -> throw $ ResultException

412 Nothing -> throw $ ResultException

412 "traversePrepared: LibPQ.prepare returned no results"

413 "traversePrepared: LibPQ.prepare returned no results"

413− Just prepResult -> tryResult prepResult

414+ Just prepResult -> okResult_ prepResult

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

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

415 let

416 let

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

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

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

420 Nothing -> throw $ ResultException

421 Nothing -> throw $ ResultException

421 "traversePrepared: LibPQ.execParams returned no results"

422 "traversePrepared: LibPQ.execParams returned no results"

422 Just result -> do

423 Just result -> do

423− tryResult result

424+ okResult_ result

424 return $ K result

425 return $ K result

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

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

426 case deallocResultMaybe of

427 case deallocResultMaybe of

427 Nothing -> throw $ ResultException

428 Nothing -> throw $ ResultException

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

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

429− Just deallocResult -> tryResult deallocResult

430+ Just deallocResult -> okResult_ deallocResult

430 return (K results)

431 return (K results)

431

432

432 traversePrepared_

433 traversePrepared_

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

437 case prepResultMaybe of

438 case prepResultMaybe of

438 Nothing -> throw $ ResultException

439 Nothing -> throw $ ResultException

439 "traversePrepared_: LibPQ.prepare returned no results"

440 "traversePrepared_: LibPQ.prepare returned no results"

440− Just prepResult -> tryResult prepResult

441+ Just prepResult -> okResult_ prepResult

441 for_ list $ \ params -> do

442 for_ list $ \ params -> do

442 let

443 let

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

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

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

446 case resultMaybe of

447 case resultMaybe of

447 Nothing -> throw $ ResultException

448 Nothing -> throw $ ResultException

448 "traversePrepared_: LibPQ.execParams returned no results"

449 "traversePrepared_: LibPQ.execParams returned no results"

449− Just result -> tryResult result

450+ Just result -> okResult_ result

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

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

451 case deallocResultMaybe of

452 case deallocResultMaybe of

452 Nothing -> throw $ ResultException

453 Nothing -> throw $ ResultException

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

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

454− Just deallocResult -> tryResult deallocResult

455+ Just deallocResult -> okResult_ deallocResult

455 return (K ())

456 return (K ())

456

457

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

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

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

630 deriving (Eq, Show)

631 deriving (Eq, Show)

631instance Exception SquealException

632instance Exception SquealException

632

633

633−tryResult

634− :: MonadIO io

635− => LibPQ.Result

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

636− -> io ()

637−tryResult result = liftIO $ do

635+okResult_ result = liftIO $ do

638 status <- LibPQ.resultStatus result

636 status <- LibPQ.resultStatus result

639 case status of

637 case status of

640 LibPQ.CommandOk -> return ()

638 LibPQ.CommandOk -> return ()

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

644 msg <- LibPQ.resultErrorMessage result

642 msg <- LibPQ.resultErrorMessage result

645 throw . PQException $ PQState status stateCode msg

643 throw . PQException $ PQState status stateCode msg

646

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

648+okResult = okResult_ . unK

649+

647-- | Catch `SquealException`s.

650-- | Catch `SquealException`s.

648catchSqueal

651catchSqueal

649 :: MonadUnliftIO io

652 :: MonadUnliftIO io