b6df2af · squeal · git.iko.soy

git.iko.soy/squeal

Merge pull request #43 from echatav/instances

Instances

commitb6df2afe4576e570272ec2b0dcbe642c415296b8 authorEitan Chatav <eitan.chatav@gmail.com> dateWed 16 Aug 2017, 21:22 (9 years ago) parentc6a4b7c 5e1a931

4 files changed+142−52

compare with dev

unifiedsplit

squeal-postgresql/squeal-postgresql.cabal+1 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+14 squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+123−48 squeal-postgresql/test/Squeal/PostgreSQL/StatementSpec.hs+4−4

squeal-postgresql/squeal-postgresql.cabal+1

@@ -24,6 +24,7 @@ library

2424 aeson

2525 , base

2626 , bytestring

27+ , deepseq

2728 , generics-sop

2829 , lifted-base

2930 , monad-control

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+14

@@ -1,5 +1,8 @@

11{-# LANGUAGE

22 DataKinds

3+ , DeriveAnyClass

4+ , DeriveDataTypeable

5+ , DeriveGeneric

36 , FlexibleContexts

47 , FlexibleInstances

58 , GADTs

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

912 , PolyKinds

1013 , RankNTypes

1114 , ScopedTypeVariables

15+ , StandaloneDeriving

1216 , TypeApplications

1317 , TypeFamilies

1418 , TypeOperators

@@ -44,9 +48,12 @@ module Squeal.PostgreSQL.Schema

4448 , module GHC.TypeLits

4549 ) where

4650

51+import Control.DeepSeq

4752import Data.ByteString

53+import Data.Data (Data)

4854import Data.Monoid

4955import Data.String

56+import GHC.Generics (Generic)

5057import GHC.Exts

5158import GHC.OverloadedLabels

5259import GHC.TypeLits

@@ -96,6 +103,7 @@ instance PGFloating 'PGfloat8

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

97104

98105data Alias (alias :: Symbol) = Alias

106+ deriving (Eq,Generic,Data,Ord,Show,NFData)

99107

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

101109renderAlias = fromString . symbolVal

@@ -109,6 +117,12 @@ data Aliased expression aliased where

109117 => expression ty

110118 -> Alias alias

111119 -> Aliased expression (alias ::: ty)

120+deriving instance Show (expression ty)

121+ => Show (Aliased expression (alias ::: ty))

122+deriving instance Eq (expression ty)

123+ => Eq (Aliased expression (alias ::: ty))

124+deriving instance Ord (expression ty)

125+ => Ord (Aliased expression (alias ::: ty))

112126

113127renderAliased

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

squeal-postgresql/src/Squeal/PostgreSQL/Statement.hs+123−48

@@ -1,16 +1,20 @@

11{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

22{-# LANGUAGE

33 DataKinds

4+ , DeriveGeneric

5+ , DeriveDataTypeable

46 , FlexibleContexts

57 , FlexibleInstances

68 , FunctionalDependencies

79 , GADTs

10+ , GeneralizedNewtypeDeriving

811 , LambdaCase

912 , MagicHash

1013 , OverloadedStrings

1114 , PolyKinds

1215 , RankNTypes

1316 , ScopedTypeVariables

17+ , StandaloneDeriving

1418 , TypeApplications

1519 , TypeFamilies

1620 , TypeOperators

@@ -20,10 +24,12 @@

2024module Squeal.PostgreSQL.Statement where

2125

2226import Control.Category

27+import Control.DeepSeq

2328import Data.ByteString (ByteString)

29+import Data.Data (Data)

2430import Data.Foldable

2531import Data.Maybe

26−import Data.Monoid

32+import Data.Monoid hiding (All)

2733import Data.Ratio

2834import Data.String

2935import Data.Word

@@ -33,6 +39,7 @@ import GHC.OverloadedLabels

3339import GHC.TypeLits

3440import Prelude hiding (RealFrac(..), id, (.))

3541

42+import qualified GHC.Generics as GHC

3643import qualified Data.ByteString as ByteString

3744

3845import Squeal.PostgreSQL.Schema

@@ -47,7 +54,7 @@ newtype Expression

4754 (grouping :: Grouping)

4855 (ty :: ColumnType)

4956 = UnsafeExpression { renderExpression :: ByteString }

50− deriving (Show,Eq)

57+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

5158

5259class (PGTyped (BaseType ty), KnownNat n)

5360 => HasParameter (n :: Nat) params ty | n params -> ty where

@@ -80,6 +87,18 @@ instance (HasTable table tables columns, HasColumn column columns ty)

8087 table ! column = UnsafeExpression $

8188 renderAlias table <> "." <> renderAlias column

8289

90+data Column

91+ (columns :: [(Symbol,ColumnType)])

92+ (columnty :: (Symbol,ColumnType))

93+ where

94+ Column

95+ :: HasColumn column columns ty

96+ => Alias column

97+ -> Column columns (column ::: ty)

98+deriving instance Show (Column columns columnty)

99+deriving instance Eq (Column columns columnty)

100+deriving instance Ord (Column columns columnty)

101+

83102def :: Expression params '[] 'Ungrouped ('Optional (nullity ty))

84103def = UnsafeExpression "DEFAULT"

85104

@@ -418,6 +437,7 @@ data SortExpression params tables grouping where

418437 DescNullsLast

419438 :: Expression params tables grouping ('Required ('Null ty))

420439 -> SortExpression params tables grouping

440+deriving instance Show (SortExpression params tables grouping)

421441

422442renderSortExpression :: SortExpression params tables grouping -> ByteString

423443renderSortExpression = \case

@@ -437,7 +457,7 @@ aggregation

437457

438458data By

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

440− (tabcol :: (Symbol,Symbol)) where

460+ (by :: (Symbol,Symbol)) where

441461 By

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

443463 => Alias column

@@ -446,6 +466,9 @@ data By

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

447467 => (Alias table, Alias column)

448468 -> By tables '(table, column)

469+deriving instance Show (By tables by)

470+deriving instance Eq (By tables by)

471+deriving instance Ord (By tables by)

449472

450473renderBy :: By tables tabcolty -> ByteString

451474renderBy = \case

@@ -470,6 +493,9 @@ data HavingClause params tables grouping where

470493 Having

471494 :: [Condition params tables ('Grouped bys)]

472495 -> HavingClause params tables ('Grouped bys)

496+deriving instance Show (HavingClause params tables grouping)

497+deriving instance Eq (HavingClause params tables grouping)

498+deriving instance Ord (HavingClause params tables grouping)

473499

474500renderHavingClause :: HavingClause params tables grouping -> ByteString

475501renderHavingClause = \case

@@ -515,74 +541,97 @@ instance

515541 ) => IsTableColumn table column

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

517543

544+data AllOrDistinct = All | Distinct

545+ deriving (GHC.Generic,Show,Eq,Ord,Data)

546+instance NFData AllOrDistinct

547+

548+renderAllOrDistinct :: AllOrDistinct -> ByteString

549+renderAllOrDistinct = \case

550+ All -> "ALL"

551+ Distinct -> "DISTINCT"

552+

518553unsafeAggregate

519554 :: ByteString

555+ -> AllOrDistinct

520556 -> Expression params tables 'Ungrouped ('Required xty)

521557 -> Expression params tables ('Grouped bys) ('Required yty)

522−unsafeAggregate fun x = UnsafeExpression $ mconcat

523− [fun, "(", renderExpression x, ")"]

558+unsafeAggregate fun allOrDistinct x = UnsafeExpression $ mconcat

559+ [fun, "(", renderAllOrDistinct allOrDistinct <+> renderExpression x, ")"]

524560

525561sum_

526562 :: PGNum ty

527− => Expression params tables 'Ungrouped ('Required (nullity ty))

563+ => AllOrDistinct

564+ -> Expression params tables 'Ungrouped ('Required (nullity ty))

528565 -> Expression params tables ('Grouped bys) ('Required (nullity ty))

529566sum_ = unsafeAggregate "sum"

530567

531568avgInt

532569 :: PGIntegral int

533− => Expression params tables 'Ungrouped ('Required (nullity int))

570+ => AllOrDistinct

571+ -> Expression params tables 'Ungrouped ('Required (nullity int))

534572 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGnumeric))

535573avgInt = unsafeAggregate "avg"

536574

537575avgFloat

538576 :: PGFloating float

539− => Expression params tables 'Ungrouped ('Required (nullity float))

577+ => AllOrDistinct

578+ -> Expression params tables 'Ungrouped ('Required (nullity float))

540579 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGfloat8))

541580avgFloat = unsafeAggregate "avg"

542581

543582bitAnd

544583 :: PGIntegral int

545− => Expression params tables 'Ungrouped ('Required (nullity int))

584+ => AllOrDistinct

585+ -> Expression params tables 'Ungrouped ('Required (nullity int))

546586 -> Expression params tables ('Grouped bys) ('Required (nullity int))

547587bitAnd = unsafeAggregate "bit_and"

548588

549589bitOr

550590 :: PGIntegral int

551− => Expression params tables 'Ungrouped ('Required (nullity int))

591+ => AllOrDistinct

592+ -> Expression params tables 'Ungrouped ('Required (nullity int))

552593 -> Expression params tables ('Grouped bys) ('Required (nullity int))

553594bitOr = unsafeAggregate "bit_or"

554595

555596boolAnd

556− :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

597+ :: AllOrDistinct

598+ -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

557599 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))

558600boolAnd = unsafeAggregate "bool_and"

559601

560602boolOr

561− :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

603+ :: AllOrDistinct

604+ -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

562605 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))

563606boolOr = unsafeAggregate "bool_or"

564607

565608countStar

566− :: Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))

567−countStar = UnsafeExpression "count(*)"

609+ :: AllOrDistinct

610+ -> Expression params table ('Grouped bys) ('Required ('NotNull 'PGint8))

611+countStar allOrDistinct = UnsafeExpression $

612+ "count(" <> renderAllOrDistinct allOrDistinct <+> "*)"

568613

569614count

570− :: Expression params tables 'Ungrouped ('Required ty)

615+ :: AllOrDistinct

616+ -> Expression params tables 'Ungrouped ('Required ty)

571617 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGint8))

572618count = unsafeAggregate "count"

573619

574620every

575− :: Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

621+ :: AllOrDistinct

622+ -> Expression params tables 'Ungrouped ('Required (nullity 'PGbool))

576623 -> Expression params tables ('Grouped bys) ('Required (nullity 'PGbool))

577624every = unsafeAggregate "every"

578625

579626jsonAgg

580− :: Expression params tables 'Ungrouped ('Required ty)

627+ :: AllOrDistinct

628+ -> Expression params tables 'Ungrouped ('Required ty)

581629 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjson))

582630jsonAgg = unsafeAggregate "json_agg"

583631

584632jsonbAgg

585− :: Expression params tables 'Ungrouped ('Required ty)

633+ :: AllOrDistinct

634+ -> Expression params tables 'Ungrouped ('Required ty)

586635 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))

587636jsonbAgg = unsafeAggregate "jsonb_agg"

588637

@@ -595,20 +644,23 @@ jsonObjectAgg k v = UnsafeExpression $

595644 <> ", " <> renderExpression v <> ")"

596645

597646jsonbObjectAgg

598− :: Expression params tables 'Ungrouped ('Required ('NotNull keyty))

647+ :: AllOrDistinct

648+ -> Expression params tables 'Ungrouped ('Required ('NotNull keyty))

599649 -> Expression params tables 'Ungrouped ('Required valty)

600650 -> Expression params tables ('Grouped bys) ('Required ('NotNull 'PGjsonb))

601−jsonbObjectAgg k v = UnsafeExpression $

602− "jsonb_object_agg(" <> renderExpression k

603− <> ", " <> renderExpression v <> ")"

651+jsonbObjectAgg allOrDistinct k v = UnsafeExpression $

652+ "jsonb_object_agg(" <> renderAllOrDistinct allOrDistinct

653+ <+> renderExpression k <> ", " <> renderExpression v <> ")"

604654

605655max_

606− :: Expression params tables 'Ungrouped ('Required (nullity ty))

656+ :: AllOrDistinct

657+ -> Expression params tables 'Ungrouped ('Required (nullity ty))

607658 -> Expression params tables ('Grouped bys) ('Required (nullity ty))

608659max_ = unsafeAggregate "max"

609660

610661min_

611− :: Expression params tables 'Ungrouped ('Required (nullity ty))

662+ :: AllOrDistinct

663+ -> Expression params tables 'Ungrouped ('Required (nullity ty))

612664 -> Expression params tables ('Grouped bys) ('Required (nullity ty))

613665min_ = unsafeAggregate "min"

614666

@@ -620,7 +672,7 @@ newtype Table

620672 (schema :: [(Symbol,[(Symbol,ColumnType)])])

621673 (columns :: [(Symbol,ColumnType)])

622674 = UnsafeTable { renderTable :: ByteString }

623− deriving (Show,Eq)

675+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

624676

625677class KnownSymbol table => HasTable table tables columns

626678 | table tables -> columns where

@@ -785,7 +837,7 @@ type expressions

785837

786838newtype TypeExpression (ty :: ColumnType)

787839 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

788− deriving (Show,Eq)

840+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

789841

790842bool :: TypeExpression ('Required ('Null 'PGbool))

791843bool = UnsafeTypeExpression "bool"

@@ -911,6 +963,7 @@ newtype Definition

911963 (schema0 :: [(Symbol,[(Symbol,ColumnType)])])

912964 (schema1 :: [(Symbol,[(Symbol,ColumnType)])])

913965 = UnsafeDefinition { renderDefinition :: ByteString }

966+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

914967

915968instance Category Definition where

916969 id = UnsafeDefinition ";"

@@ -922,12 +975,14 @@ newtype Manipulation

922975 (params :: [ColumnType])

923976 (columns :: [(Symbol,ColumnType)])

924977 = UnsafeManipulation { renderManipulation :: ByteString }

978+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

925979

926980newtype Query

927981 (schema :: [(Symbol,[(Symbol,ColumnType)])])

928982 (params :: [ColumnType])

929983 (columns :: [(Symbol,ColumnType)])

930984 = UnsafeQuery { renderQuery :: ByteString }

985+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

931986

932987queryStatement

933988 :: Query schema params columns

@@ -977,12 +1032,29 @@ select list tabs = UnsafeQuery $

9771032 <+> renderCommaSeparated (renderAliased renderExpression) list

9781033 <+> renderTableExpression tabs

9791034

1035+selectDistinct

1036+ :: SListI columns

1037+ => NP (Aliased (Expression params tables grouping)) (column ': columns)

1038+ -> TableExpression params schema tables grouping

1039+ -> Query schema params (column ': columns)

1040+selectDistinct list tabs = UnsafeQuery $

1041+ "SELECT DISTINCT"

1042+ <+> renderCommaSeparated (renderAliased renderExpression) list

1043+ <+> renderTableExpression tabs

1044+

9801045selectStar

9811046 :: tables ~ '[table ::: columns]

9821047 => TableExpression params schema tables 'Ungrouped

9831048 -> Query schema params columns

9841049selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderTableExpression tabs

9851050

1051+selectDistinctStar

1052+ :: tables ~ '[table ::: columns]

1053+ => TableExpression params schema tables 'Ungrouped

1054+ -> Query schema params columns

1055+selectDistinctStar tabs = UnsafeQuery $

1056+ "SELECT DISTINCT" <+> "*" <+> renderTableExpression tabs

1057+

9861058selectDotStar

9871059 :: HasTable table tables columns

9881060 => Alias table

@@ -991,12 +1063,14 @@ selectDotStar

9911063selectDotStar table tables = UnsafeQuery $

9921064 "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables

9931065

994−selectRow

995− :: SListI columns

996− => NP (Aliased (Expression params '[] 'Ungrouped)) columns

1066+selectDistinctDotStar

1067+ :: HasTable table tables columns

1068+ => Alias table

1069+ -> TableExpression params schema tables 'Ungrouped

9971070 -> Query schema params columns

998−selectRow row = UnsafeQuery $

999− "SELECT" <+> renderCommaSeparated (renderAliased renderExpression) row

1071+selectDistinctDotStar table tables = UnsafeQuery $

1072+ "SELECT DISTINCT" <+> renderAlias table <> ".*"

1073+ <+> renderTableExpression tables

10001074

10011075{-----------------------------------------

10021076CREATE statements

@@ -1023,10 +1097,11 @@ createTable table columns constraints = UnsafeDefinition $

10231097 [] -> ""

10241098 _ -> ", " <> commaSeparated (renderTableConstraint <$> constraints)

10251099

1026−data TableConstraint

1100+newtype TableConstraint

10271101 (schema :: [(Symbol,[(Symbol,ColumnType)])])

10281102 (columns :: [(Symbol,ColumnType)])

1029− = UnsafeTableConstraint { renderTableConstraint :: ByteString }

1103+ = UnsafeTableConstraint { renderTableConstraint :: ByteString }

1104+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

10301105

10311106check

10321107 :: Condition '[] '[table ::: columns] 'Ungrouped

@@ -1034,15 +1109,6 @@ check

10341109check condition = UnsafeTableConstraint $

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

10361111

1037−data Column

1038− (columns :: [(Symbol,ColumnType)])

1039− (columnty :: (Symbol,ColumnType))

1040− where

1041− Column

1042− :: HasColumn column columns ty

1043− => Alias column

1044− -> Column columns (column ::: ty)

1045−

10461112renderColumn :: Column columns columnty -> ByteString

10471113renderColumn (Column column) = renderAlias column

10481114

@@ -1084,6 +1150,8 @@ data OnDelete

10841150 = OnDeleteNoAction

10851151 | OnDeleteRestrict

10861152 | OnDeleteCascade

1153+ deriving (GHC.Generic,Show,Eq,Ord,Data)

1154+instance NFData OnDelete

10871155

10881156renderOnDelete :: OnDelete -> ByteString

10891157renderOnDelete = \case

@@ -1095,6 +1163,8 @@ data OnUpdate

10951163 = OnUpdateNoAction

10961164 | OnUpdateRestrict

10971165 | OnUpdateCascade

1166+ deriving (GHC.Generic,Show,Eq,Ord,Data)

1167+instance NFData OnUpdate

10981168

10991169renderOnUpdate :: OnUpdate -> ByteString

11001170renderOnUpdate = \case

@@ -1136,10 +1206,11 @@ alterTableRename table0 table1 = UnsafeDefinition $

11361206 "ALTER TABLE" <+> renderAlias table0

11371207 <+> "RENAME TO" <+> renderAlias table1 <> ";"

11381208

1139−data AlterTable

1209+newtype AlterTable

11401210 (columns0 :: [(Symbol, ColumnType)])

11411211 (columns1 :: [(Symbol, ColumnType)]) =

11421212 UnsafeAlterTable {renderAlterTable :: ByteString}

1213+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

11431214

11441215addColumnDefault

11451216 :: KnownSymbol column

@@ -1180,8 +1251,9 @@ alterColumn

11801251alterColumn column alteration = UnsafeAlterTable $

11811252 "ALTER COLUMN" <+> renderAlias column <+> renderAlterColumn alteration

11821253

1183−data AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

1254+newtype AlterColumn (ty0 :: ColumnType) (ty1 :: ColumnType) =

11841255 UnsafeAlterColumn {renderAlterColumn :: ByteString}

1256+ deriving (GHC.Generic,Show,Eq,Ord,Data,NFData)

11851257

11861258setDefault

11871259 :: Expression '[] '[] 'Ungrouped ('Required ty)

@@ -1226,10 +1298,10 @@ data ValuesClause

12261298 (schema :: [(Symbol,[(Symbol,ColumnType)])])

12271299 (params :: [ColumnType])

12281300 (columns :: [(Symbol,ColumnType)])

1229− = Values

1230− (NP (Aliased (Expression params '[] 'Ungrouped)) columns)

1231− [NP (Aliased (Expression params '[] 'Ungrouped)) columns]

1232− | ValuesQuery (Query schema params columns)

1301+ = Values

1302+ (NP (Aliased (Expression params '[] 'Ungrouped)) columns)

1303+ [NP (Aliased (Expression params '[] 'Ungrouped)) columns]

1304+ | ValuesQuery (Query schema params columns)

12331305

12341306renderValuesClause

12351307 :: SListI columns

@@ -1299,6 +1371,9 @@ UPDATE statements

12991371data UpdateExpression params columns ty

13001372 = Same

13011373 | Set (forall table. Expression params '[table ::: columns] 'Ungrouped ty)

1374+deriving instance Show (UpdateExpression params columns ty)

1375+deriving instance Eq (UpdateExpression params columns ty)

1376+deriving instance Ord (UpdateExpression params columns ty)

13021377

13031378renderUpdateExpression

13041379 :: Aliased (UpdateExpression params columns) column

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

@@ -88,15 +88,15 @@ spec = do

8888 let

8989 statement :: Query Tables '[] SumAndCol1

9090 statement =

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

91+ select (sum_ All #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_ All #col2 >* 1) )

9595 statement `queryRenders`

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

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

9797 \ FROM table1 AS table1\

9898 \ GROUP BY col1\

99− \ HAVING ((col1 + sum(col2)) > 1);"

99+ \ HAVING ((col1 + sum(ALL col2)) > 1);"

100100 it "correctly renders simple INSERTs" $ do

101101 let

102102 statement :: Manipulation Tables '[] '[]