5cfbd5e · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

more cleanup

5cfbd5eEitan Chatav9 years ago

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

compare with dev

unifiedsplit

@@ -206,7 +206,7 @@ unique

206 :: SOP.SListI subcolumns

207 => NP (Column columns) subcolumns

208 -- ^ unique column or group of columns

209− -> TableConstraintExpression schema columns ('Unique (Aliases subcolumns))

209+ -> TableConstraintExpression schema columns ('Unique (AliasesOf subcolumns))

210unique columns = UnsafeTableConstraintExpression $

211 "UNIQUE" <+> parenthesized (renderCommaSeparated renderColumn columns)

212

@@ -226,7 +226,7 @@ primaryKey

226 :: (SOP.SListI subcolumns, AllNotNull subcolumns)

227 => NP (Column columns) subcolumns

228 -- ^ identifying column or group of columns

229− -> TableConstraintExpression schema columns ('PrimaryKey (Aliases subcolumns))

229+ -> TableConstraintExpression schema columns ('PrimaryKey (AliasesOf subcolumns))

230primaryKey columns = UnsafeTableConstraintExpression $

231 "PRIMARY KEY" <+> parenthesized (renderCommaSeparated renderColumn columns)

232

@@ -289,7 +289,7 @@ foreignKey

289 -> OnUpdateClause

290 -- ^ what to do when reference is updated

291 -> TableConstraintExpression schema columns

292− ('ForeignKey (Aliases subcolumns) table (Aliases refsubcolumns))

292+ ('ForeignKey (AliasesOf subcolumns) table (AliasesOf refsubcolumns))

293foreignKey columns reftable refcolumns onDelete onUpdate =

294 UnsafeTableConstraintExpression $

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

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+10−11

@@ -97,7 +97,7 @@ module Squeal.PostgreSQL.Expression

97 , every, everyDistinct

98 , max_, maxDistinct, min_, minDistinct

99 -- * Tables

100− , Subtable (UnsafeSubtable, renderSubtable)

100+ , Table (UnsafeTable, renderTable)

101 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

102 , PGTyped (pgtype)

103 , bool

@@ -936,19 +936,18 @@ minDistinct = unsafeAggregateDistinct "min"

936tables

937-----------------------------------------}

938

939−-- | A `Subtable` from a table expression is a way

939+-- | A `Table` from a table expression is a way

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

941−newtype Subtable

941+newtype Table

942− (table :: RelationsType)

942+ (schema :: TablesType)

943 (columns :: RelationType)

944− = UnsafeSubtable { renderSubtable :: ByteString }

944+ = UnsafeTable { renderTable :: ByteString }

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

946−instance Has

946+instance

947− (subtable :: Symbol)

947+ ( Has alias schema table

948− (table :: RelationsType)

948+ , relation ~ ColumnsToRelation (TableToColumns table)

949− (columns :: RelationType)

949+ ) => IsLabel alias (Table schema relation) where

950− => IsLabel subtable (Subtable table columns) where

951− fromLabel = UnsafeSubtable $ renderAlias (Alias @subtable)

950+ fromLabel = UnsafeTable $ renderAlias (Alias @alias)

952

951

953{-----------------------------------------

952{-----------------------------------------

954type expressions

953type expressions

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

@@ -12,6 +12,7 @@ Squeal queries.

12 DataKinds

13 , DeriveDataTypeable

14 , DeriveGeneric

15+ , FlexibleContexts

15 , FlexibleInstances

16 , FlexibleInstances

16 , GADTs

17 , GADTs

17 , GeneralizedNewtypeDeriving

18 , GeneralizedNewtypeDeriving

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

45 , selectDistinctDotStar

46 , selectDistinctDotStar

46 -- * Table Expressions

47 -- * Table Expressions

47 , TableExpression (..)

48 , TableExpression (..)

48− , renderSubtableExpression

49+ , renderTableExpression

49 , from

50 , from

50 , where_

51 , where_

51 , group

52 , group

@@ -70,7 +71,7 @@ module Squeal.PostgreSQL.Query

71import Control.DeepSeq

72import Control.DeepSeq

72import Data.ByteString (ByteString)

73import Data.ByteString (ByteString)

73−import Data.Monoid

74+import Data.Monoid hiding (All)

74import Data.String

75import Data.String

75import Data.Word

76import Data.Word

76import Generics.SOP hiding (from)

77import Generics.SOP hiding (from)

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

348select list tabs = UnsafeQuery $

349select list tabs = UnsafeQuery $

349 "SELECT"

350 "SELECT"

350 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

351 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

351− <+> renderSubtableExpression tabs

352+ <+> renderTableExpression tabs

352

353

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

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

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

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

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

362selectDistinct list tabs = UnsafeQuery $

363selectDistinct list tabs = UnsafeQuery $

363 "SELECT DISTINCT"

364 "SELECT DISTINCT"

364 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

365 <+> renderCommaSeparated (renderAliasedAs renderExpression) list

365− <+> renderSubtableExpression tabs

366+ <+> renderTableExpression tabs

366

367

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

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

368-- that the table expression produces.

369-- that the table expression produces.

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

371 => TableExpression schema params tables 'Ungrouped

372 => TableExpression schema params tables 'Ungrouped

372 -- ^ intermediate virtual table

373 -- ^ intermediate virtual table

373 -> Query schema params columns

374 -> Query schema params columns

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

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

375

376

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

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

377-- produces and eliminates duplicate rows.

378-- produces and eliminates duplicate rows.

@@ -381,32 +382,32 @@ selectDistinctStar

381 -- ^ intermediate virtual table

382 -- ^ intermediate virtual table

382 -> Query schema params columns

383 -> Query schema params columns

383selectDistinctStar tabs = UnsafeQuery $

384selectDistinctStar tabs = UnsafeQuery $

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

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

385

386

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

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

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

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

388selectDotStar

389selectDotStar

389 :: Has table tables columns

390 :: Has table tables columns

390 => Alias table

391 => Alias table

391− -- ^ particular virtual subtable

392+ -- ^ particular virtual Table

392 -> TableExpression schema params tables 'Ungrouped

393 -> TableExpression schema params tables 'Ungrouped

393 -- ^ intermediate virtual table

394 -- ^ intermediate virtual table

394 -> Query schema params columns

395 -> Query schema params columns

395selectDotStar table tables = UnsafeQuery $

396selectDotStar table tables = UnsafeQuery $

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

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

397

398

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

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

399-- and eliminates duplicate rows.

400-- and eliminates duplicate rows.

400selectDistinctDotStar

401selectDistinctDotStar

401 :: Has table tables columns

402 :: Has table tables columns

402 => Alias table

403 => Alias table

403− -- ^ particular virtual subtable

404+ -- ^ particular virtual Table

404 -> TableExpression schema params tables 'Ungrouped

405 -> TableExpression schema params tables 'Ungrouped

405 -- ^ intermediate virtual table

406 -- ^ intermediate virtual table

406 -> Query schema params columns

407 -> Query schema params columns

407selectDistinctDotStar table tables = UnsafeQuery $

408selectDistinctDotStar table tables = UnsafeQuery $

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

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

409− <+> renderSubtableExpression tables

410+ <+> renderTableExpression tables

410

411

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

412{-----------------------------------------

412Table Expressions

413Table Expressions

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

466 }

467 }

467

468

468-- | Render a `TableExpression`

469-- | Render a `TableExpression`

469−renderSubtableExpression

470+renderTableExpression

470 :: TableExpression schema params tables grouping

471 :: TableExpression schema params tables grouping

471 -> ByteString

472 -> ByteString

472−renderSubtableExpression

473+renderTableExpression

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

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

474 [ "FROM ", renderFromClause tables

475 [ "FROM ", renderFromClause tables

475 , renderWheres whs'

476 , renderWheres whs'

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

612-}

613-}

613data FromClause schema params tables where

614data FromClause schema params tables where

614 Table

615 Table

615− :: Aliased (Subtable (TablesToRelations schema)) table

616+ :: Aliased (Table schema) table

616 -> FromClause schema params '[table]

617 -> FromClause schema params '[table]

617 Subquery

618 Subquery

618 :: Aliased (Query schema params) table

619 :: Aliased (Query schema params) table

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

646-- | Renders a `FromClause`.

647-- | Renders a `FromClause`.

647renderFromClause :: FromClause schema params tables -> ByteString

648renderFromClause :: FromClause schema params tables -> ByteString

648renderFromClause = \case

649renderFromClause = \case

649− Table table -> renderAliasedAs renderSubtable table

650+ Table table -> renderAliasedAs renderTable table

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

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

651 CrossJoin right left ->

652 CrossJoin right left ->

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

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

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

@@ -43,21 +43,29 @@ module Squeal.PostgreSQL.Schema

43 , TableType

44 , TablesType

45 , Grouping (..)

46− -- * Constraints

46+ -- * PostgreSQL Constraints

47− , PGNum

47+ , (:=>)

48− , PGIntegral

48+ , ColumnsToRelation

49− , PGFloating

49+ , TableToColumns

50− -- * Aliases

50+ , TablesToRelations

51+ , ColumnConstraint (..)

52+ , TableConstraint (..)

53+ -- * AliasesOf

51 , (:::)

54 , (:::)

52 , Alias (Alias)

55 , Alias (Alias)

53 , renderAlias

56 , renderAlias

54 , Aliased (As)

57 , Aliased (As)

55 , renderAliasedAs

58 , renderAliasedAs

59+ , AliasesOf

60+ , Has

61+ , HasUnique

56 , IsLabel (..)

62 , IsLabel (..)

57 , IsTableColumn (..)

63 , IsTableColumn (..)

58 -- * Type Families

64 -- * Type Families

59 , In

65 , In

60− , HasUnique

66+ , PGNum

67+ , PGIntegral

68+ , PGFloating

61 , PGTypeOf

69 , PGTypeOf

62 , SameTypes

70 , SameTypes

63 , AllNotNull

71 , AllNotNull

@@ -75,15 +83,6 @@ module Squeal.PostgreSQL.Schema

75 -- * Generics

83 -- * Generics

76 , SameField

84 , SameField

77 , SameFields

85 , SameFields

78− -- * PostgreSQL Constraints

79− , (:=>)

80− , ColumnsToRelation

81− , TableToColumns

82− , TablesToRelations

83− , ColumnConstraint (..)

84− , TableConstraint (..)

85− , Aliases

86− , Has

87 ) where

86 ) where

89import Control.DeepSeq

88import Control.DeepSeq

@@ -198,22 +197,6 @@ data Grouping

198 = Ungrouped -- ^ no aggregation permitted

197 = Ungrouped -- ^ no aggregation permitted

199 | Grouped [(Symbol,Symbol)] -- ^ aggregation required for any column which is not grouped

198 | Grouped [(Symbol,Symbol)] -- ^ aggregation required for any column which is not grouped

200

199

201−-- | `PGNum` is a constraint on `PGType` whose

202−-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.

203−type PGNum ty =

204− In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

205−

206−-- | `PGFloating` is a constraint on `PGType` whose

207−-- `Squeal.PostgreSQL.Expression.Expression`s

208−-- have `Fractional` and `Floating` constraints.

209−type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

210−

211−-- | `PGIntegral` is a constraint on `PGType` whose

212−-- `Squeal.PostgreSQL.Expression.Expression`s

213−-- have `Squeal.PostgreSQL.Expression.div_` and

214−-- `Squeal.PostgreSQL.Expression.mod_` functions.

215−type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]

216−

217-- | `Alias`es are proxies for a type level string or `Symbol`

200-- | `Alias`es are proxies for a type level string or `Symbol`

218-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

201-- and have an `IsLabel` instance so that with @-XOverloadedLabels@

219--

202--

@@ -225,8 +208,8 @@ data Alias (alias :: Symbol) = Alias

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

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

226 fromLabel = Alias

209 fromLabel = Alias

227

210

228−-- | >>> renderAlias #alias

211+-- | >>> renderAlias #jimbob

229−-- "alias"

212+-- "jimbob"

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

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

231renderAlias = fromString . symbolVal

214renderAlias = fromString . symbolVal

232

215

@@ -261,6 +244,25 @@ renderAliasedAs

261renderAliasedAs render (expression `As` alias) =

244renderAliasedAs render (expression `As` alias) =

262 render expression <> " AS " <> renderAlias alias

245 render expression <> " AS " <> renderAlias alias

263

246

247+-- | `AliasesOf` retains the AliasesOf in a row.

248+type family AliasesOf aliaseds where

249+ AliasesOf '[] = '[]

250+ AliasesOf (alias ::: ty ': tys) = alias ': AliasesOf tys

251+

252+-- | @HasUnique alias xs x@ is a constraint that proves that @xs@ is a singleton

253+-- of @alias ::: x@.

254+type HasUnique alias xs x = xs ~ '[alias ::: x]

255+

256+-- | @Has alias xs x@ is a constraint that proves that @xs@ has a field

257+-- of @alias ::: x@.

258+class KnownSymbol alias =>

259+ Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)

260+ | alias fields -> field where

261+instance {-# OVERLAPPING #-} KnownSymbol alias

262+ => Has alias (alias ::: field ': fields) field

263+instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

264+ => Has alias (field' ': fields) field

265+

264-- | Analagous to `IsLabel`, the constraint

266-- | Analagous to `IsLabel`, the constraint

265-- `IsTableColumn` defines `!` for a column alias qualified

267-- `IsTableColumn` defines `!` for a column alias qualified

266-- by a table alias.

268-- by a table alias.

@@ -274,9 +276,21 @@ type family In x xs :: Constraint where

274 In x (x ': xs) = ()

276 In x (x ': xs) = ()

275 In x (y ': xs) = In x xs

277 In x (y ': xs) = In x xs

276

278

277−-- | @HasUnique alias xs x@ is a constraint that proves that @xs@ is a singleton

279+-- | `PGNum` is a constraint on `PGType` whose

278−-- of @alias ::: x@.

280+-- `Squeal.PostgreSQL.Expression.Expression`s have a `Num` constraint.

279−type HasUnique alias xs x = xs ~ '[alias ::: x]

281+type PGNum ty =

282+ In ty '[ 'PGint2, 'PGint4, 'PGint8, 'PGnumeric, 'PGfloat4, 'PGfloat8]

283+

284+-- | `PGFloating` is a constraint on `PGType` whose

285+-- `Squeal.PostgreSQL.Expression.Expression`s

286+-- have `Fractional` and `Floating` constraints.

287+type PGFloating ty = In ty '[ 'PGfloat4, 'PGfloat8, 'PGnumeric]

288+

289+-- | `PGIntegral` is a constraint on `PGType` whose

290+-- `Squeal.PostgreSQL.Expression.Expression`s

291+-- have `Squeal.PostgreSQL.Expression.div_` and

292+-- `Squeal.PostgreSQL.Expression.mod_` functions.

293+type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8]

280

294

281-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

295-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

282type family PGTypeOf (ty :: NullityType) :: PGType where

296type family PGTypeOf (ty :: NullityType) :: PGType where

@@ -382,7 +396,7 @@ instance field ~ column => SameField ('Type.FieldInfo field) (column ::: ty)

382

396

383-- | A `SameFields` constraint proves that a

397-- | A `SameFields` constraint proves that a

384-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same

398-- `Generics.SOP.Type.Metadata.DatatypeInfo` of a record type has the same

385−-- field names as the column aliases of a `ColumnsType`.

399+-- field names as the column AliasesOf of a `ColumnsType`.

386type family SameFields

400type family SameFields

387 (datatypeInfo :: Type.DatatypeInfo) (columns :: RelationType)

401 (datatypeInfo :: Type.DatatypeInfo) (columns :: RelationType)

388 :: Constraint where

402 :: Constraint where

@@ -394,17 +408,3 @@ type family SameFields

394 ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

408 ('Type.Newtype _module _datatype ('Type.Record _constructor fields))

395 columns

409 columns

396 = AllZip SameField fields columns

410 = AllZip SameField fields columns

397−

398−-- type Unconstraint = ('[] :: [(Symbol,TableConstraint)])

399−

400−type family Aliases xs where

401− Aliases '[] = '[]

402− Aliases ((alias ::: x) ': xs) = alias ': Aliases xs

403−

404−class KnownSymbol alias =>

405− Has (alias :: Symbol) (fields :: [(Symbol,kind)]) (field :: kind)

406− | alias fields -> field where

407−instance {-# OVERLAPPING #-} KnownSymbol alias

408− => Has alias (alias ::: field ': fields) field

409−instance {-# OVERLAPPABLE #-} (KnownSymbol alias, Has alias fields field)

410− => Has alias (field' ': fields) field