a28d35a · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

almost...

a28d35aEitan Chatav9 years ago

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

compare with dev

unifiedsplit

@@ -106,18 +106,16 @@ CREATE statements

106-- :}

107-- "CREATE TABLE tab (a int, b real);"

108createTable

109− :: ( KnownSymbol tab

109+ :: ( KnownSymbol table

110 , columns ~ (col ': cols)

111 , SOP.SListI columns

112− , SOP.SListI constraints

112+ , SOP.SListI constraints )

113− , table ~ (constraints :=> columns))

114− => Alias tab -- ^ the name of the table to add

113+ => Alias table -- ^ the name of the table to add

115 -> NP (Aliased TypeExpression) columns

114 -> NP (Aliased TypeExpression) columns

116 -- ^ the names and datatype of each column

115 -- ^ the names and datatype of each column

117− -> NP (Aliased (TableConstraintExpression schema (UnconstrainColumns columns)))

116+ -> NP (Aliased (TableConstraintExpression schema columns)) constraints

118− constraints

119 -- ^ constraints that must hold for the table

117 -- ^ constraints that must hold for the table

120− -> Definition schema (Create tab table schema)

118+ -> Definition schema (Create table (constraints :=> columns) schema)

121createTable table columns constraints = UnsafeDefinition $

119createTable table columns constraints = UnsafeDefinition $

122 "CREATE TABLE" <+> renderAlias table

120 "CREATE TABLE" <+> renderAlias table

123 <+> parenthesized

121 <+> parenthesized

@@ -151,12 +149,23 @@ createTable table columns constraints = UnsafeDefinition $

151-- even if the value came from the default value definition.

149-- even if the value came from the default value definition.

152newtype TableConstraintExpression

150newtype TableConstraintExpression

153 (schema :: SchemaType)

151 (schema :: SchemaType)

154− (columns :: RelationType)

152+ (columns :: ColumnsType)

155 (tableConstraint :: TableConstraint)

153 (tableConstraint :: TableConstraint)

156 = UnsafeTableConstraintExpression

154 = UnsafeTableConstraintExpression

157 { renderTableConstraintExpression :: ByteString }

155 { renderTableConstraintExpression :: ByteString }

158 deriving (GHC.Generic,Show,Eq,Ord,NFData)

156 deriving (GHC.Generic,Show,Eq,Ord,NFData)

159

157

158+data Column

159+ (columns :: ColumnsType)

160+ (column :: (Symbol,ColumnType))

161+ where

162+ Column

163+ :: Has column columns ty

164+ => Column columns (column ::: ty)

165+deriving instance Show (Column columns columnty)

166+deriving instance Eq (Column columns columnty)

167+deriving instance Ord (Column columns columnty)

168+

160-- | A `check` constraint is the most generic `TableConstraint` type.

169-- | A `check` constraint is the most generic `TableConstraint` type.

161-- It allows you to specify that the value in a certain column must satisfy

170-- It allows you to specify that the value in a certain column must satisfy

162-- a Boolean (truth-value) expression.

171-- a Boolean (truth-value) expression.

@@ -170,7 +179,7 @@ newtype TableConstraintExpression

170-- :}

179-- :}

171-- "CREATE TABLE tab (a int NOT NULL, b int NOT NULL, CONSTRAINT inequality CHECK ((a > b)));"

180-- "CREATE TABLE tab (a int NOT NULL, b int NOT NULL, CONSTRAINT inequality CHECK ((a > b)));"

172check

181check

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

182+ :: Condition '[table ::: UnconstrainColumns columns] 'Ungrouped '[]

174 -- ^ condition to check

183 -- ^ condition to check

175 -> TableConstraintExpression schema columns 'Check

184 -> TableConstraintExpression schema columns 'Check

176check condition = UnsafeTableConstraintExpression $

185check condition = UnsafeTableConstraintExpression $

@@ -257,14 +266,15 @@ primaryKey columns = UnsafeTableConstraintExpression $

257-- :}

266-- :}

258-- "CREATE TABLE users (id serial, username text NOT NULL, CONSTRAINT pk_id PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, CONSTRAINT pk_id PRIMARY KEY (id), CONSTRAINT fk_user_id FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"

267-- "CREATE TABLE users (id serial, username text NOT NULL, CONSTRAINT pk_id PRIMARY KEY (id)); CREATE TABLE emails (id serial, userid integer NOT NULL, email text NOT NULL, CONSTRAINT pk_id PRIMARY KEY (id), CONSTRAINT fk_user_id FOREIGN KEY (userid) REFERENCES users (id) ON DELETE CASCADE ON UPDATE RESTRICT);"

259foreignKey

268foreignKey

260− :: ( HasTable tab (UnconstrainSchema schema) refcolumns

269+ :: ( Has table schema reftable

270+ , reftable ~ (constraints :=> refsubcolumns)

261 , SameTypes subcolumns refsubcolumns

271 , SameTypes subcolumns refsubcolumns

262 , AllNotNull subcolumns

272 , AllNotNull subcolumns

263 , SOP.SListI subcolumns

273 , SOP.SListI subcolumns

264 , SOP.SListI refsubcolumns)

274 , SOP.SListI refsubcolumns)

265 => NP (Column columns) subcolumns

275 => NP (Column columns) subcolumns

266 -- ^ column or columns in the table

276 -- ^ column or columns in the table

267− -> Alias tab

277+ -> Alias table

268 -- ^ reference table

278 -- ^ reference table

269 -> NP (Column refcolumns) refsubcolumns

279 -> NP (Column refcolumns) refsubcolumns

270 -- ^ reference column or columns in the reference table

280 -- ^ reference column or columns in the reference table

@@ -273,7 +283,7 @@ foreignKey

273 -> OnUpdateClause

283 -> OnUpdateClause

274 -- ^ what to do when reference is updated

284 -- ^ what to do when reference is updated

275 -> TableConstraintExpression schema columns

285 -> TableConstraintExpression schema columns

276− ('ForeignKey (Aliases subcolumns) tab (Aliases refsubcolumns))

286+ ('ForeignKey (Aliases subcolumns) table (Aliases refsubcolumns))

277foreignKey columns reftable refcolumns onDelete onUpdate =

287foreignKey columns reftable refcolumns onDelete onUpdate =

278 UnsafeTableConstraintExpression $

288 UnsafeTableConstraintExpression $

279 "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

289 "FOREIGN KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

@@ -378,7 +388,7 @@ alterTableRename table0 table1 = UnsafeDefinition $

378addConstraint

388addConstraint

379 :: KnownSymbol constraintName

389 :: KnownSymbol constraintName

380 => Alias constraintName

390 => Alias constraintName

381− -> TableConstraintExpression schema (UnconstrainColumns (UnconstrainTable table)) constraint

391+ -> TableConstraintExpression schema table constraint

382 -> AlterTable schema table (AddConstraint constraintName constraint table)

392 -> AlterTable schema table (AddConstraint constraintName constraint table)

383addConstraint constraintName constraint = UnsafeAlterTable $

393addConstraint constraintName constraint = UnsafeAlterTable $

384 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

394 "ADD" <+> "CONSTRAINT" <+> renderAlias constraintName

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+35−70

@@ -37,9 +37,8 @@ module Squeal.PostgreSQL.Expression

37 ( -- * Expression

38 Expression (UnsafeExpression, renderExpression)

39 , HasParameter (param)

40− , HasColumn (getColumn)

41− , Column (Column)

40+ -- , Column (Column)

42− , renderColumn

41+ -- , renderColumn

43 , GroupedBy (getGroup1, getGroup2)

42 , GroupedBy (getGroup1, getGroup2)

44 -- ** Null

43 -- ** Null

45 , null_

44 , null_

@@ -100,8 +99,7 @@ module Squeal.PostgreSQL.Expression

100 , every, everyDistinct

99 , every, everyDistinct

101 , max_, maxDistinct, min_, minDistinct

100 , max_, maxDistinct, min_, minDistinct

102 -- * Tables

101 -- * Tables

103− , Table (UnsafeTable, renderTable)

102+ , Subtable (UnsafeSubtable, renderSubtable)

104− , HasTable (getTable)

105 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

103 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

106 , PGTyped (pgtype)

104 , PGTyped (pgtype)

107 , bool

105 , bool

@@ -206,32 +204,11 @@ instance {-# OVERLAPPING #-} PGTyped (PGTypeOf ty1)

206instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)

204instance {-# OVERLAPPABLE #-} (KnownNat n, HasParameter (n-1) params ty)

207 => HasParameter n (ty' : params) ty

205 => HasParameter n (ty' : params) ty

208

206

209−{- | A `HasColumn` constraint indicates an unqualified column reference.

210−`getColumn` can only be unambiguous when the `TableExpression` the column

211−references is unique, in which case the column may be referenced using

212−@-XOverloadedLabels@. Otherwise, combined with a `HasTable` constraint, the

213−qualified column reference operator `!` may be used.

214−-}

215−class KnownSymbol column => HasColumn

216− (column :: Symbol)

217− (columns :: RelationType)

218− (ty :: NullityType)

219− | column columns -> ty where

220− getColumn

221− :: HasUnique table tables columns

207+instance (HasUnique table tables columns, Has column columns ty)

222− => Alias column

223− -> Expression tables 'Ungrouped params ty

224− getColumn column = UnsafeExpression $ renderAlias column

225−instance {-# OVERLAPPING #-} KnownSymbol column

226− => HasColumn column (column ::: ty ': tys) ty

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

228− => HasColumn column (ty' ': table) ty

229−

230−instance (HasColumn column columns ty, HasUnique table tables columns)

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

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

232− fromLabel = getColumn (Alias @column)

209+ fromLabel = UnsafeExpression $ renderAlias (Alias @column)

233

210

234−instance (HasTable table tables columns, HasColumn column columns ty)

211+instance (Has table tables columns, Has column columns ty)

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

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

236 table ! column = UnsafeExpression $

213 table ! column = UnsafeExpression $

237 renderAlias table <> "." <> renderAlias column

214 renderAlias table <> "." <> renderAlias column

@@ -240,21 +217,21 @@ instance (HasTable table tables columns, HasColumn column columns ty)

240-- in `Squeel.PostgreSQL.Definition.unique` and other

217-- in `Squeel.PostgreSQL.Definition.unique` and other

241-- `Squeel.PostgreSQL.Definition.TableConstraint`s to witness a

218-- `Squeel.PostgreSQL.Definition.TableConstraint`s to witness a

242-- subcolumns relationship.

219-- subcolumns relationship.

243−data Column

220+-- data Column

244− (columns :: RelationType)

221+-- (columns :: RelationType)

245− (columnty :: (Symbol,NullityType))

222+-- (columnty :: (Symbol,NullityType))

246− where

223+-- where

247− Column

224+-- Column

248− :: HasColumn column columns ty

225+-- :: Has column columns ty

249− => Alias column

226+-- => Alias column

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

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

251−deriving instance Show (Column columns columnty)

228+-- deriving instance Show (Column columns columnty)

252−deriving instance Eq (Column columns columnty)

229+-- deriving instance Eq (Column columns columnty)

253−deriving instance Ord (Column columns columnty)

230+-- deriving instance Ord (Column columns columnty)

254−

231+

255−-- | Render a `Column`.

232+-- -- | Render a `Column`.

256−renderColumn :: Column columns columnty -> ByteString

233+-- renderColumn :: Column columns columnty -> ByteString

257−renderColumn (Column column) = renderAlias column

234+-- renderColumn (Column column) = renderAlias column

258

235

259{- | A `GroupedBy` constraint indicates that a table qualified column is

236{- | A `GroupedBy` constraint indicates that a table qualified column is

260a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,

237a member of the auxiliary namespace created by @GROUP BY@ clauses and thus,

@@ -263,12 +240,12 @@ may be called in an output `Expression` without aggregating.

263class (KnownSymbol table, KnownSymbol column)

240class (KnownSymbol table, KnownSymbol column)

264 => GroupedBy table column bys where

241 => GroupedBy table column bys where

265 getGroup1

242 getGroup1

266− :: (HasUnique table tables columns, HasColumn column columns ty)

243+ :: (HasUnique table tables columns, Has column columns ty)

267 => Alias column

244 => Alias column

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

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

269 getGroup1 column = UnsafeExpression $ renderAlias column

246 getGroup1 column = UnsafeExpression $ renderAlias column

270 getGroup2

247 getGroup2

271− :: (HasTable table tables columns, HasColumn column columns ty)

248+ :: (Has table tables columns, Has column columns ty)

272 => Alias table

249 => Alias table

273 -> Alias column

250 -> Alias column

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

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

@@ -284,15 +261,15 @@ instance {-# OVERLAPPABLE #-}

284

261

285instance

262instance

286 ( HasUnique table tables columns

263 ( HasUnique table tables columns

287− , HasColumn column columns ty

264+ , Has column columns ty

288 , GroupedBy table column bys

265 , GroupedBy table column bys

289 ) => IsLabel column

266 ) => IsLabel column

290 (Expression tables ('Grouped bys) params ty) where

267 (Expression tables ('Grouped bys) params ty) where

291 fromLabel = getGroup1 (Alias @column)

268 fromLabel = getGroup1 (Alias @column)

292

269

293instance

270instance

294− ( HasTable table tables columns

271+ ( Has table tables columns

295− , HasColumn column columns ty

272+ , Has column columns ty

296 , GroupedBy table column bys

273 , GroupedBy table column bys

297 ) => IsTableColumn table column

274 ) => IsTableColumn table column

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

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

@@ -961,31 +938,19 @@ minDistinct = unsafeAggregateDistinct "min"

961tables

938tables

962-----------------------------------------}

939-----------------------------------------}

963

940

964−-- | A `Table` from a schema without its alias with an `IsLabel` instance

941+-- | A `Subtable` from a table expression is a way

965-- to call a table reference by its alias.

942-- to call a table reference by its alias.

966−newtype Table

943+newtype Subtable

967− (schema :: RelationProduct)

944+ (table :: RelationProduct)

968 (columns :: RelationType)

945 (columns :: RelationType)

969− = UnsafeTable { renderTable :: ByteString }

946+ = UnsafeSubtable { renderSubtable :: ByteString }

970 deriving (GHC.Generic,Show,Eq,Ord,NFData)

947 deriving (GHC.Generic,Show,Eq,Ord,NFData)

971−

948+instance Has

972−-- | A `HasTable` constraint indicates a table reference.

973−class KnownSymbol table => HasTable

974− (table :: Symbol)

949+ (subtable :: Symbol)

975− (tables :: RelationProduct)

950+ (table :: RelationProduct)

976 (columns :: RelationType)

951 (columns :: RelationType)

977− | table tables -> columns where

952+ => IsLabel subtable (Subtable table columns) where

978− getTable :: Alias table -> Table tables columns

953+ fromLabel = UnsafeSubtable $ renderAlias (Alias @subtable)

979− getTable table = UnsafeTable $ renderAlias table

980−instance {-# OVERLAPPING #-} KnownSymbol table

981− => HasTable table ((table ::: columns) ': tables) columns

982−instance {-# OVERLAPPABLE #-}

983− (KnownSymbol table, HasTable table schema columns)

984− => HasTable table (table' ': schema) columns

985−

986−instance HasTable table schema columns

987− => IsLabel table (Table schema columns) where

988− fromLabel = getTable (Alias @table)

989

954

990{-----------------------------------------

955{-----------------------------------------

991type expressions

956type expressions

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+15−15

@@ -45,7 +45,7 @@ module Squeal.PostgreSQL.Query

45 , selectDistinctDotStar

46 -- * Table Expressions

47 , TableExpression (..)

48− , renderTableExpression

48+ , renderSubtableExpression

49 , from

50 , where_

51 , group

@@ -348,7 +348,7 @@ select

348select list tabs = UnsafeQuery $

349 "SELECT"

350 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

351− <+> renderTableExpression tabs

351+ <+> renderSubtableExpression tabs

352

353-- | After the select list has been processed, the result table can

354-- be subject to the elimination of duplicate rows using `selectDistinct`.

@@ -362,7 +362,7 @@ selectDistinct

362selectDistinct list tabs = UnsafeQuery $

363 "SELECT DISTINCT"

364 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

365− <+> renderTableExpression tabs

365+ <+> renderSubtableExpression tabs

366

367-- | The simplest kind of query is `selectStar` which emits all columns

368-- that the table expression produces.

@@ -371,7 +371,7 @@ selectStar

371 => TableExpression schema params tables 'Ungrouped

372 -- ^ intermediate virtual table

373 -> Query schema params columns

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

374+selectStar tabs = UnsafeQuery $ "SELECT" <+> "*" <+> renderSubtableExpression tabs

375

376-- | A `selectDistinctStar` emits all columns that the table expression

377-- produces and eliminates duplicate rows.

@@ -381,24 +381,24 @@ selectDistinctStar

381 -- ^ intermediate virtual table

382 -> Query schema params columns

383selectDistinctStar tabs = UnsafeQuery $

384− "SELECT DISTINCT" <+> "*" <+> renderTableExpression tabs

384+ "SELECT DISTINCT" <+> "*" <+> renderSubtableExpression tabs

385

386-- | When working with multiple tables, it can also be useful to ask

387-- for all the columns of a particular table, using `selectDotStar`.

388selectDotStar

389− :: HasTable table tables columns

389+ :: Has table tables columns

390 => Alias table

391 -- ^ particular virtual subtable

392 -> TableExpression schema params tables 'Ungrouped

393 -- ^ intermediate virtual table

394 -> Query schema params columns

395selectDotStar table tables = UnsafeQuery $

396− "SELECT" <+> renderAlias table <> ".*" <+> renderTableExpression tables

396+ "SELECT" <+> renderAlias table <> ".*" <+> renderSubtableExpression tables

397

398-- | A `selectDistinctDotStar` asks for all the columns of a particular table,

399-- and eliminates duplicate rows.

400selectDistinctDotStar

401− :: HasTable table tables columns

401+ :: Has table tables columns

402 => Alias table

403 -- ^ particular virtual subtable

404 -> TableExpression schema params tables 'Ungrouped

@@ -406,7 +406,7 @@ selectDistinctDotStar

406 -> Query schema params columns

407selectDistinctDotStar table tables = UnsafeQuery $

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

409− <+> renderTableExpression tables

409+ <+> renderSubtableExpression tables

410

411{-----------------------------------------

412Table Expressions

@@ -466,10 +466,10 @@ data TableExpression

466 }

467

468-- | Render a `TableExpression`

469−renderTableExpression

469+renderSubtableExpression

470 :: TableExpression schema params tables grouping

471 -> ByteString

472−renderTableExpression

472+renderSubtableExpression

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

474 [ "FROM ", renderFromClause tables

475 , renderWheres whs'

@@ -612,7 +612,7 @@ their placement in SQL.

612-}

613data FromClause schema params tables where

614 Table

615− :: Aliased (Table (UnconstrainSchema schema)) table

615+ :: Aliased (Subtable (UnconstrainSchema schema)) table

616 -> FromClause schema params '[table]

617 Subquery

618 :: Aliased (Query schema params) table

@@ -646,7 +646,7 @@ data FromClause schema params tables where

646-- | Renders a `FromClause`.

647renderFromClause :: FromClause schema params tables -> ByteString

648renderFromClause = \case

649− Table table -> renderAliasedAs renderTable table

649+ Table table -> renderAliasedAs renderSubtable table

650 Subquery selection -> renderAliasedAs (parenthesized . renderQuery) selection

651 CrossJoin right left ->

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

@@ -672,11 +672,11 @@ data By

672 (tables :: RelationProduct)

673 (by :: (Symbol,Symbol)) where

674 By

675− :: (HasUnique table tables columns, HasColumn column columns ty)

675+ :: (HasUnique table tables columns, Has column columns ty)

676 => Alias column

677 -> By tables '(table, column)

678 By2

679− :: (HasTable table tables columns, HasColumn column columns ty)

679+ :: (Has table tables columns, Has column columns ty)

680 => (Alias table, Alias column)

681 -> By tables '(table, column)

682deriving instance Show (By tables by)

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

@@ -262,22 +262,22 @@ type family PGTypeOf (ty :: NullityType) :: PGType where

262

263-- | `SameTypes` is a constraint that proves two `ColumnsType`s have the same

264-- length and the same `ColumnType`s.

265−type family SameTypes (columns0 :: RelationType) (columns1 :: RelationType)

265+type family SameTypes (columns0 :: ColumnsType) (columns1 :: ColumnsType)

266 :: Constraint where

267 SameTypes '[] '[] = ()

268− SameTypes (column0 ::: ty0 ': columns0) (column1 ::: ty1 ': columns1)

268+ SameTypes (column0 ::: def0 :=> ty0 ': columns0) (column1 ::: def1 :=> ty1 ': columns1)

269 = (ty0 ~ ty1, SameTypes columns0 columns1)

270

271-- | `AllNotNull` is a constraint that proves a `ColumnsType` has no @NULL@s.

272−type family AllNotNull (columns :: RelationType) :: Constraint where

272+type family AllNotNull (columns :: ColumnsType) :: Constraint where

273 AllNotNull '[] = ()

274− AllNotNull (column ::: 'NotNull ty ': columns) = AllNotNull columns

274+ AllNotNull (column ::: def :=> 'NotNull ty ': columns) = AllNotNull columns

275

276-- | `NotAllNull` is a constraint that proves a `ColumnsType` has some

277-- @NOT NULL@.

278−type family NotAllNull (columns :: RelationType) :: Constraint where

278+type family NotAllNull (columns :: ColumnsType) :: Constraint where

279− NotAllNull (column ::: 'NotNull ty ': columns) = ()

279+ NotAllNull (column ::: def :=> 'NotNull ty ': columns) = ()

280− NotAllNull (column ::: 'Null ty ': columns) = NotAllNull columns

280+ NotAllNull (column ::: def :=> 'Null ty ': columns) = NotAllNull columns

281

282-- | `NullifyType` is an idempotent that nullifies a `ColumnType`.

283type family NullifyType (ty :: NullityType) :: NullityType where