ee074c4 · squeal · git.iko.soy

git.iko.soy/squeal

simplify column expression

back to the old way

commitee074c4a84e2efb777bc0746416e8d72b52ea438 authorEitan Chatav <eitan@Eitans-MacBook-Pro.local> dateSun 14 Apr 2019, 11:36 (8 years ago) parent510376f

6 files changed+48−126

compare with dev

unifiedsplit

squeal-postgresql/exe/Example.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL.hs+4−3 squeal-postgresql/src/Squeal/PostgreSQL/Alias.hs−9 squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+40−110 squeal-postgresql/src/Squeal/PostgreSQL/Migration.hs+1−1 squeal-postgresql/test/Specs/ExceptionHandling.hs+1−1

squeal-postgresql/exe/Example.hs+2−2

@@ -64,12 +64,12 @@ teardown = dropTable #emails >>> dropTable #users

6464

6565insertUser :: Manipulation_ Schemas (Text, VarArray (Vector (Maybe Int16))) (Only Int32)

6666insertUser = insertInto #users

67− (Values_ (defaultAs #id :* param @1 `as` #name :* param @2 `as` #vec))

67+ (Values_ (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec))

6868 (OnConflict (OnConstraint #pk_users) DoNothing) (Returning_ (#id `as` #fromOnly))

6969

7070insertEmail :: Manipulation_ Schemas (Int32, Maybe Text) ()

7171insertEmail = insertInto_ #emails

72− (Values_ (defaultAs #id :* param @1 `as` #user_id :* param @2 `as` #email))

72+ (Values_ (Default `as` #id :* Set (param @1) `as` #user_id :* Set (param @2) `as` #email))

7373

7474getUsers :: Query_ Schemas () User

7575getUsers = select_

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

@@ -130,10 +130,11 @@ let

130130 insertUser = with (u `as` #u) e

131131 where

132132 u = insertInto #users

133− (Values_ (defaultAs #id :* param @1 `as` #name))

133+ (Values_ (Default `as` #id :* Set (param @1) `as` #name))

134134 OnConflictDoRaise (Returning_ (#id :* param @2 `as` #email))

135− e = insertInto_ #emails

136− (Select (defaultAs #id :* #u ! #id `as` #user_id :* #u ! #email) (from (common #u)))

135+ e = insertInto_ #emails $ Select

136+ (Default `as` #id :* Set (#u ! #id) `as` #user_id :* Set (#u ! #email) `as` #email)

137+ (from (common #u))

137138:}

138139

139140>>> printSQL insertUser

squeal-postgresql/src/Squeal/PostgreSQL/Alias.hs−9

@@ -46,7 +46,6 @@ module Squeal.PostgreSQL.Alias

4646 , HasIn

4747 , QualifiedAlias (..)

4848 , IsQualified (..)

49− , DefaultAliasable (..)

5049 -- * Grouping

5150 , Grouping (..)

5251 , GroupedBy

@@ -189,14 +188,6 @@ choose which subfields to update.

189188class HasIn fields field where

190189instance (Has alias fields field) => HasIn fields (alias ::: field) where

191190

192−{- |

193−The `DefaultAliasable` class is intended to help with Scrap your Nils

194−for default inserts and updates.

195−-}

196−class KnownSymbol alias

197− => DefaultAliasable alias aliased | aliased -> alias where

198− defaultAs :: Alias alias -> aliased

199−

200191-- | `HasAll` extends `Has` to take lists of @aliases@ and @fields@ and infer

201192-- a list of @subfields@.

202193class

squeal-postgresql/src/Squeal/PostgreSQL/Manipulation.hs+40−110

@@ -18,6 +18,7 @@ Squeal data manipulation language.

1818 , MultiParamTypeClasses

1919 , OverloadedStrings

2020 , PatternSynonyms

21+ , QuantifiedConstraints

2122 , RankNTypes

2223 , ScopedTypeVariables

2324 , TypeApplications

@@ -34,8 +35,7 @@ module Squeal.PostgreSQL.Manipulation

3435 , queryStatement

3536 , QueryClause (..)

3637 , pattern Values_

37− , DefaultAliasable (..)

38− , ColumnExpression (..)

38+ , Optional (..)

3939 , ReturningClause (..)

4040 , pattern Returning_

4141 , ConflictClause (..)

@@ -56,7 +56,6 @@ module Squeal.PostgreSQL.Manipulation

5656import Control.DeepSeq

5757import Data.ByteString hiding (foldr)

5858import Data.Kind (Type)

59−import GHC.TypeLits (KnownSymbol)

6059

6160import qualified Generics.SOP as SOP

6261import qualified GHC.Generics as GHC

@@ -86,7 +85,7 @@ simple insert:

8685let

8786 manipulation :: Manipulation '[] (Public Schema) '[] '[]

8887 manipulation =

89− insertInto_ #tab (Values_ (2 `as` #col1 :* defaultAs #col2))

88+ insertInto_ #tab (Values_ (Set 2 `as` #col1 :* Default `as` #col2))

9089in printSQL manipulation

9190:}

9291INSERT INTO "tab" ("col1", "col2") VALUES (2, DEFAULT)

@@ -99,7 +98,7 @@ parameterized insert:

9998let

10099 manipulation :: Manipulation '[] (Public Schema) '[ 'NotNull 'PGint4, 'NotNull 'PGint4 ] '[]

101100 manipulation =

102− insertInto_ #tab (Values_ (param @1 `as` #col1 :* param @2 `as` #col2))

101+ insertInto_ #tab (Values_ (Set (param @1) `as` #col1 :* Set (param @2) `as` #col2))

103102in printSQL manipulation

104103:}

105104INSERT INTO "tab" ("col1", "col2") VALUES (($1 :: int4), ($2 :: int4))

@@ -110,7 +109,7 @@ returning insert:

110109let

111110 manipulation :: Manipulation '[] (Public Schema) '[] '["fromOnly" ::: 'NotNull 'PGint4]

112111 manipulation =

113− insertInto #tab (Values_ (2 `as` #col1 :* 3 `as` #col2))

112+ insertInto #tab (Values_ (Set 2 `as` #col1 :* Set 3 `as` #col2))

114113 OnConflictDoRaise (Returning (#col1 `as` #fromOnly))

115114in printSQL manipulation

116115:}

@@ -126,9 +125,9 @@ let

126125 manipulation :: Manipulation '[] (Public CustomersSchema) '[] '[]

127126 manipulation =

128127 insertInto #customers

129− (Values_ ("John Smith" `as` #name :* "john@smith.com" `as` #email))

128+ (Values_ (Set "John Smith" `as` #name :* Set "john@smith.com" `as` #email))

130129 (OnConflict (OnConstraint #uq)

131− (DoUpdate (((#excluded ! #email) <> "; " <> (#customers ! #email)) `as` #email) []))

130+ (DoUpdate (Set (#excluded ! #email <> "; " <> #customers ! #email) `as` #email) []))

132131 (Returning_ Nil)

133132in printSQL manipulation

134133:}

@@ -149,7 +148,7 @@ update:

149148>>> :{

150149let

151150 manipulation :: Manipulation '[] (Public Schema) '[] '[]

152− manipulation = update_ #tab (2 `as` #col1) (#col1 ./= #col2)

151+ manipulation = update_ #tab (Set 2 `as` #col1) (#col1 ./= #col2)

153152in printSQL manipulation

154153:}

155154UPDATE "tab" SET "col1" = 2 WHERE ("col1" <> "col2")

@@ -268,12 +267,12 @@ insertInto_ tab qry =

268267data QueryClause commons schemas params columns where

269268 Values

270269 :: SOP.SListI columns

271− => NP (ColumnExpression 'Ungrouped schemas params '[]) columns

272− -> [NP (ColumnExpression 'Ungrouped schemas params '[]) columns]

270+ => NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[]))) columns

271+ -> [NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[]))) columns]

273272 -> QueryClause commons schemas params columns

274273 Select

275274 :: SOP.SListI columns

276− => NP (ColumnExpression grp schemas params from) columns

275+ => NP (Aliased (Optional (Expression '[] '[] grp schemas params from))) columns

277276 -> TableExpression '[] commons grp schemas params from

278277 -> QueryClause commons schemas params columns

279278 Subquery

@@ -297,109 +296,34 @@ instance RenderSQL (QueryClause commons schemas params columns) where

297296 Subquery qry -> renderQuery qry

298297 where

299298 renderSQLPartMaybe, renderValuePartMaybe

300− :: ColumnExpression grp schemas params from column -> Maybe ByteString

299+ :: Aliased (Optional (Expression '[] '[] grp schemas params from)) column

300+ -> Maybe ByteString

301301 renderSQLPartMaybe = \case

302− DefaultAs _ -> Nothing

303− Specific (_ `As` name) -> Just $ renderSQL name

302+ Default `As` _ -> Nothing

303+ Set _ `As` name -> Just $ renderSQL name

304304 renderValuePartMaybe = \case

305− DefaultAs _ -> Nothing

306− Specific (value `As` _) -> Just $ renderExpression value

305+ Default `As` _ -> Nothing

306+ Set value `As` _ -> Just $ renderExpression value

307307 renderSQLPart, renderValuePart

308− :: ColumnExpression grp schemas params from column -> ByteString

309− renderSQLPart = \case

310− DefaultAs name -> renderSQL name

311− Specific (_ `As` name) -> renderSQL name

312− renderValuePart = \case

313− DefaultAs _ -> "DEFAULT"

314− Specific (value `As` _) -> renderExpression value

308+ :: Aliased (Optional (Expression '[] '[] grp schemas params from)) column

309+ -> ByteString

310+ renderSQLPart (_ `As` name) = renderSQL name

311+ renderValuePart (value `As` _) = renderSQL value

315312

316313pattern Values_

317314 :: SOP.SListI columns

318− => NP (ColumnExpression 'Ungrouped schemas params '[]) columns

315+ => NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[]))) columns

319316 -> QueryClause commons schemas params columns

320317pattern Values_ vals = Values vals []

321318

322−data ColumnExpression grp schemas params from column where

323− DefaultAs

324− :: KnownSymbol col

325− => Alias col

326− -> ColumnExpression grp schemas params from (col ::: 'Def :=> ty)

327− Specific

328− :: Aliased (Expression '[] '[] grp schemas params from) (col ::: ty)

329− -> ColumnExpression grp schemas params from (col ::: defness :=> ty)

330−

331−instance (KnownSymbol col, column ~ (col ::: defness :=> ty))

332− => Aliasable col

333− (Expression '[] '[] grp schemas params from ty)

334− (ColumnExpression grp schemas params from column) where

335− expression `as` col = Specific (expression `As` col)

336−instance (KnownSymbol col, columns ~ '[col ::: defness :=> ty])

337− => Aliasable col

338− (Expression '[] '[] grp schemas params from ty)

339− (NP (ColumnExpression grp schemas params from) columns) where

340− expression `as` col = expression `as` col :* Nil

341−instance (KnownSymbol col, column ~ (col ::: 'Def :=> ty))

342− => DefaultAliasable col (ColumnExpression grp schemas params from column) where

343− defaultAs = DefaultAs

344−instance (KnownSymbol col, columns ~ '[col ::: 'Def :=> ty])

345− => DefaultAliasable col (NP (ColumnExpression grp schemas params from) columns) where

346− defaultAs col = defaultAs col :* Nil

347−

348−instance (HasUnique tab from row, Has col row ty, column ~ (col ::: defness :=> ty))

349− => IsLabel col (ColumnExpression 'Ungrouped schemas params from column) where

350− fromLabel = fromLabel @col `as` Alias

351−instance (HasUnique tab from row, Has col row ty, columns ~ '[col ::: defness :=> ty])

352− => IsLabel col

353− (NP (ColumnExpression 'Ungrouped schemas params from) columns) where

354− fromLabel = fromLabel @col `as` Alias

355−

356−instance (Has tab from row, Has col row ty, column ~ (col ::: defness :=> ty))

357− => IsQualified tab col (ColumnExpression 'Ungrouped schemas params from column) where

358− tab ! col = tab ! col `as` col

359−instance (Has tab from row, Has col row ty, columns ~ '[col ::: defness :=> ty])

360− => IsQualified tab col (NP (ColumnExpression 'Ungrouped schemas params from) columns) where

361− tab ! col = tab ! col `as` col

362−

363−instance

364− ( HasUnique tab from row

365− , Has col row ty

366− , GroupedBy tab col bys

367− , column ~ (col ::: defness :=> ty)

368− ) => IsLabel col

369− (ColumnExpression ('Grouped bys) schemas params from column) where

370− fromLabel = fromLabel @col `as` Alias

371−instance

372− ( HasUnique tab from row

373− , Has col row ty

374− , GroupedBy tab col bys

375− , columns ~ '[col ::: defness :=> ty]

376− ) => IsLabel col

377− (NP (ColumnExpression ('Grouped bys) schemas params from) columns) where

378− fromLabel = fromLabel @col `as` Alias

379−

380−instance

381− ( Has tab from row

382− , Has col row ty

383− , GroupedBy tab col bys

384− , column ~ (col ::: defness :=> ty)

385− ) => IsQualified tab col

386− (ColumnExpression ('Grouped bys) schemas params from column) where

387− tab ! col = tab ! col `as` col

388−instance

389− ( Has tab from row

390− , Has col row ty

391− , GroupedBy tab col bys

392− , columns ~ '[col ::: defness :=> ty]

393− ) => IsQualified tab col

394− (NP (ColumnExpression ('Grouped bys) schemas params from) columns) where

395− tab ! col = tab ! col :* Nil

396−

397−instance RenderSQL (ColumnExpression grp schemas params from column) where

319+data Optional expr ty where

320+ Default :: Optional expr ('Def :=> ty)

321+ Set :: expr ty -> Optional expr (def :=> ty)

322+

323+instance (forall x. RenderSQL (expr x)) => RenderSQL (Optional expr ty) where

398324 renderSQL = \case

399− DefaultAs col ->

400− renderSQL col <+> "=" <+> "DEFAULT"

401− Specific (expression `As` col) ->

402− renderSQL col <+> "=" <+> renderSQL expression

325+ Default -> "DEFAULT"

326+ Set expr -> renderSQL expr

403327

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

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

@@ -453,7 +377,7 @@ data ConflictAction tab commons schemas params columns where

453377 , columns ~ (col0 ': cols)

454378 , SOP.All (HasIn columns) subcolumns

455379 , AllUnique subcolumns )

456− => NP (ColumnExpression 'Ungrouped schemas params '[tab ::: row, "excluded" ::: row]) subcolumns

380+ => NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[tab ::: row, "excluded" ::: row]))) subcolumns

457381 -> [Condition '[] commons 'Ungrouped schemas params '[tab ::: row, "excluded" ::: row]]

458382 -> ConflictAction tab commons schemas params columns

459383

@@ -462,11 +386,17 @@ instance RenderSQL (ConflictAction tab commons schemas params columns) where

462386 DoNothing -> "DO NOTHING"

463387 DoUpdate updates whs'

464388 -> "DO UPDATE SET"

465− <+> renderCommaSeparated renderSQL updates

389+ <+> renderCommaSeparated renderUpdate updates

466390 <> case whs' of

467391 [] -> ""

468392 wh:whs -> " WHERE" <+> renderSQL (foldr (.&&) wh whs)

469393

394+renderUpdate

395+ :: (forall x. RenderSQL (expr x))

396+ => Aliased (Optional expr) ty

397+ -> ByteString

398+renderUpdate (expr `As` col) = renderSQL col <+> "=" <+> renderSQL expr

399+

470400-- | A `ConflictTarget` specifies the constraint violation that triggers a

471401-- `ConflictAction`.

472402data ConflictTarget constraints where

@@ -497,7 +427,7 @@ update

497427 , SOP.All (HasIn columns) subcolumns

498428 , AllUnique subcolumns )

499429 => QualifiedAlias sch tab -- ^ table to update

500− -> NP (ColumnExpression 'Ungrouped schemas params '[tab ::: row0]) subcolumns

430+ -> NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[tab ::: row0]))) subcolumns

501431 -- ^ modified values to replace old values

502432 -> Condition '[] commons 'Ungrouped schemas params '[tab ::: row0]

503433 -- ^ condition under which to perform update on a row

@@ -507,7 +437,7 @@ update tab columns wh returning = UnsafeManipulation $

507437 "UPDATE"

508438 <+> renderSQL tab

509439 <+> "SET"

510− <+> renderCommaSeparated renderSQL columns

440+ <+> renderCommaSeparated renderUpdate columns

511441 <+> "WHERE" <+> renderSQL wh

512442 <> renderSQL returning

513443

@@ -522,7 +452,7 @@ update_

522452 , SOP.All (HasIn columns) subcolumns

523453 , AllUnique subcolumns )

524454 => QualifiedAlias sch tab -- ^ table to update

525− -> NP (ColumnExpression 'Ungrouped schemas params '[tab ::: row]) subcolumns

455+ -> NP (Aliased (Optional (Expression '[] '[] 'Ungrouped schemas params '[tab ::: row]))) subcolumns

526456 -- ^ modified values to replace old values

527457 -> Condition '[] commons 'Ungrouped schemas params '[tab ::: row]

528458 -- ^ condition under which to perform update on a row

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

@@ -339,7 +339,7 @@ createMigrations =

339339-- the time at which it was inserted.

340340insertMigration :: Manipulation_ MigrationsSchemas (Only Text) ()

341341insertMigration = insertInto_ #schema_migrations

342− (Values_ ((param @1) `as` #name :* defaultAs #executed_at))

342+ (Values_ (Set (param @1) `as` #name :* Default `as` #executed_at))

343343

344344-- | Deletes a `Migration` from the `MigrationsTable`, returning

345345-- the time at which it was inserted.

squeal-postgresql/test/Specs/ExceptionHandling.hs+1−1

@@ -59,7 +59,7 @@ instance SOP.HasDatatypeInfo User

5959insertUser :: Manipulation '[] Schemas '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))]

6060 '[ "fromOnly" ::: 'NotNull 'PGint4 ]

6161insertUser = insertInto #users

62− (Values_ (defaultAs #id :* param @1 `as` #name :* param @2 `as` #vec))

62+ (Values_ (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec))

6363 OnConflictDoRaise (Returning (#id `as` #fromOnly))

6464

6565setup :: Definition (Public '[]) Schemas