93c4be0 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

refactor Returning

93c4be0Eitan Chatav8 years ago

squeal-postgresql/exe/Example.hs+2−3

compare with dev

unifiedsplit

@@ -68,12 +68,11 @@ insertUser :: Manipulation DB '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null

68 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

69insertUser = insertInto #users

70 (Values_ (defaultAs #id :* param @1 `as` #name :* param @2 `as` #vec))

71− (OnConflict (OnConstraint #pk_users) DoNothing) (Returning (#id `as` #fromOnly))

71+ (OnConflict (OnConstraint #pk_users) DoNothing) (Returning_ (#id `as` #fromOnly))

73insertEmail :: Manipulation DB '[ 'NotNull 'PGint4, 'Null 'PGtext] '[]

74−insertEmail = insertInto #emails

74+insertEmail = insertInto_ #emails

75 (Values_ (defaultAs #id :* param @1 `as` #user_id :* param @2 `as` #email))

76− (OnConflict (OnConstraint #pk_emails) DoNothing) (Returning Nil)

78getUsers :: Query DB '[]

77getUsers :: Query DB '[]

79 '[ "userName" ::: 'NotNull 'PGtext

78 '[ "userName" ::: 'NotNull 'PGtext

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+33−44

@@ -35,6 +35,7 @@ module Squeal.PostgreSQL.Manipulation

35 , DefaultAliasable (..)

36 , ColumnExpression (..)

37 , ReturningClause (..)

38+ , pattern Returning_

38 , ConflictClause (..)

39 , ConflictClause (..)

39 , ConflictTarget (..)

40 , ConflictTarget (..)

40 , ConflictAction (..)

41 , ConflictAction (..)

@@ -42,7 +43,6 @@ module Squeal.PostgreSQL.Manipulation

42 -- * Insert

43 -- * Insert

43 , insertInto

44 , insertInto

44 , insertInto_

45 , insertInto_

45− , renderReturningClause

46 , renderConflictClause

47 , renderConflictTarget

48 , renderConflictAction

@@ -231,19 +231,19 @@ insertInto

231 , Has sch schemas schema

232 , Has tab schema ('Table table)

233 , columns ~ TableToColumns table

234− , row ~ TableToRow table

234+ , row0 ~ TableToRow table

235 , SOP.SListI columns

236− , SOP.SListI result )

236+ , SOP.SListI row1 )

237 => QualifiedAlias sch tab

238 -> QueryClause db params columns

239 -> ConflictClause tab db params table

240− -> ReturningClause db params row result

240+ -> ReturningClause db params '[tab ::: row0] row1

241− -> Manipulation db params result

241+ -> Manipulation db params row1

242insertInto tab qry conflict ret = UnsafeManipulation $

243 "INSERT" <+> "INTO" <+> renderQualifiedAlias tab

244 <+> renderQueryClause qry

245 <> renderConflictClause conflict

246− <> renderReturningClause ret

246+ <> renderSQL ret

247

248insertInto_

249 :: ( db ~ (commons :=> schemas)

@@ -256,7 +256,7 @@ insertInto_

256 -> QueryClause db params columns

257 -> Manipulation db params '[]

258insertInto_ tab qry =

259− insertInto tab qry OnConflictDoRaise (Returning Nil)

259+ insertInto tab qry OnConflictDoRaise (Returning_ Nil)

260

261data QueryClause db params columns where

262 Values

@@ -408,28 +408,17 @@ renderColumnExpression = \case

408-- the row will not be returned. `ReturningStar` will return all columns

409-- in the row. Use @Returning Nil@ in the common case where no return

410-- values are desired.

411−data ReturningClause

411+newtype ReturningClause db params from row =

412− (db :: DBType)

412+ Returning (Selection db params 'Ungrouped from row)

413− (params :: [NullityType])

413+

414− (row0 :: RowType)

414+instance RenderSQL (ReturningClause db params from row) where

415− (row1 :: RowType)

415+ renderSQL (Returning selection) = "RETURNING" <+> renderSQL selection

416− where

416+

417− ReturningStar

417+pattern Returning_

418− :: ReturningClause db params row row

419− Returning

420− :: NP (Aliased (Expression db params 'Ungrouped '[tab ::: row0])) row1

421− -> ReturningClause db params row0 row1

422−

423−-- | Render a `ReturningClause`.

424−renderReturningClause

425− :: SOP.SListI results

418+ :: SOP.SListI row

426− => ReturningClause db params columns results

419+ => NP (Aliased (Expression db params 'Ungrouped from)) row

427− -> ByteString

420+ -> ReturningClause db params from row

428−renderReturningClause = \case

421+pattern Returning_ list = Returning (List list)

429− ReturningStar -> " RETURNING *"

430− Returning Nil -> ""

431− Returning results -> " RETURNING"

432− <+> renderCommaSeparated (renderAliasedAs renderExpression) results

433

422

434-- | A `ConflictClause` specifies an action to perform upon a constraint

423-- | A `ConflictClause` specifies an action to perform upon a constraint

435-- violation. `OnConflictDoRaise` will raise an error.

424-- violation. `OnConflictDoRaise` will raise an error.

@@ -500,28 +489,28 @@ UPDATE statements

500-- in all rows that satisfy the condition.

489-- in all rows that satisfy the condition.

501update

490update

502 :: ( SOP.SListI columns

491 :: ( SOP.SListI columns

503− , SOP.SListI results

492+ , SOP.SListI row1

504 , db ~ (commons :=> schemas)

493 , db ~ (commons :=> schemas)

505 , Has sch schemas schema

494 , Has sch schemas schema

506 , Has tab schema ('Table table)

495 , Has tab schema ('Table table)

507− , row ~ TableToRow table

496+ , row0 ~ TableToRow table

508 , columns ~ TableToColumns table

497 , columns ~ TableToColumns table

509 , SOP.All (HasIn columns) subcolumns

498 , SOP.All (HasIn columns) subcolumns

510 , AllUnique subcolumns )

499 , AllUnique subcolumns )

511 => QualifiedAlias sch tab -- ^ table to update

500 => QualifiedAlias sch tab -- ^ table to update

512− -> NP (ColumnExpression db params 'Ungrouped '[tab ::: row]) subcolumns

501+ -> NP (ColumnExpression db params 'Ungrouped '[tab ::: row0]) subcolumns

513 -- ^ modified values to replace old values

502 -- ^ modified values to replace old values

514− -> Condition db params 'Ungrouped '[tab ::: row]

503+ -> Condition db params 'Ungrouped '[tab ::: row0]

515 -- ^ condition under which to perform update on a row

504 -- ^ condition under which to perform update on a row

516− -> ReturningClause db params row results -- ^ results to return

505+ -> ReturningClause db params '[tab ::: row0] row1 -- ^ results to return

517− -> Manipulation db params results

506+ -> Manipulation db params row1

518update tab columns wh returning = UnsafeManipulation $

507update tab columns wh returning = UnsafeManipulation $

519 "UPDATE"

508 "UPDATE"

520 <+> renderQualifiedAlias tab

509 <+> renderQualifiedAlias tab

521 <+> "SET"

510 <+> "SET"

522 <+> renderCommaSeparated renderColumnExpression columns

511 <+> renderCommaSeparated renderColumnExpression columns

523 <+> "WHERE" <+> renderExpression wh

512 <+> "WHERE" <+> renderExpression wh

524− <> renderReturningClause returning

513+ <> renderSQL returning

525

514

526-- | Update a row returning `Nil`.

515-- | Update a row returning `Nil`.

527update_

516update_

@@ -539,7 +528,7 @@ update_

539 -> Condition db params 'Ungrouped '[tab ::: row]

528 -> Condition db params 'Ungrouped '[tab ::: row]

540 -- ^ condition under which to perform update on a row

529 -- ^ condition under which to perform update on a row

541 -> Manipulation db params '[]

530 -> Manipulation db params '[]

542−update_ tab columns wh = update tab columns wh (Returning Nil)

531+update_ tab columns wh = update tab columns wh (Returning_ Nil)

543

532

544{-----------------------------------------

533{-----------------------------------------

545DELETE statements

534DELETE statements

@@ -553,18 +542,18 @@ data UsingClause db params from where

553

542

554-- | Delete rows from a table.

543-- | Delete rows from a table.

555deleteFrom

544deleteFrom

556− :: ( SOP.SListI results

545+ :: ( SOP.SListI row1

557 , db ~ (commons :=> schemas)

546 , db ~ (commons :=> schemas)

558 , Has sch schemas schema

547 , Has sch schemas schema

559 , Has tab schema ('Table table)

548 , Has tab schema ('Table table)

560− , row ~ TableToRow table

549+ , row0 ~ TableToRow table

561 , columns ~ TableToColumns table )

550 , columns ~ TableToColumns table )

562 => QualifiedAlias sch tab -- ^ table to delete from

551 => QualifiedAlias sch tab -- ^ table to delete from

563 -> UsingClause db params from

552 -> UsingClause db params from

564− -> Condition db params 'Ungrouped (tab ::: row ': from)

553+ -> Condition db params 'Ungrouped (tab ::: row0 ': from)

565 -- ^ condition under which to delete a row

554 -- ^ condition under which to delete a row

566− -> ReturningClause db params row results -- ^ results to return

555+ -> ReturningClause db params '[tab ::: row0] row1 -- ^ results to return

567− -> Manipulation db params results

556+ -> Manipulation db params row1

568deleteFrom tab using wh returning = UnsafeManipulation $

557deleteFrom tab using wh returning = UnsafeManipulation $

569 "DELETE FROM"

558 "DELETE FROM"

570 <+> renderQualifiedAlias tab

559 <+> renderQualifiedAlias tab

@@ -572,7 +561,7 @@ deleteFrom tab using wh returning = UnsafeManipulation $

572 NoUsing -> ""

561 NoUsing -> ""

573 Using tables -> " USING" <+> renderFromClause tables

562 Using tables -> " USING" <+> renderFromClause tables

574 <+> "WHERE" <+> renderExpression wh

563 <+> "WHERE" <+> renderExpression wh

575− <> renderReturningClause returning

564+ <> renderSQL returning

576

565

577-- | Delete rows returning `Nil`.

566-- | Delete rows returning `Nil`.

578deleteFrom_

567deleteFrom_

@@ -586,7 +575,7 @@ deleteFrom_

586 -> Condition db params 'Ungrouped (tab ::: row ': from)

575 -> Condition db params 'Ungrouped (tab ::: row ': from)

587 -- ^ condition under which to delete a row

576 -- ^ condition under which to delete a row

588 -> Manipulation db params '[]

577 -> Manipulation db params '[]

589−deleteFrom_ tab uses wh = deleteFrom tab uses wh (Returning Nil)

578+deleteFrom_ tab uses wh = deleteFrom tab uses wh (Returning_ Nil)

590

579

591-- | This has the behaviour of a cartesian product, taking all

580-- | This has the behaviour of a cartesian product, taking all

592-- possible combinations between @left@ and @right@ - exactly like a

581-- possible combinations between @left@ and @right@ - exactly like a

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+28

@@ -18,7 +18,9 @@ Squeal queries.

18 , LambdaCase

19 , MultiParamTypeClasses

20 , OverloadedStrings

21+ , ScopedTypeVariables

21 , StandaloneDeriving

22 , StandaloneDeriving

23+ , TypeApplications

22 , TypeFamilies

24 , TypeFamilies

23 , TypeInType

25 , TypeInType

24 , TypeOperators

26 , TypeOperators

@@ -34,6 +36,7 @@ module Squeal.PostgreSQL.Query

34 , select_

36 , select_

35 , selectDistinct

37 , selectDistinct

36 , selectDistinct_

38 , selectDistinct_

39+ , Selection (..)

37 -- ** Values

40 -- ** Values

38 , values

41 , values

39 , values_

42 , values_

@@ -408,6 +411,31 @@ data Selection db params grp from row where

408 :: Selection db params grp from right

411 :: Selection db params grp from right

409 -> Selection db params grp from left

412 -> Selection db params grp from left

410 -> Selection db params grp from (Join left right)

413 -> Selection db params grp from (Join left right)

414+instance (KnownSymbol col, row ~ '[col ::: ty])

415+ => Aliasable col

416+ (Expression db params grp from ty)

417+ (Selection db params grp from row) where

418+ expr `as` col = List (expr `as` col)

419+instance (Has tab from row0, Has col row0 ty, row1 ~ '[col ::: ty])

420+ => IsQualified tab col (Selection db params 'Ungrouped from row1) where

421+ tab ! col = tab ! col `as` col

422+instance

423+ ( Has tab from row0

424+ , Has col row0 ty

425+ , row1 ~ '[col ::: ty]

426+ , GroupedBy tab col bys )

427+ => IsQualified tab col (Selection db params ('Grouped bys) from row1) where

428+ tab ! col = tab ! col `as` col

429+instance (HasUnique tab from row0, Has col row0 ty, row1 ~ '[col ::: ty])

430+ => IsLabel col (Selection db params 'Ungrouped from row1) where

431+ fromLabel = fromLabel @col `as` Alias

432+instance

433+ ( HasUnique tab from row0

434+ , Has col row0 ty

435+ , row1 ~ '[col ::: ty]

436+ , GroupedBy tab col bys )

437+ => IsLabel col (Selection db params ('Grouped bys) from row1) where

438+ fromLabel = fromLabel @col `as` Alias

411

439

412instance RenderSQL (Selection db params grp from row) where

440instance RenderSQL (Selection db params grp from row) where

413 renderSQL = \case

441 renderSQL = \case