2f37506 · squeal · git.iko.soy

git.iko.soy/squeal

Merge branch 'master' into pq-stuff

commit2f37506627339f822161320588ad3548f963b803 authorEitan Chatav <eitan.chatav@gmail.com> dateTue 15 Aug 2017, 18:26 (9 years ago) parent6d0a671 cfcf7d3

5 files changed+85−59

compare with dev

unifiedsplit

circle.yml+2 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+7−6 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+65−42 squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+10−10 stack.yaml+1−1

circle.yml+2

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

33 - "~/.stack"

44 - ".stack-work"

55 override:

6+ - stack upgrade

7+ - stack update

68 - stack setup

79 - stack test --no-run-tests

810test:

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

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

99 , PolyKinds

1010 , RankNTypes

1111 , ScopedTypeVariables

12+ , TypeApplications

1213 , TypeFamilies

1314 , TypeOperators

1415#-}

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

4344import Data.ByteString

4445import Data.Monoid

4546import Data.String

46−import GHC.Exts

4747import GHC.OverloadedLabels

4848import GHC.TypeLits

4949

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

9191

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

9393

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

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

9595

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

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

97+renderAlias = fromString . symbolVal

9898

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

100100 fromLabel = Alias

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

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

111111 -> Aliased expression aliased

112112 -> ByteString

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

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

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

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

115115

116116data NullityType = Null PGType | NotNull PGType

117117

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

159159 | Grouped [(Symbol,Symbol)]

160160

161161class 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)

6363class KnownSymbol column => HasColumn column columns ty

6464 | column columns -> ty where

6565 getColumn

66− :: Proxy# column

66+ :: Alias column

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

68− getColumn column = UnsafeExpression $ renderSymbol column

68+ getColumn column = UnsafeExpression $ renderAlias column

6969instance {-# OVERLAPPING #-} KnownSymbol column

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

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

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

7373

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

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

76− fromLabel = getColumn

76+ fromLabel = getColumn (Alias @column)

7777

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

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

80− table &. column = UnsafeExpression $

80+ table ! column = UnsafeExpression $

8181 renderAlias table <> "." <> renderAlias column

8282

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

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

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

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

344344(==*) = unsafeBinaryOp "="

345+infix 4 ==*

345346

346347(/=*)

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

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

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

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

352+infix 4 /=*

351353

352354(>=*)

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

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

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

356358(>=*) = unsafeBinaryOp ">="

359+infix 4 >=*

357360

358361(<*)

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

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

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

362365(<*) = unsafeBinaryOp "<"

366+infix 4 <*

363367

364368(<=*)

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

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

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

368372(<=*) = unsafeBinaryOp "<="

373+infix 4 <=*

369374

370375(>*)

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

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

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

374379(>*) = unsafeBinaryOp ">"

380+infix 4 >*

375381

376382data SortExpression params tables grouping where

377383 Asc

378− :: Expression params tables grouping ty

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

379385 -> SortExpression params tables grouping

380386 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))

382400 -> SortExpression params tables grouping

383401

384402renderSortExpression :: SortExpression params tables grouping -> ByteString

385403renderSortExpression = \case

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

387405 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+

388413

389414{-----------------------------------------

390415aggregation

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

437462 => GroupedBy table column bys where

438463 getGroup1

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

440− => Proxy# column

465+ => Alias column

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

442− getGroup1 column = UnsafeExpression $ renderSymbol column

467+ getGroup1 column = UnsafeExpression $ renderAlias column

443468 getGroup2

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

445470 => Alias table

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

460485 , HasColumn column columns ty

461486 , GroupedBy table column bys

462487 ) => 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)

464490

465491instance

466492 ( HasTable table tables columns

467493 , HasColumn column columns ty

468494 , GroupedBy table column bys

469495 ) => IsTableColumn table column

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

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

471497

472498unsafeAggregate

473499 :: ByteString

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

578604

579605class KnownSymbol table => HasTable table tables columns

580606 | table tables -> columns where

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

582− getTable table = UnsafeTable $ renderSymbol table

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

608+ getTable table = UnsafeTable $ renderAlias table

583609instance {-# OVERLAPPING #-} KnownSymbol table

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

585611instance {-# OVERLAPPABLE #-}

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

588614

589615instance HasTable table schema columns

590616 => IsLabel table (Table schema columns) where

591− fromLabel = getTable

617+ fromLabel = getTable (Alias @table)

592618

593−data TableReference params schema tables where

619+data FromClause params schema tables where

594620 Table

595621 :: Aliased (Table schema) table

596− -> TableReference params schema '[table]

622+ -> FromClause params schema '[table]

597623 Subquery

598624 :: Aliased (Query schema params) table

599− -> TableReference params schema '[table]

625+ -> FromClause params schema '[table]

600626 CrossJoin

601− :: TableReference params schema right

602− -> TableReference params schema left

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

627+ :: FromClause params schema right

628+ -> FromClause params schema left

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

604630 InnerJoin

605− :: TableReference params schema right

631+ :: FromClause params schema right

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

607− -> TableReference params schema left

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

633+ -> FromClause params schema left

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

609635 LeftOuterJoin

610− :: TableReference params schema right

636+ :: FromClause params schema right

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

612− -> TableReference params schema left

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

638+ -> FromClause params schema left

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

614640 RightOuterJoin

615− :: TableReference params schema right

641+ :: FromClause params schema right

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

617− -> TableReference params schema left

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

643+ -> FromClause params schema left

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

619645 FullOuterJoin

620− :: TableReference params schema right

646+ :: FromClause params schema right

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

622− -> TableReference params schema left

623− -> TableReference params schema

648+ -> FromClause params schema left

649+ -> FromClause params schema

624650 (Join (NullifyTables left) (NullifyTables right))

625651

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

627−renderTableReference = \case

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

653+renderFromClause = \case

628654 Table table -> renderAliased renderTable table

629655 Subquery selection -> renderAliased renderQuery selection

630656 CrossJoin right left ->

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

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

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

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

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

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

636662 where

637663 renderJoin op right on left =

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

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

639665 <+> "ON" <+> renderExpression on

640666

641667data TableExpression

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

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

645671 (grouping :: Grouping)

646672 = TableExpression

647− { fromClause :: TableReference params schema tables

673+ { fromClause :: FromClause params schema tables

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

649675 , groupByClause :: GroupByClause tables grouping

650676 , havingClause :: HavingClause params tables grouping

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

658684 -> ByteString

659685renderTableExpression

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

661− [ "FROM ", renderTableReference tables

687+ [ "FROM ", renderFromClause tables

662688 , renderWheres whs'

663689 , renderGroupByClause grps'

664690 , renderHavingClause hvs'

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

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

684710

685711from

686− :: TableReference params schema tables

712+ :: FromClause params schema tables

687713 -> TableExpression params schema tables 'Ungrouped

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

689715

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

9831009 = UnsafeTableConstraint { renderTableConstraint :: ByteString }

9841010

9851011check

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

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

9871013 -> TableConstraint schema columns

9881014check condition = UnsafeTableConstraint $

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

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

13021328 . hcollapse

13031329 . hmap (K . render)

13041330

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

1306−renderSymbol p = fromString $ symbolVal' p

1307−

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

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

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

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

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

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

9393 & group (By #col1 :* Nil)

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

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

9595 statement `queryRenders`

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

9797 \ FROM table1 AS table1\

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

181181 let

182182 statement :: Query JoinTables '[] ValueColumns

183183 statement = select

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

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

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

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

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

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

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

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

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

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

190190 statement `queryRenders`

191191 "SELECT\

192192 \ orders.orderVal AS orderVal,\

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

199199 let

200200 statement :: Query JoinTables '[] ValueColumns

201201 statement = select

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

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

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

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

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

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

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

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

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

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

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

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

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

210210 statement `queryRenders`

211211 "SELECT\

212212 \ orders.orderVal AS orderVal,\

stack.yaml+1−1

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

1−resolver: nightly-2017-06-26

1+resolver: nightly-2017-08-15

22packages:

33- squeal-postgresql