2f37506 · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

Merge branch 'master' into pq-stuff

2f37506Eitan Chatav9 years ago

circle.yml+2

compare with dev

unifiedsplit

@@ -3,6 +3,8 @@ dependencies:

3 - "~/.stack"

4 - ".stack-work"

5 override:

6+ - stack upgrade

7+ - stack update

6 - stack setup

8 - stack setup

7 - stack test --no-run-tests

9 - stack test --no-run-tests

8test:

10test:

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+7−6

@@ -9,6 +9,7 @@

9 , PolyKinds

10 , RankNTypes

11 , ScopedTypeVariables

12+ , TypeApplications

12 , TypeFamilies

13 , TypeFamilies

13 , TypeOperators

14 , TypeOperators

14#-}

15#-}

@@ -43,7 +44,6 @@ module Squeal.PostgreSQL.Schema

43import Data.ByteString

44import Data.ByteString

44import Data.Monoid

45import Data.Monoid

45import Data.String

46import Data.String

46−import GHC.Exts

47import GHC.OverloadedLabels

48import GHC.TypeLits

@@ -91,10 +91,10 @@ instance PGFloating 'PGfloat8

92type (:::) (alias :: Symbol) (ty :: polykind) = '(alias,ty)

94−data Alias (alias :: Symbol) = Alias (Proxy# alias)

94+data Alias (alias :: Symbol) = Alias

96renderAlias :: KnownSymbol alias => Alias alias -> ByteString

97−renderAlias (Alias alias) = fromString (symbolVal' alias)

97+renderAlias = fromString . symbolVal

99instance alias1 ~ alias2 => IsLabel alias1 (Alias alias2) where

100 fromLabel = Alias

@@ -110,8 +110,8 @@ renderAliased

110 :: (forall ty. expression ty -> ByteString)

111 -> Aliased expression aliased

112 -> ByteString

113−renderAliased render (expression `As` Alias alias) =

113+renderAliased render (expression `As` alias) =

114− render expression <> " AS " <> fromString (symbolVal' alias)

114+ render expression <> " AS " <> renderAlias alias

115

116data NullityType = Null PGType | NotNull PGType

117

@@ -159,4 +159,5 @@ data Grouping

159 | Grouped [(Symbol,Symbol)]

160

161class IsTableColumn table column expression where

162− (&.) :: Alias table -> Alias column -> expression

162+ (!) :: Alias table -> Alias column -> expression

163+ infixl 9 !

squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+65−42

@@ -63,9 +63,9 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)

63class KnownSymbol column => HasColumn column columns ty

64 | column columns -> ty where

65 getColumn

66− :: Proxy# column

66+ :: Alias column

67 -> Expression params '[table ::: columns] 'Ungrouped ty

68− getColumn column = UnsafeExpression $ renderSymbol column

68+ getColumn column = UnsafeExpression $ renderAlias column

69instance {-# OVERLAPPING #-} KnownSymbol column

70 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)

71instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)

@@ -73,11 +73,11 @@ instance {-# OVERLAPPABLE #-} (KnownSymbol column, HasColumn column table ty)

74instance (HasColumn column columns ty, tables ~ '[table ::: columns])

75 => IsLabel column (Expression params tables 'Ungrouped ty) where

76− fromLabel = getColumn

76+ fromLabel = getColumn (Alias @column)

78instance (HasTable table tables columns, HasColumn column columns ty)

79 => IsTableColumn table column (Expression params tables 'Ungrouped ty) where

80− table &. column = UnsafeExpression $

80+ table ! column = UnsafeExpression $

81 renderAlias table <> "." <> renderAlias column

83def :: Expression params '[] grouping ('Optional (nullity ty))

@@ -342,49 +342,74 @@ ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

342 -> Expression params tables grouping ('Required (nullity ty))

343 -> Expression params tables grouping ('Required (nullity 'PGbool))

344(==*) = unsafeBinaryOp "="

345+infix 4 ==*

345

346

346(/=*)

347(/=*)

347 :: Expression params tables grouping ('Required (nullity ty))

348 :: Expression params tables grouping ('Required (nullity ty))

348 -> Expression params tables grouping ('Required (nullity ty))

349 -> Expression params tables grouping ('Required (nullity ty))

349 -> Expression params tables grouping ('Required (nullity 'PGbool))

350 -> Expression params tables grouping ('Required (nullity 'PGbool))

350(/=*) = unsafeBinaryOp "<>"

351(/=*) = unsafeBinaryOp "<>"

352+infix 4 /=*

351

353

352(>=*)

354(>=*)

353 :: Expression params tables grouping ('Required (nullity ty))

355 :: Expression params tables grouping ('Required (nullity ty))

354 -> Expression params tables grouping ('Required (nullity ty))

356 -> Expression params tables grouping ('Required (nullity ty))

355 -> Expression params tables grouping ('Required (nullity 'PGbool))

357 -> Expression params tables grouping ('Required (nullity 'PGbool))

356(>=*) = unsafeBinaryOp ">="

358(>=*) = unsafeBinaryOp ">="

359+infix 4 >=*

357

360

358(<*)

361(<*)

359 :: Expression params tables grouping ('Required (nullity ty))

362 :: Expression params tables grouping ('Required (nullity ty))

360 -> Expression params tables grouping ('Required (nullity ty))

363 -> Expression params tables grouping ('Required (nullity ty))

361 -> Expression params tables grouping ('Required (nullity 'PGbool))

364 -> Expression params tables grouping ('Required (nullity 'PGbool))

362(<*) = unsafeBinaryOp "<"

365(<*) = unsafeBinaryOp "<"

366+infix 4 <*

363

367

364(<=*)

368(<=*)

365 :: Expression params tables grouping ('Required (nullity ty))

369 :: Expression params tables grouping ('Required (nullity ty))

366 -> Expression params tables grouping ('Required (nullity ty))

370 -> Expression params tables grouping ('Required (nullity ty))

367 -> Expression params tables grouping ('Required (nullity 'PGbool))

371 -> Expression params tables grouping ('Required (nullity 'PGbool))

368(<=*) = unsafeBinaryOp "<="

372(<=*) = unsafeBinaryOp "<="

373+infix 4 <=*

369

374

370(>*)

375(>*)

371 :: Expression params tables grouping ('Required (nullity ty))

376 :: Expression params tables grouping ('Required (nullity ty))

372 -> Expression params tables grouping ('Required (nullity ty))

377 -> Expression params tables grouping ('Required (nullity ty))

373 -> Expression params tables grouping ('Required (nullity 'PGbool))

378 -> Expression params tables grouping ('Required (nullity 'PGbool))

374(>*) = unsafeBinaryOp ">"

379(>*) = unsafeBinaryOp ">"

380+infix 4 >*

375

381

376data SortExpression params tables grouping where

382data SortExpression params tables grouping where

377 Asc

383 Asc

378− :: Expression params tables grouping ty

384+ :: Expression params tables grouping ('Required ('NotNull ty))

379 -> SortExpression params tables grouping

385 -> SortExpression params tables grouping

380 Desc

386 Desc

381− :: Expression params tables grouping ty

387+ :: Expression params tables grouping ('Required ('NotNull ty))

388+ -> SortExpression params tables grouping

389+ AscNullsFirst

390+ :: Expression params tables grouping ('Required ('Null ty))

391+ -> SortExpression params tables grouping

392+ AscNullsLast

393+ :: Expression params tables grouping ('Required ('Null ty))

394+ -> SortExpression params tables grouping

395+ DescNullsFirst

396+ :: Expression params tables grouping ('Required ('Null ty))

397+ -> SortExpression params tables grouping

398+ DescNullsLast

399+ :: Expression params tables grouping ('Required ('Null ty))

382 -> SortExpression params tables grouping

400 -> SortExpression params tables grouping

383

401

384renderSortExpression :: SortExpression params tables grouping -> ByteString

402renderSortExpression :: SortExpression params tables grouping -> ByteString

385renderSortExpression = \case

403renderSortExpression = \case

386 Asc expression -> renderExpression expression <+> "ASC"

404 Asc expression -> renderExpression expression <+> "ASC"

387 Desc expression -> renderExpression expression <+> "DESC"

405 Desc expression -> renderExpression expression <+> "DESC"

406+ AscNullsFirst expression -> renderExpression expression

407+ <+> "ASC NULLS FIRST"

408+ DescNullsFirst expression -> renderExpression expression

409+ <+> "DESC NULLS FIRST"

410+ AscNullsLast expression -> renderExpression expression <+> "ASC NULLS LAST"

411+ DescNullsLast expression -> renderExpression expression <+> "DESC NULLS LAST"

412+

388

413

389{-----------------------------------------

414{-----------------------------------------

390aggregation

415aggregation

@@ -437,9 +462,9 @@ class (KnownSymbol table, KnownSymbol column)

437 => GroupedBy table column bys where

462 => GroupedBy table column bys where

438 getGroup1

463 getGroup1

439 :: (tables ~ '[table ::: columns], HasColumn column columns ty)

464 :: (tables ~ '[table ::: columns], HasColumn column columns ty)

440− => Proxy# column

465+ => Alias column

441 -> Expression params tables ('Grouped bys) ty

466 -> Expression params tables ('Grouped bys) ty

442− getGroup1 column = UnsafeExpression $ renderSymbol column

467+ getGroup1 column = UnsafeExpression $ renderAlias column

443 getGroup2

468 getGroup2

444 :: (HasTable table tables columns, HasColumn column columns ty)

469 :: (HasTable table tables columns, HasColumn column columns ty)

445 => Alias table

470 => Alias table

@@ -460,14 +485,15 @@ instance

460 , HasColumn column columns ty

485 , HasColumn column columns ty

461 , GroupedBy table column bys

486 , GroupedBy table column bys

462 ) => IsLabel column

487 ) => IsLabel column

463− (Expression params tables ('Grouped bys) ty) where fromLabel = getGroup1

488+ (Expression params tables ('Grouped bys) ty) where

489+ fromLabel = getGroup1 (Alias @column)

464

490

465instance

491instance

466 ( HasTable table tables columns

492 ( HasTable table tables columns

467 , HasColumn column columns ty

493 , HasColumn column columns ty

468 , GroupedBy table column bys

494 , GroupedBy table column bys

469 ) => IsTableColumn table column

495 ) => IsTableColumn table column

470− (Expression params tables ('Grouped bys) ty) where (&.) = getGroup2

496+ (Expression params tables ('Grouped bys) ty) where (!) = getGroup2

471

497

472unsafeAggregate

498unsafeAggregate

473 :: ByteString

499 :: ByteString

@@ -578,8 +604,8 @@ newtype Table

578

604

579class KnownSymbol table => HasTable table tables columns

605class KnownSymbol table => HasTable table tables columns

580 | table tables -> columns where

606 | table tables -> columns where

581− getTable :: Proxy# table -> Table tables columns

607+ getTable :: Alias table -> Table tables columns

582− getTable table = UnsafeTable $ renderSymbol table

608+ getTable table = UnsafeTable $ renderAlias table

583instance {-# OVERLAPPING #-} KnownSymbol table

609instance {-# OVERLAPPING #-} KnownSymbol table

584 => HasTable table ((table ::: columns) ': tables) columns

610 => HasTable table ((table ::: columns) ': tables) columns

585instance {-# OVERLAPPABLE #-}

611instance {-# OVERLAPPABLE #-}

@@ -588,54 +614,54 @@ instance {-# OVERLAPPABLE #-}

588

614

589instance HasTable table schema columns

615instance HasTable table schema columns

590 => IsLabel table (Table schema columns) where

616 => IsLabel table (Table schema columns) where

591− fromLabel = getTable

617+ fromLabel = getTable (Alias @table)

592

618

593−data TableReference params schema tables where

619+data FromClause params schema tables where

594 Table

620 Table

595 :: Aliased (Table schema) table

621 :: Aliased (Table schema) table

596− -> TableReference params schema '[table]

622+ -> FromClause params schema '[table]

597 Subquery

623 Subquery

598 :: Aliased (Query schema params) table

624 :: Aliased (Query schema params) table

599− -> TableReference params schema '[table]

625+ -> FromClause params schema '[table]

600 CrossJoin

626 CrossJoin

601− :: TableReference params schema right

627+ :: FromClause params schema right

602− -> TableReference params schema left

628+ -> FromClause params schema left

603− -> TableReference params schema (Join left right)

629+ -> FromClause params schema (Join left right)

604 InnerJoin

630 InnerJoin

605− :: TableReference params schema right

631+ :: FromClause params schema right

606 -> Condition params (Join left right) 'Ungrouped

632 -> Condition params (Join left right) 'Ungrouped

607− -> TableReference params schema left

633+ -> FromClause params schema left

608− -> TableReference params schema (Join left right)

634+ -> FromClause params schema (Join left right)

609 LeftOuterJoin

635 LeftOuterJoin

610− :: TableReference params schema right

636+ :: FromClause params schema right

611 -> Condition params (Join left right) 'Ungrouped

637 -> Condition params (Join left right) 'Ungrouped

612− -> TableReference params schema left

638+ -> FromClause params schema left

613− -> TableReference params schema (Join left (NullifyTables right))

639+ -> FromClause params schema (Join left (NullifyTables right))

614 RightOuterJoin

640 RightOuterJoin

615− :: TableReference params schema right

641+ :: FromClause params schema right

616 -> Condition params (Join left right) 'Ungrouped

642 -> Condition params (Join left right) 'Ungrouped

617− -> TableReference params schema left

643+ -> FromClause params schema left

618− -> TableReference params schema (Join (NullifyTables left) right)

644+ -> FromClause params schema (Join (NullifyTables left) right)

619 FullOuterJoin

645 FullOuterJoin

620− :: TableReference params schema right

646+ :: FromClause params schema right

621 -> Condition params (Join left right) 'Ungrouped

647 -> Condition params (Join left right) 'Ungrouped

622− -> TableReference params schema left

648+ -> FromClause params schema left

623− -> TableReference params schema

649+ -> FromClause params schema

624 (Join (NullifyTables left) (NullifyTables right))

650 (Join (NullifyTables left) (NullifyTables right))

625

651

626−renderTableReference :: TableReference params schema tables -> ByteString

652+renderFromClause :: FromClause params schema tables -> ByteString

627−renderTableReference = \case

653+renderFromClause = \case

628 Table table -> renderAliased renderTable table

654 Table table -> renderAliased renderTable table

629 Subquery selection -> renderAliased renderQuery selection

655 Subquery selection -> renderAliased renderQuery selection

630 CrossJoin right left ->

656 CrossJoin right left ->

631− renderTableReference left <+> "CROSS JOIN" <+> renderTableReference right

657+ renderFromClause left <+> "CROSS JOIN" <+> renderFromClause right

632 InnerJoin right on left -> renderJoin "INNER JOIN" right on left

658 InnerJoin right on left -> renderJoin "INNER JOIN" right on left

633 LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left

659 LeftOuterJoin right on left -> renderJoin "LEFT OUTER JOIN" right on left

634 RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left

660 RightOuterJoin right on left -> renderJoin "RIGHT OUTER JOIN" right on left

635 FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left

661 FullOuterJoin right on left -> renderJoin "FULL OUTER JOIN" right on left

636 where

662 where

637 renderJoin op right on left =

663 renderJoin op right on left =

638− renderTableReference left <+> op <+> renderTableReference right

664+ renderFromClause left <+> op <+> renderFromClause right

639 <+> "ON" <+> renderExpression on

665 <+> "ON" <+> renderExpression on

640

666

641data TableExpression

667data TableExpression

@@ -644,7 +670,7 @@ data TableExpression

644 (tables :: [(Symbol,[(Symbol,ColumnType)])])

670 (tables :: [(Symbol,[(Symbol,ColumnType)])])

645 (grouping :: Grouping)

671 (grouping :: Grouping)

646 = TableExpression

672 = TableExpression

647− { fromClause :: TableReference params schema tables

673+ { fromClause :: FromClause params schema tables

648 , whereClause :: [Condition params tables 'Ungrouped]

674 , whereClause :: [Condition params tables 'Ungrouped]

649 , groupByClause :: GroupByClause tables grouping

675 , groupByClause :: GroupByClause tables grouping

650 , havingClause :: HavingClause params tables grouping

676 , havingClause :: HavingClause params tables grouping

@@ -658,7 +684,7 @@ renderTableExpression

658 -> ByteString

684 -> ByteString

659renderTableExpression

685renderTableExpression

660 (TableExpression tables whs' grps' hvs' srts' lims' offs') = mconcat

686 (TableExpression tables whs' grps' hvs' srts' lims' offs') = mconcat

661− [ "FROM ", renderTableReference tables

687+ [ "FROM ", renderFromClause tables

662 , renderWheres whs'

688 , renderWheres whs'

663 , renderGroupByClause grps'

689 , renderGroupByClause grps'

664 , renderHavingClause hvs'

690 , renderHavingClause hvs'

@@ -683,7 +709,7 @@ renderTableExpression

683 offs -> " OFFSET" <+> fromString (show (sum offs))

709 offs -> " OFFSET" <+> fromString (show (sum offs))

684

710

685from

711from

686− :: TableReference params schema tables

712+ :: FromClause params schema tables

687 -> TableExpression params schema tables 'Ungrouped

713 -> TableExpression params schema tables 'Ungrouped

688from tables = TableExpression tables [] NoGroups NoHaving [] [] []

714from tables = TableExpression tables [] NoGroups NoHaving [] [] []

689

715

@@ -983,7 +1009,7 @@ data TableConstraint

983 = UnsafeTableConstraint { renderTableConstraint :: ByteString }

1009 = UnsafeTableConstraint { renderTableConstraint :: ByteString }

984

1010

985check

1011check

986− :: Condition '[] '[table ::: columns] 'Ungrouped

1012+ :: (forall table. Condition '[] '[table ::: columns] 'Ungrouped)

987 -> TableConstraint schema columns

1013 -> TableConstraint schema columns

988check condition = UnsafeTableConstraint $

1014check condition = UnsafeTableConstraint $

989 "CHECK" <+> parenthesized (renderExpression condition)

1015 "CHECK" <+> parenthesized (renderExpression condition)

@@ -1302,8 +1328,5 @@ renderCommaSeparatedMaybe render

1302 . hcollapse

1328 . hcollapse

1303 . hmap (K . render)

1329 . hmap (K . render)

1304

1330

1305−renderSymbol :: KnownSymbol str => Proxy# str -> ByteString

1306−renderSymbol p = fromString $ symbolVal' p

1307−

1308renderNat :: KnownNat n => proxy n -> ByteString

1331renderNat :: KnownNat n => proxy n -> ByteString

1309renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))

1332renderNat (_ :: proxy n) = fromString (show (natVal' (proxy# :: Proxy# n)))

squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+10−10

@@ -91,7 +91,7 @@ spec = do

91 select (sum_ #col2 `As` #sum :* #col1 `As` #col1 :* Nil)

92 ( from (Table (#table1 `As` #table1))

93 & group (By #col1 :* Nil)

94− & having ((#col1 + sum_ #col2) >* 1) )

94+ & having (#col1 + sum_ #col2 >* 1) )

95 statement `queryRenders`

96 "SELECT sum(col2) AS sum, col1 AS col1\

97 \ FROM table1 AS table1\

@@ -181,12 +181,12 @@ spec = do

181 let

182 statement :: Query JoinTables '[] ValueColumns

183 statement = select

184− ( (#orders &. #orderVal) `As` #orderVal

184+ ( #orders ! #orderVal `As` #orderVal :*

185− :* (#customers &. #customerVal) `As` #customerVal

185+ #customers ! #customerVal `As` #customerVal :*

186− :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil)

186+ #shippers ! #shipperVal `As` #shipperVal :* Nil )

187 ( from (Table (#orders `As` #orders)

188 & CrossJoin (Table (#customers `As` #customers))

189− & CrossJoin (Table (#shippers `As` #shippers))))

189+ & CrossJoin (Table (#shippers `As` #shippers))) )

190 statement `queryRenders`

191 "SELECT\

192 \ orders.orderVal AS orderVal,\

@@ -199,14 +199,14 @@ spec = do

199 let

200 statement :: Query JoinTables '[] ValueColumns

201 statement = select

202− ( (#orders &. #orderVal) `As` #orderVal

202+ ( (#orders ! #orderVal) `As` #orderVal

203− :* (#customers &. #customerVal) `As` #customerVal

203+ :* (#customers ! #customerVal) `As` #customerVal

204− :* (#shippers &. #shipperVal) `As` #shipperVal :* Nil)

204+ :* (#shippers ! #shipperVal) `As` #shipperVal :* Nil)

205 ( from (Table (#orders `As` #orders)

206 & InnerJoin (Table (#customers `As` #customers))

207− ((#orders &. #customerID) ==* (#customers &. #customerID))

207+ ((#orders ! #customerID) ==* (#customers ! #customerID))

208 & InnerJoin (Table (#shippers `As` #shippers))

209− ((#orders &. #shipperID) ==* (#shippers &. #shipperID))))

209+ ((#orders ! #shipperID) ==* (#shippers ! #shipperID))))

210 statement `queryRenders`

211 "SELECT\

212 \ orders.orderVal AS orderVal,\

stack.yaml+1−1

@@ -1,3 +1,3 @@

1−resolver: nightly-2017-06-26

1+resolver: nightly-2017-08-15

2packages:

3- squeal-postgresql