8898027 · squeal · git.iko.soy

git.iko.soy/squeal

it compiles!

commit88980278260de67010b2b48fd1dcc6dff85afa9f authorEitan Chatav <eitan.chatav@gmail.com> dateWed 11 Jul 2018, 21:58 (8 years ago) parente1f631c

3 files changed+30−39

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+10−30 squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+18−7

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

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

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

441441 fromValue p =

442442 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]

443453 composite

444454 :: forall proxy pgs. SListI pgs

445455 => proxy ('PGcomposite pgs)

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

455465 then return (K Nothing)

456466 else K . Just <$> bytesOfSize len

457467 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−

488468 in

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

490470

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

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

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

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

945945nullable

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

946+ :: TypeExpression schema (nullity ty)

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

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

949949

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

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

952952notNullable

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

953+ :: TypeExpression schema (nullity ty)

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

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

956956

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

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

7474import Data.Function ((&))

7575import Data.Kind

7676import Data.Monoid

77+import Data.Text (unpack)

7778import Data.Traversable

7879import Generics.SOP

80+import PostgreSQL.Binary.Encoding (encodingBytes)

7981

8082import qualified Database.PostgreSQL.LibPQ as LibPQ

8183

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

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

394396 PQ $ \ (K conn) -> do

395397 let

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

398+ toParam' encoding =

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

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

398401 q' = q <> ";"

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

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

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

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

418421 let

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

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

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

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

422425 case resultMaybe of

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

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

448451 for_ list $ \ params -> do

449452 let

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

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

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

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

453456 case resultMaybe of

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

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

542545 case fromList row' of

543546 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

545550

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

547552-- 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

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

560565 case fromList row' of

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

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

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

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

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

563570

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

565572getRows

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

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

574581 case fromList row' of

575582 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

577586

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

579588firstRow

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

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

588597 case fromList row' of

589598 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

591602

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

593604liftResult