3be316a · squeal · git.iko.soy

git.iko.soy/squeal

lots of stuff

commit3be316a547d4dffecaf22ef4558bebe28c69d78c authorEitan Chatav <eitan.chatav@gmail.com> dateTue 17 Apr 2018, 13:22 (9 years ago) parente7e9693

11 files changed+97−189

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+30−50

@@ -9,10 +9,7 @@ Binary encoding and decoding between Haskell and PostgreSQL types.

99-}

1010

1111{-# LANGUAGE

12− ConstraintKinds

13− , DataKinds

14− , DefaultSignatures

15− , DeriveFoldable

12+ DeriveFoldable

1613 , DeriveFunctor

1714 , DeriveGeneric

1815 , DeriveTraversable

@@ -20,12 +17,9 @@ Binary encoding and decoding between Haskell and PostgreSQL types.

2017 , FlexibleInstances

2118 , GADTs

2219 , LambdaCase

23− , KindSignatures

2420 , MultiParamTypeClasses

2521 , ScopedTypeVariables

2622 , TypeApplications

27− , TypeFamilies

28− , TypeFamilyDependencies

2923 , TypeInType

3024 , TypeOperators

3125 , UndecidableInstances

@@ -231,61 +225,47 @@ instance

231225 Decoding.enum (readMaybe . upper . Strict.unpack)

232226instance

233227 ( SListI fields

234− , IsMaybes ys

228+ , MapMaybes ys

235229 , IsProductType y (Maybes ys)

236230 , AllZip FromAliasedValue fields ys

237231 , SameFields (DatatypeInfoOf y) fields

238232 ) => FromValue ('PGcomposite fields) y where

239− fromValue = fmap (to . SOP . Z . maybes) . composite . decoders

240−

241−class IsMaybes (xs :: [Type]) where

242− type family Maybes xs = (mxs :: [Type]) | mxs -> xs

243− maybes :: NP Maybe xs -> NP I (Maybes xs)

233+ fromValue =

234+ let

235+ decoders

236+ :: forall pgs zs proxy

237+ . AllZip FromAliasedValue pgs zs

238+ => proxy ('PGcomposite pgs)

239+ -> NP Decoding.Value zs

240+ decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue

241+ (hpure Proxy :: NP Proxy pgs)

244242

245−instance IsMaybes '[] where

246− type Maybes '[] = '[]

247− maybes Nil = Nil

243+ composite fields = do

244+ -- [for each field]

245+ -- <OID of field's type: sizeof(Oid) bytes>

246+ -- [if value is NULL]

247+ -- <-1: 4 bytes>

248+ -- [else]

249+ -- <length of value: 4 bytes>

250+ -- <value: <length> bytes>

251+ -- [end if]

252+ -- [end for]

253+ -- <number of fields: 4 bytes>

254+ unitOfSize 4

255+ let

256+ each field = do

257+ unitOfSize 4

258+ len <- sized 4 Decoding.int

259+ if len == -1 then return Nothing else Just <$> sized len field

260+ htraverse' each fields

248261

249−instance IsMaybes xs => IsMaybes (x ': xs) where

250− type Maybes (x ': xs) = Maybe x ': Maybes xs

251− maybes (x :* xs) = I x :* maybes xs

262+ in fmap (to . SOP . Z . maybes) . composite . decoders

252263

253264class FromAliasedValue (pg :: (Symbol,PGType)) (y :: Type) where

254265 fromAliasedValue :: proxy pg -> Decoding.Value y

255266instance FromValue pg y => FromAliasedValue (alias ::: pg) y where

256267 fromAliasedValue _ = fromValue (Proxy @pg)

257268

258−decoders

259− :: forall pgs ys proxy

260− . AllZip FromAliasedValue pgs ys

261− => proxy ('PGcomposite pgs)

262− -> NP Decoding.Value ys

263−decoders _ = htrans (Proxy @FromAliasedValue) fromAliasedValue

264− (hpure Proxy :: NP Proxy pgs)

265−

266−composite

267− :: SListI ys

268− => NP Decoding.Value ys

269− -> Decoding.Value (NP Maybe ys)

270−composite fields = do

271−-- [for each field]

272−-- <OID of field's type: sizeof(Oid) bytes>

273−-- [if value is NULL]

274−-- <-1: 4 bytes>

275−-- [else]

276−-- <length of value: 4 bytes>

277−-- <value: <length> bytes>

278−-- [end if]

279−-- [end for]

280−-- <number of fields: 4 bytes>

281− unitOfSize 4

282− let

283− each field = do

284− unitOfSize 4

285− len <- sized 4 Decoding.int

286− if len == -1 then return Nothing else Just <$> sized len field

287− htraverse' each fields

288−

289269-- | A `FromColumnValue` constraint lifts the `FromValue` parser

290270-- to a decoding of a @(Symbol, ColumnType)@ to a `Type`,

291271-- decoding `Null`s to `Maybe`s. You should not define instances for

squeal-postgresql/src/Squeal/PostgreSQL/Definition.hs−4

@@ -10,20 +10,16 @@ Squeal data definition language.

1010

1111{-# LANGUAGE

1212 ConstraintKinds

13− , DataKinds

14− , DeriveDataTypeable

1513 , DeriveGeneric

1614 , FlexibleContexts

1715 , FlexibleInstances

1816 , GADTs

1917 , GeneralizedNewtypeDeriving

20− , KindSignatures

2118 , LambdaCase

2219 , MultiParamTypeClasses

2320 , OverloadedStrings

2421 , RankNTypes

2522 , ScopedTypeVariables

26− , StandaloneDeriving

2723 , TypeApplications

2824 , TypeInType

2925 , TypeOperators

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

@@ -11,21 +11,15 @@ Squeal expressions are the atoms used to build statements.

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

1212{-# LANGUAGE

1313 AllowAmbiguousTypes

14− , DataKinds

1514 , DeriveGeneric

16− , DeriveDataTypeable

1715 , FlexibleContexts

1816 , FlexibleInstances

1917 , FunctionalDependencies

20− , GADTs

2118 , GeneralizedNewtypeDeriving

2219 , LambdaCase

2320 , MagicHash

2421 , OverloadedStrings

25− , PolyKinds

26− , RankNTypes

2722 , ScopedTypeVariables

28− , StandaloneDeriving

2923 , TypeApplications

3024 , TypeFamilies

3125 , TypeInType

@@ -46,8 +40,10 @@ module Squeal.PostgreSQL.Expression

4640 , isn'tNull

4741 , matchNull

4842 , nullIf

49− -- ** Arrays

43+ -- ** Arrays, Enums, Composites

5044 , array

45+ , label

46+ , row

5147 -- ** Functions

5248 , unsafeBinaryOp

5349 , unsafeUnaryOp

@@ -330,10 +326,6 @@ label

330326label (_ :: Alias label) = UnsafeExpression $

331327 fromString $ symbolVal (Proxy @label)

332328

333−type family Nulls tys where

334− Nulls '[] = '[]

335− Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys

336−

337329row

338330 :: (SListI (Nulls fields))

339331 => NP (Aliased (Expression relation grouping params)) (Nulls fields)

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+41−45

@@ -9,17 +9,13 @@ Squeal data manipulation language.

99-}

1010

1111{-# LANGUAGE

12− DataKinds

13− , DeriveDataTypeable

14− , DeriveGeneric

12+ DeriveGeneric

1513 , FlexibleContexts

1614 , GADTs

1715 , GeneralizedNewtypeDeriving

18− , KindSignatures

1916 , LambdaCase

2017 , OverloadedStrings

2118 , RankNTypes

22− , StandaloneDeriving

2319 , TypeInType

2420 , TypeOperators

2521#-}

@@ -203,32 +199,32 @@ queryStatement q = UnsafeManipulation $ renderQuery q <> ";"

203199INSERT statements

204200-----------------------------------------}

205201

206−-- | Insert multiple rows.

202+-- | Insert multiple rws.

207203--

208204-- When a table is created, it contains no data. The first thing to do

209205-- before a database can be of much use is to insert data. Data is

210−-- conceptually inserted one row at a time. Of course you can also insert

211−-- more than one row, but there is no way to insert less than one row.

212−-- Even if you know only some column values, a complete row must be created.

206+-- conceptually inserted one rw at a time. Of course you can also insert

207+-- more than one rw, but there is no way to insert less than one rw.

208+-- Even if you know only some column values, a complete rw must be created.

213209insertRows

214210 :: ( SOP.SListI columns

215211 , SOP.SListI results

216212 , Has tab schema ('Table table)

217213 , columns ~ TableToColumns table )

218214 => Alias tab -- ^ table to insert into

219− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

220− -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert

215+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert

216+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rws to insert

221217 -> ConflictClause columns params

222218 -- ^ what to do in case of constraint conflict

223219 -> ReturningClause columns params results -- ^ results to return

224220 -> Manipulation schema params results

225−insertRows tab row rows conflict returning = UnsafeManipulation $

221+insertRows tab rw rws conflict returning = UnsafeManipulation $

226222 "INSERT" <+> "INTO" <+> renderAlias tab

227− <+> parenthesized (renderCommaSeparated renderAliasPart row)

223+ <+> parenthesized (renderCommaSeparated renderAliasPart rw)

228224 <+> "VALUES"

229225 <+> commaSeparated

230226 ( parenthesized

231− . renderCommaSeparated renderColumnValuePart <$> row:rows )

227+ . renderCommaSeparated renderColumnValuePart <$> rw:rws )

232228 <> renderConflictClause conflict

233229 <> renderReturningClause returning

234230 where

@@ -239,41 +235,41 @@ insertRows tab row rows conflict returning = UnsafeManipulation $

239235 Default -> "DEFAULT"

240236 Set expression -> renderExpression expression

241237

242−-- | Insert a single row.

238+-- | Insert a single rw.

243239insertRow

244240 :: ( SOP.SListI columns

245241 , SOP.SListI results

246242 , Has tab schema ('Table table)

247243 , columns ~ TableToColumns table )

248244 => Alias tab -- ^ table to insert into

249− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

245+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert

250246 -> ConflictClause columns params

251247 -- ^ what to do in case of constraint conflict

252248 -> ReturningClause columns params results -- ^ results to return

253249 -> Manipulation schema params results

254−insertRow tab row = insertRows tab row []

250+insertRow tab rw = insertRows tab rw []

255251

256−-- | Insert multiple rows returning `Nil` and raising an error on conflicts.

252+-- | Insert multiple rws returning `Nil` and raising an error on conflicts.

257253insertRows_

258254 :: ( SOP.SListI columns

259255 , Has tab schema ('Table table)

260256 , columns ~ TableToColumns table )

261257 => Alias tab -- ^ table to insert into

262− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

263− -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rows to insert

258+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert

259+ -> [NP (Aliased (ColumnValue '[] params)) columns] -- ^ more rws to insert

264260 -> Manipulation schema params '[]

265−insertRows_ tab row rows =

266− insertRows tab row rows OnConflictDoRaise (Returning Nil)

261+insertRows_ tab rw rws =

262+ insertRows tab rw rws OnConflictDoRaise (Returning Nil)

267263

268−-- | Insert a single row returning `Nil` and raising an error on conflicts.

264+-- | Insert a single rw returning `Nil` and raising an error on conflicts.

269265insertRow_

270266 :: ( SOP.SListI columns

271267 , Has tab schema ('Table table)

272268 , columns ~ TableToColumns table )

273269 => Alias tab -- ^ table to insert into

274− -> NP (Aliased (ColumnValue '[] params)) columns -- ^ row to insert

270+ -> NP (Aliased (ColumnValue '[] params)) columns -- ^ rw to insert

275271 -> Manipulation schema params '[]

276−insertRow_ tab row = insertRow tab row OnConflictDoRaise (Returning Nil)

272+insertRow_ tab rw = insertRow tab rw OnConflictDoRaise (Returning Nil)

277273

278274-- | Insert a `Query`.

279275insertQuery

@@ -304,11 +300,11 @@ insertQuery_

304300insertQuery_ tab query =

305301 insertQuery tab query OnConflictDoRaise (Returning Nil)

306302

307−-- | `ColumnValue`s are values to insert or update in a row

303+-- | `ColumnValue`s are values to insert or update in a rw

308304-- `Same` updates with the same value.

309305-- `Default` inserts or updates with the @DEFAULT@ value

310306-- `Set` a value to be an `Expression`, relative to the given

311−-- row for an update, and closed for an insert.

307+-- rw for an update, and closed for an insert.

312308data ColumnValue

313309 (columns :: RelationType)

314310 (params :: [NullityType])

@@ -321,14 +317,14 @@ data ColumnValue

321317 -> ColumnValue columns params (constraint :=> ty)

322318

323319-- | A `ReturningClause` computes and return value(s) based

324−-- on each row actually inserted, updated or deleted. This is primarily

320+-- on each rw actually inserted, updated or deleted. This is primarily

325321-- useful for obtaining values that were supplied by defaults, such as a

326322-- serial sequence number. However, any expression using the table's columns

327−-- is allowed. Only rows that were successfully inserted or updated or

328−-- deleted will be returned. For example, if a row was locked

323+-- is allowed. Only rws that were successfully inserted or updated or

324+-- deleted will be returned. For example, if a rw was locked

329325-- but not updated because an `OnConflictDoUpdate` condition was not satisfied,

330−-- the row will not be returned. `ReturningStar` will return all columns

331−-- in the row. Use @Returning Nil@ in the common case where no return

326+-- the rw will not be returned. `ReturningStar` will return all columns

327+-- in the rw. Use @Returning Nil@ in the common case where no return

332328-- values are desired.

333329data ReturningClause

334330 (columns :: ColumnsType)

@@ -356,8 +352,8 @@ renderReturningClause = \case

356352

357353-- | A `ConflictClause` specifies an action to perform upon a constraint

358354-- violation. `OnConflictDoRaise` will raise an error.

359−-- `OnConflictDoNothing` simply avoids inserting a row.

360−-- `OnConflictDoUpdate` updates the existing row that conflicts with the row

355+-- `OnConflictDoNothing` simply avoids inserting a rw.

356+-- `OnConflictDoUpdate` updates the existing rw that conflicts with the rw

361357-- proposed for insertion.

362358data ConflictClause (columns :: ColumnsType) params where

363359 OnConflictDoRaise :: ConflictClause columns params

@@ -397,7 +393,7 @@ UPDATE statements

397393-----------------------------------------}

398394

399395-- | An `update` command changes the values of the specified columns

400−-- in all rows that satisfy the condition.

396+-- in all rws that satisfy the condition.

401397update

402398 :: ( SOP.SListI columns

403399 , SOP.SListI results

@@ -407,7 +403,7 @@ update

407403 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns

408404 -- ^ modified values to replace old values

409405 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

410− -- ^ condition under which to perform update on a row

406+ -- ^ condition under which to perform update on a rw

411407 -> ReturningClause columns params results -- ^ results to return

412408 -> Manipulation schema params results

413409update tab columns wh returning = UnsafeManipulation $

@@ -428,7 +424,7 @@ update tab columns wh returning = UnsafeManipulation $

428424 Set expression `As` column -> Just $

429425 renderAlias column <+> "=" <+> renderExpression expression

430426

431−-- | Update a row returning `Nil`.

427+-- | Update a rw returning `Nil`.

432428update_

433429 :: ( SOP.SListI columns

434430 , Has tab schema ('Table table)

@@ -437,7 +433,7 @@ update_

437433 -> NP (Aliased (ColumnValue (ColumnsToRelation columns) params)) columns

438434 -- ^ modified values to replace old values

439435 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

440− -- ^ condition under which to perform update on a row

436+ -- ^ condition under which to perform update on a rw

441437 -> Manipulation schema params '[]

442438update_ tab columns wh = update tab columns wh (Returning Nil)

443439

@@ -445,14 +441,14 @@ update_ tab columns wh = update tab columns wh (Returning Nil)

445441DELETE statements

446442-----------------------------------------}

447443

448−-- | Delete rows of a table.

444+-- | Delete rws of a table.

449445deleteFrom

450446 :: ( SOP.SListI results

451447 , Has tab schema ('Table table)

452448 , columns ~ TableToColumns table )

453449 => Alias tab -- ^ table to delete from

454450 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

455− -- ^ condition under which to delete a row

451+ -- ^ condition under which to delete a rw

456452 -> ReturningClause columns params results -- ^ results to return

457453 -> Manipulation schema params results

458454deleteFrom tab wh returning = UnsafeManipulation $

@@ -460,13 +456,13 @@ deleteFrom tab wh returning = UnsafeManipulation $

460456 <+> "WHERE" <+> renderExpression wh

461457 <> renderReturningClause returning

462458

463−-- | Delete rows returning `Nil`.

459+-- | Delete rws returning `Nil`.

464460deleteFrom_

465461 :: ( Has tab schema ('Table table)

466462 , columns ~ TableToColumns table )

467463 => Alias tab -- ^ table to delete from

468464 -> Condition '[tab ::: ColumnsToRelation columns] 'Ungrouped params

469− -- ^ condition under which to delete a row

465+ -- ^ condition under which to delete a rw

470466 -> Manipulation schema params '[]

471467deleteFrom_ tab wh = deleteFrom tab wh (Returning Nil)

472468

@@ -484,11 +480,11 @@ WITH statements

484480-- let

485481-- manipulation :: Manipulation '["products" ::: 'Table ProductsTable, "products_deleted" ::: 'Table ProductsTable] '[ 'NotNull 'PGdate] '[]

486482-- manipulation = with

487−-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rows :* Nil)

488−-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rows `As` #t)))))

483+-- (deleteFrom #products (#date .< param @1) ReturningStar `As` #deleted_rws :* Nil)

484+-- (insertQuery_ #products_deleted (selectStar (from (view (#deleted_rws `As` #t)))))

489485-- in renderManipulation manipulation

490486-- :}

491−-- "WITH \"deleted_rows\" AS (DELETE FROM \"products\" WHERE (\"date\" < ($1 :: date)) RETURNING *) INSERT INTO \"products_deleted\" SELECT * FROM \"deleted_rows\" AS \"t\";"

487+-- "WITH \"deleted_rws\" AS (DELETE FROM \"products\" WHERE (\"date\" < ($1 :: date)) RETURNING *) INSERT INTO \"products_deleted\" SELECT * FROM \"deleted_rws\" AS \"t\";"

492488with

493489 :: SOP.SListI commons

494490 => NP (Aliased (Manipulation schema params)) commons

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

@@ -90,9 +90,7 @@ Row 0

9090-}

9191

9292{-# LANGUAGE

93− ScopedTypeVariables

94− , OverloadedStrings

95− , DataKinds

93+ DataKinds

9694 , GADTs

9795 , LambdaCase

9896 , PolyKinds

squeal-postgresql/src/Squeal/PostgreSQL/PQ.hs+1−6

@@ -20,15 +20,10 @@ of executing Squeal commands.

2020

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

2222{-# LANGUAGE

23− DataKinds

24− , DefaultSignatures

23+ DefaultSignatures

2524 , FunctionalDependencies

26− , PolyKinds

27− , DeriveFunctor

2825 , FlexibleContexts

2926 , FlexibleInstances

30− , MagicHash

31− , MultiParamTypeClasses

3227 , OverloadedStrings

3328 , RankNTypes

3429 , ScopedTypeVariables

squeal-postgresql/src/Squeal/PostgreSQL/Pool.hs+1−2

@@ -9,8 +9,7 @@ A `MonadPQ` for pooled connections.

99-}

1010

1111{-# LANGUAGE

12− DataKinds

13− , DeriveFunctor

12+ DeriveFunctor

1413 , FlexibleContexts

1514 , FlexibleInstances

1615 , MultiParamTypeClasses

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

@@ -9,23 +9,14 @@ Squeal queries.

99-}

1010

1111{-# LANGUAGE

12− DataKinds

13− , DeriveDataTypeable

14− , DeriveGeneric

15− , FlexibleContexts

16− , FlexibleInstances

12+ DeriveGeneric

1713 , GADTs

1814 , GeneralizedNewtypeDeriving

19− , KindSignatures

2015 , LambdaCase

21− , MultiParamTypeClasses

2216 , OverloadedStrings

23− , ScopedTypeVariables

2417 , StandaloneDeriving

25− , TypeApplications

2618 , TypeInType

2719 , TypeOperators

28− , UndecidableInstances

2920#-}

3021

3122module Squeal.PostgreSQL.Query

squeal-postgresql/src/Squeal/PostgreSQL/Render.hs−1

@@ -14,7 +14,6 @@ Rendering helper functions.

1414 , PolyKinds

1515 , RankNTypes

1616 , ScopedTypeVariables

17− , TypeApplications

1817#-}

1918

2019module Squeal.PostgreSQL.Render

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

@@ -11,23 +11,17 @@ A type-level DSL for kinds of PostgreSQL types, constraints, and aliases.

1111{-# LANGUAGE

1212 AllowAmbiguousTypes

1313 , ConstraintKinds

14− , DataKinds

1514 , DeriveAnyClass

16− , DeriveDataTypeable

1715 , DeriveGeneric

1816 , FlexibleContexts

1917 , FlexibleInstances

2018 , FunctionalDependencies

2119 , GADTs

22− , MagicHash

23− , MultiParamTypeClasses

2420 , OverloadedStrings

25− , PolyKinds

2621 , RankNTypes

27− , ScopedTypeVariables

2822 , StandaloneDeriving

2923 , TypeApplications

30− , TypeFamilies

24+ , TypeFamilyDependencies

3125 , TypeInType

3226 , TypeOperators

3327 , UndecidableInstances

@@ -45,8 +39,6 @@ module Squeal.PostgreSQL.Schema

4539 , NilRelation

4640 , RelationsType

4741 , TableType

48− , TablesType

49− , NilTables

5042 -- * Grouping

5143 , Grouping (..)

5244 , GroupedBy

@@ -92,8 +84,6 @@ module Squeal.PostgreSQL.Schema

9284 , ColumnsToRelation

9385 , RelationToColumns

9486 , TableToColumns

95− , TablesToRelations

96− , RelationsToTables

9787 , ConstraintInvolves

9888 , DropIfConstraintsInvolve

9989 -- * Generics

@@ -101,6 +91,8 @@ module Squeal.PostgreSQL.Schema

10191 , SameFields

10292 , SameLabel

10393 , SameLabels

94+ , MapMaybes (..)

95+ , Nulls

10496 -- * Schema

10597 , SchemumType (..)

10698 , SchemaType

@@ -109,11 +101,11 @@ module Squeal.PostgreSQL.Schema

109101

110102import Control.DeepSeq

111103import Data.ByteString

104+import Data.Kind

112105import Data.Monoid hiding (All)

113106import Data.String

114107import Data.Word

115108import Data.Type.Bool

116−import GHC.Exts

117109import GHC.OverloadedLabels

118110import GHC.TypeLits

119111

@@ -279,31 +271,6 @@ type family Uniquely

279271-- :}

280272type TableType = (TableConstraints,ColumnsType)

281273

282−-- | `TablesType` is a row of `TableType`s, thought of as a union.

283−--

284−-- >>> :{

285−-- type family Schema :: TablesType where

286−-- Schema =

287−-- '[ "users" :::

288−-- '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=>

289−-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4

290−-- , "name" ::: 'NoDef :=> 'NotNull 'PGtext

291−-- , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2)

292−-- ]

293−-- , "emails" :::

294−-- '[ "pk_emails" ::: 'PrimaryKey '["id"]

295−-- , "fk_user_id" ::: 'ForeignKey '["user_id"] "users" '["id"]

296−-- ] :=>

297−-- '[ "id" ::: 'Def :=> 'NotNull 'PGint4

298−-- , "user_id" ::: 'NoDef :=> 'NotNull 'PGint4

299−-- , "email" ::: 'NoDef :=> 'Null 'PGtext

300−-- ]

301−-- ]

302−-- :}

303−type TablesType = [(Symbol,TableType)]

304−-- | A monokinded empty `TablesType`.

305−type family NilTables :: TablesType where NilTables = '[]

306−

307274-- | `RelationType` is a row of `NullityType`

308275--

309276-- >>> :{

@@ -337,18 +304,6 @@ type family RelationToColumns (relation :: RelationType) :: ColumnsType where

337304type family TableToColumns (table :: TableType) :: ColumnsType where

338305 TableToColumns (constraints :=> columns) = columns

339306

340−-- | `TablesToRelations` removes both table and column constraints.

341−type family TablesToRelations (tables :: TablesType) :: RelationsType where

342− TablesToRelations '[] = '[]

343− TablesToRelations (alias ::: constraint :=> columns ': tables) =

344− alias ::: ColumnsToRelation columns ': TablesToRelations tables

345−

346−-- | `RelationsToTables` adds both trivial table and column constraints.

347−type family RelationsToTables (tables :: RelationsType) :: TablesType where

348− RelationsToTables '[] = '[]

349− RelationsToTables (alias ::: columns ': relations) =

350− alias ::: '[] :=> RelationToColumns columns ': RelationsToTables relations

351−

352307-- | `Grouping` is an auxiliary namespace, created by

353308-- @GROUP BY@ clauses (`Squeal.PostgreSQL.Query.group`), and used

354309-- for typesafe aggregation

@@ -619,6 +574,20 @@ type family SameLabels

619574 ('Type.ADT _module _datatype constructors) labels

620575 = SOP.AllZip SameLabel constructors labels

621576

577+class MapMaybes xs where

578+ type family Maybes (xs :: [Type]) = (mxs :: [Type]) | mxs -> xs

579+ maybes :: SOP.NP Maybe xs -> SOP.NP SOP.I (Maybes xs)

580+instance MapMaybes '[] where

581+ type Maybes '[] = '[]

582+ maybes SOP.Nil = SOP.Nil

583+instance MapMaybes xs => MapMaybes (x ': xs) where

584+ type Maybes (x ': xs) = Maybe x ': Maybes xs

585+ maybes (x SOP.:* xs) = SOP.I x SOP.:* maybes xs

586+

587+type family Nulls tys where

588+ Nulls '[] = '[]

589+ Nulls (field ::: ty ': tys) = field ::: 'Null ty ': Nulls tys

590+

622591-- | Check if a `TableConstraint` involves a column

623592type family ConstraintInvolves column constraint where

624593 ConstraintInvolves column ('Check columns) = column `Elem` columns

squeal-postgresql/src/Squeal/PostgreSQL/Transaction.hs+1−8

@@ -9,16 +9,9 @@ Squeal transaction control language.

99-}

1010

1111{-# LANGUAGE

12− DataKinds

13− , EmptyCase

14− , FlexibleContexts

15− , FlexibleInstances

12+ FlexibleContexts

1613 , LambdaCase

1714 , OverloadedStrings

18− , MultiParamTypeClasses

19− , ScopedTypeVariables

20− , TypeFamilies

21− , TypeInType

2215#-}

2316

2417module Squeal.PostgreSQL.Transaction