8898027 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

it compiles!

8898027Eitan Chatav8 years ago

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+10−30

compare with dev

unifiedsplit

@@ -440,6 +440,16 @@ instance

440 ) => FromValue ('PGcomposite fields) y where

441 fromValue p =

442 let

443+ -- <number of fields: 4 bytes>

444+ -- [for each field]

445+ -- <OID of field's type: sizeof(Oid) bytes>

446+ -- [if value is NULL]

447+ -- <-1: 4 bytes>

448+ -- [else]

449+ -- <length of value: 4 bytes>

450+ -- <value: <length> bytes>

451+ -- [end if]

452+ -- [end for]

443 composite

453 composite

444 :: forall proxy pgs. SListI pgs

454 :: forall proxy pgs. SListI pgs

445 => proxy ('PGcomposite pgs)

455 => proxy ('PGcomposite pgs)

@@ -455,36 +465,6 @@ instance

455 then return (K Nothing)

465 then return (K Nothing)

456 else K . Just <$> bytesOfSize len

466 else K . Just <$> bytesOfSize len

457 htraverse' each (hpure Proxy :: NP Proxy pgs)

467 htraverse' each (hpure Proxy :: NP Proxy pgs)

458−

459− -- composite

460− -- :: SListI zs

461− -- => NP ((->) (Maybe Strict.ByteString) :.: Either Strict.Text :.: P) zs

462− -- -> Decoding.Value (NP P zs)

463− -- composite fields = do

464− -- <number of fields: 4 bytes>

465− -- [for each field]

466− -- <OID of field's type: sizeof(Oid) bytes>

467− -- [if value is NULL]

468− -- <-1: 4 bytes>

469− -- [else]

470− -- <length of value: 4 bytes>

471− -- <value: <length> bytes>

472− -- [end if]

473− -- [end for]

474− -- unitOfSize 4

475− -- let

476− -- each

477− -- :: ((->) (Maybe Strict.ByteString) :.: Either Strict.Text :.: P) z

478− -- -> Decoding.Value (P z)

479− -- each = undefined

480− -- each (Comp field) = _

481− -- unitOfSize 4

482− -- len <- sized 4 Decoding.int

483− -- if len == -1

484− -- then return (P (field Nothing))

485− -- else sized len (fn _)

486− -- htraverse' each fields

487−

488 in

468 in

489 Decoding.fn (fromRow @fields @y <=< composite p)

469 Decoding.fn (fromRow @fields @y <=< composite p)

490

470

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

@@ -943,14 +943,14 @@ newtype ColumnTypeExpression (schema :: SchemaType) (ty :: ColumnType)

943-- | used in `createTable` commands as a column constraint to note that

944-- @NULL@ may be present in a column

945nullable

946− :: (forall nullity. TypeExpression schema (nullity ty))

946+ :: TypeExpression schema (nullity ty)

947 -> ColumnTypeExpression schema ('NoDef :=> 'Null ty)

948nullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NULL"

949

950-- | used in `createTable` commands as a column constraint to ensure

951-- @NULL@ is not present in a column

952notNullable

953− :: (forall nullity. TypeExpression schema (nullity ty))

953+ :: TypeExpression schema (nullity ty)

954 -> ColumnTypeExpression schema (def :=> 'NotNull ty)

955notNullable ty = UnsafeColumnTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

956

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+18−7

@@ -74,8 +74,10 @@ import Data.Foldable

74import Data.Function ((&))

75import Data.Kind

76import Data.Monoid

77+import Data.Text (unpack)

77import Data.Traversable

78import Data.Traversable

78import Generics.SOP

79import Generics.SOP

80+import PostgreSQL.Binary.Encoding (encodingBytes)

80import qualified Database.PostgreSQL.LibPQ as LibPQ

82import qualified Database.PostgreSQL.LibPQ as LibPQ

@@ -393,7 +395,8 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

393 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =

395 (UnsafeManipulation q :: Manipulation schema ps ys) (params :: x) =

394 PQ $ \ (K conn) -> do

396 PQ $ \ (K conn) -> do

395 let

397 let

398+ toParam' encoding =

396− toParam' bytes = (LibPQ.invalidOid,bytes,LibPQ.Binary)

399+ (LibPQ.invalidOid, encodingBytes encoding, LibPQ.Binary)

397 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))

400 params' = fmap (fmap toParam') (hcollapse (toParams @x @ps params))

398 q' = q <> ";"

401 q' = q <> ";"

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

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

@@ -416,7 +419,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

416 "traversePrepared: LibPQ.prepare status " <> show status

419 "traversePrepared: LibPQ.prepare status " <> show status

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

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

418 let

421 let

419− toParam' bytes = (bytes,LibPQ.Binary)

422+ toParam' encoding = (encodingBytes encoding,LibPQ.Binary)

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

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

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

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

422 case resultMaybe of

425 case resultMaybe of

@@ -447,7 +450,7 @@ instance (MonadBase IO io, schema0 ~ schema, schema1 ~ schema)

447 "traversePrepared: LibPQ.prepare status " <> show status

450 "traversePrepared: LibPQ.prepare status " <> show status

448 for_ list $ \ params -> do

451 for_ list $ \ params -> do

449 let

452 let

450− toParam' bytes = (bytes,LibPQ.Binary)

453+ toParam' encoding = (encodingBytes encoding, LibPQ.Binary)

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

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

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

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

453 case resultMaybe of

456 case resultMaybe of

@@ -541,7 +544,9 @@ getRow r (K result :: K LibPQ.Result columns) = liftBase $ do

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

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

542 case fromList row' of

545 case fromList row' of

543 Nothing -> error "getRow: found unexpected length"

546 Nothing -> error "getRow: found unexpected length"

544− Just row -> return $ fromRow @columns row

547+ Just row -> case fromRow @columns row of

548+ Left parseError -> error $ "fromRow: " <> unpack parseError

549+ Right y -> return y

545

550

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

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

547-- takes a total number of rows (which can be found with `ntuples`)

552-- takes a total number of rows (which can be found with `ntuples`)

@@ -559,7 +564,9 @@ nextRow total (K result :: K LibPQ.Result columns) r

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

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

560 case fromList row' of

565 case fromList row' of

561 Nothing -> error "nextRow: found unexpected length"

566 Nothing -> error "nextRow: found unexpected length"

567+ Just row -> case fromRow @columns row of

568+ Left parseError -> error $ "nextRow: " <> unpack parseError

562− Just row -> return $ Just (r+1, fromRow @columns row)

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

563

570

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

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

565getRows

572getRows

@@ -573,7 +580,9 @@ getRows (K result :: K LibPQ.Result columns) = liftBase $ do

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

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

574 case fromList row' of

581 case fromList row' of

575 Nothing -> error "getRows: found unexpected length"

582 Nothing -> error "getRows: found unexpected length"

576− Just row -> return $ fromRow @columns row

583+ Just row -> case fromRow @columns row of

584+ Left parseError -> error $ "getRows: " <> unpack parseError

585+ Right y -> return y

577

586

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

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

579firstRow

588firstRow

@@ -587,7 +596,9 @@ firstRow (K result :: K LibPQ.Result columns) = liftBase $ do

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

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

588 case fromList row' of

597 case fromList row' of

589 Nothing -> error "firstRow: found unexpected length"

598 Nothing -> error "firstRow: found unexpected length"

590− Just row -> return . Just $ fromRow @columns row

599+ Just row -> case fromRow @columns row of

600+ Left parseError -> error $ "firstRow: " <> unpack parseError

601+ Right y -> return $ Just y

591

602

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

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

593liftResult

604liftResult