5becf22 · squeal · git.iko.soy

76import Data.Function ((&))

77import Data.Kind

78import Data.Monoid

79−import Data.Text (unpack)

79+import Data.Text (pack, Text)

80import Data.Traversable

81import Generics.SOP

82import PostgreSQL.Binary.Encoding (encodingBytes)

273 define (UnsafeDefinition q) = PQ $ \ (K conn) -> do

274 resultMaybe <- liftBase $ LibPQ.exec conn q

275 case resultMaybe of

276− Nothing -> error

276+ Nothing -> throw $ ResultException

277 "define: LibPQ.exec returned no results"

278 Just result -> return $ K (K result)

279

403 q' = q <> ";"

404 resultMaybe <- liftBase $ LibPQ.execParams conn q' params' LibPQ.Binary

405 case resultMaybe of

406− Nothing -> error

406+ Nothing -> throw $ ResultException

407 "manipulateParams: LibPQ.execParams returned no results"

408 Just result -> do

409 tryResult result

415 let temp = "temporary_statement"

416 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

417 case prepResultMaybe of

418− Nothing -> error

418+ Nothing -> throw $ ResultException

419 "traversePrepared: LibPQ.prepare returned no results"

420 Just prepResult -> tryResult prepResult

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

424 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

425 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

426 case resultMaybe of

427− Nothing -> error

427+ Nothing -> throw $ ResultException

428 "traversePrepared: LibPQ.execParams returned no results"

429 Just result -> do

430 tryResult result

431 return $ K result

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

433 case deallocResultMaybe of

434− Nothing -> error

434+ Nothing -> throw $ ResultException

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

436 Just deallocResult -> tryResult deallocResult

437 return (K results)

442 let temp = "temporary_statement"

443 prepResultMaybe <- LibPQ.prepare conn temp q Nothing

444 case prepResultMaybe of

445− Nothing -> error

445+ Nothing -> throw $ ResultException

446 "traversePrepared_: LibPQ.prepare returned no results"

447 Just prepResult -> tryResult prepResult

448 for_ list $ \ params -> do

451 params' = fmap (fmap toParam') (hcollapse (toParams @x @xs params))

452 resultMaybe <- LibPQ.execPrepared conn temp params' LibPQ.Binary

453 case resultMaybe of

454− Nothing -> error

454+ Nothing -> throw $ ResultException

455 "traversePrepared_: LibPQ.execParams returned no results"

456 Just result -> tryResult result

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

458 case deallocResultMaybe of

459− Nothing -> error

459+ Nothing -> throw $ ResultException

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

461 Just deallocResult -> tryResult deallocResult

462 return (K ())

531 -> io y

532getRow r (K result :: K LibPQ.Result columns) = liftBase $ do

533 numRows <- LibPQ.ntuples result

534− when (numRows < r) $ error $

534+ when (numRows < r) $ throw $ ResultException $

535− "getRow: expected at least " <> show r <> "rows but only saw "

535+ "getRow: expected at least " <> pack (show r) <> "rows but only saw "

536− <> show numRows

536+ <> pack (show numRows)

537 let len = fromIntegral (lengthSList (Proxy @columns))

538 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

539 case fromList row' of

540− Nothing -> error "getRow: found unexpected length"

540+ Nothing -> throw $ ResultException "getRow: found unexpected length"

541 Just row -> case fromRow @columns row of

542− Left parseError -> error $ "fromRow: " <> unpack parseError

542+ Left parseError -> throw $ ParseException $ "getRow: " <> parseError

543 Right y -> return y

544

545-- | Intended to be used for unfolding in streaming libraries, `nextRow`

557 let len = fromIntegral (lengthSList (Proxy @columns))

558 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

559 case fromList row' of

560− Nothing -> error "nextRow: found unexpected length"

560+ Nothing -> throw $ ResultException "nextRow: found unexpected length"

561 Just row -> case fromRow @columns row of

562− Left parseError -> error $ "nextRow: " <> unpack parseError

562+ Left parseError -> throw $ ParseException $ "nextRow: " <> parseError

563 Right y -> return $ Just (r+1, y)

564

565-- | Get all rows from a `LibPQ.Result`.

573 for [0 .. numRows - 1] $ \ r -> do

574 row' <- traverse (LibPQ.getvalue result r) [0 .. len - 1]

575 case fromList row' of

576− Nothing -> error "getRows: found unexpected length"

576+ Nothing -> throw $ ResultException "getRows: found unexpected length"

577 Just row -> case fromRow @columns row of

578− Left parseError -> error $ "getRows: " <> unpack parseError

578+ Left parseError -> throw $ ParseException $ "getRows: " <> parseError

579 Right y -> return y

580

581-- | Get the first row if possible from a `LibPQ.Result`.

589 let len = fromIntegral (lengthSList (Proxy @columns))

590 row' <- traverse (LibPQ.getvalue result 0) [0 .. len - 1]

591 case fromList row' of

592− Nothing -> error "firstRow: found unexpected length"

592+ Nothing -> throw $ ResultException "firstRow: found unexpected length"

593 Just row -> case fromRow @columns row of

594− Left parseError -> error $ "firstRow: " <> unpack parseError

594+ Left parseError -> throw $ ParseException $ "firstRow: " <> parseError

595 Right y -> return $ Just y

596

597-- | Lifts actions on results from @LibPQ@.

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

627

628data SquealException

629− = SquealException

629+ = PQException

630 { sqlExecStatus :: LibPQ.ExecStatus

631 , sqlStateCode :: Maybe ByteString

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

633 , sqlErrorMessage :: Maybe ByteString

634+ }

635+ | ResultException Text

636+ | ParseException Text

634− } deriving (Eq, Show)

637+ deriving (Eq, Show)

635instance Exception SquealException

638instance Exception SquealException

636

639

637tryResult

640tryResult

646 _ -> do

649 _ -> do

647 stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

650 stateCode <- LibPQ.resultErrorField result LibPQ.DiagSqlstate

648 msg <- LibPQ.resultErrorMessage result

651 msg <- LibPQ.resultErrorMessage result

649− throw $ SquealException status stateCode msg

652+ throw $ PQException status stateCode msg