squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs · squeal

git.iko.soy/squeal

on dfd6885 help sign in

squeal/squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs

903 lines 30 kB history raw

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

2{-# LANGUAGE

3 AllowAmbiguousTypes

4 , DataKinds

5 , DeriveGeneric

6 , DeriveDataTypeable

7 , FlexibleContexts

8 , FlexibleInstances

9 , FunctionalDependencies

10 , GADTs

11 , GeneralizedNewtypeDeriving

12 , LambdaCase

13 , MagicHash

14 , OverloadedStrings

15 , PolyKinds

16 , RankNTypes

17 , ScopedTypeVariables

18 , StandaloneDeriving

19 , TypeApplications

20 , TypeFamilies

21 , TypeInType

22 , TypeOperators

23 , UndecidableInstances

24#-}

26module Squeal.PostgreSQL.Expression

27 ( -- * Column Expressions

28 Expression (UnsafeExpression, renderExpression)

29 , HasParameter (param)

30 , HasColumn (getColumn)

31 , Column (Column)

32 , renderColumn

33 , GroupedBy (getGroup1, getGroup2)

34 -- ** Default

35 , def

36 , unDef

37 -- ** Null

38 , null_

39 , unNull

40 , coalesce

41 , fromNull

42 , isNull

43 , isn'tNull

44 , matchNull

45 , nullIf

46 -- ** Functions

47 , unsafeBinaryOp

48 , unsafeUnaryOp

49 , unsafeFunction

50 , atan2_

51 , cast

52 , div_

53 , mod_

54 , trunc

55 , round_

56 , ceiling_

57 , greatest

58 , least

59 -- ** Conditions

60 , Condition

61 , true

62 , false

63 , not_

64 , (.&&)

65 , (.||)

66 , caseWhenThenElse

67 , ifThenElse

68 , (.==)

69 , (./=)

70 , (.>=)

71 , (.<)

72 , (.<=)

73 , (.>)

74 -- ** Time

75 , currentDate

76 , currentTime

77 , currentTimestamp

78 , localTime

79 , localTimestamp

80 -- ** Text

81 , lower

82 , upper

83 , charLength

84 , like

85 -- ** Aggregation

86 , unsafeAggregate, unsafeAggregateDistinct

87 , sum_, sumDistinct

88 , PGAvg (avg, avgDistinct)

89 , bitAnd, bitOr, boolAnd, boolOr

90 , countStar

91 , count, countDistinct

92 , every, everyDistinct

93 , jsonAgg, jsonAggDistinct

94 , jsonbAgg, jsonbAggDistinct

95 , jsonObjectAgg

96 , jsonbObjectAgg

97 , max_, maxDistinct, min_, minDistinct

98 -- * Tables

99 , Table (UnsafeTable, renderTable)

100 , HasTable (getTable)

101 -- * TypeExpression

102 , TypeExpression (UnsafeTypeExpression, renderTypeExpression)

103 , PGTyped (pgtype)

104 , bool

105 , int2

106 , smallint

107 , int4

108 , int

109 , integer

110 , int8

111 , bigint

112 , numeric

113 , float4

114 , real

115 , float8

116 , doublePrecision

117 , serial2

118 , smallserial

119 , serial4

120 , serial

121 , serial8

122 , bigserial

123 , text

124 , char

125 , character

126 , varchar

127 , characterVarying

128 , bytea

129 , timestamp

130 , timestampWithTimeZone

131 , date

132 , time

133 , timeWithTimeZone

134 , interval

135 , uuid

136 , json

137 , jsonb

138 , notNull

139 , default_

140 -- * Re-export

141 , (&)

142 , NP ((:*), Nil)

143 ) where

144

145import Control.Category

146import Control.DeepSeq

147import Data.ByteString (ByteString)

148import Data.Function ((&))

149import Data.Monoid hiding (All)

150import Data.Ratio

151import Data.String

152import Generics.SOP hiding (from)

153import GHC.OverloadedLabels

154import GHC.TypeLits

155import Prelude hiding (id, (.))

156

157import qualified GHC.Generics as GHC

158

159import Squeal.PostgreSQL.Prettyprint

160import Squeal.PostgreSQL.Schema

161

162{-----------------------------------------

163column expressions

164-----------------------------------------}

165

166{- | `Expression`s are used in a variety of contexts,

167such as in the target list of the `select` command,

168as new column values in `insertInto` or `update`,

169or in search `Condition`s in a number of commands.

170

171The expression syntax allows the calculation of

172values from primitive expression using arithmetic, logical,

173and other operations.

174-}

175newtype Expression

176 (tables :: TablesType)

177 (grouping :: Grouping)

178 (params :: [ColumnType])

179 (ty :: ColumnType)

180 = UnsafeExpression { renderExpression :: ByteString }

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

182

183{- | A `HasParameter` constraint is used to indicate a value that is

184supplied externally to a SQL statement.

185`Squeal.PostgreSQL.PQ.manipulateParams`,

186`Squeal.PostgreSQL.PQ.queryParams` and

187`Squeal.PostgreSQL.PQ.traversePrepared` support specifying data values

188separately from the SQL command string, in which case `param`s are used to

189refer to the out-of-line data values.

190-}

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

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

193 param :: Expression tables grouping params ty

194 param = UnsafeExpression $ parenthesized $

195 "$" <> renderNat (Proxy @n) <+> "::"

196 <+> renderTypeExpression (pgtype @(BaseType ty))

197instance {-# OVERLAPPING #-} PGTyped (BaseType ty1)

198 => HasParameter 1 (ty1:tys) ty1

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

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

201

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

203`getColumn` can only be unambiguous when the `TableExpression` the column

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

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

206qualified column reference operator `!` may be used.

207-}

208class KnownSymbol column => HasColumn column columns ty

209 | column columns -> ty where

210 getColumn

211 :: HasUnique table tables columns

212 => Alias column

213 -> Expression tables 'Ungrouped params ty

214 getColumn column = UnsafeExpression $ renderAlias column

215instance {-# OVERLAPPING #-} KnownSymbol column

216 => HasColumn column ((column ::: optionality ty) ': tys) ('Required ty)

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

218 => HasColumn column (ty' ': table) ty

219

220instance (HasColumn column columns ty, HasUnique table tables columns)

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

222 fromLabel = getColumn (Alias @column)

223

224instance (HasTable table tables columns, HasColumn column columns ty)

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

226 table ! column = UnsafeExpression $

227 renderAlias table <> "." <> renderAlias column

228

229data Column

230 (columns :: ColumnsType)

231 (columnty :: (Symbol,ColumnType))

232 where

233 Column

234 :: HasColumn column columns ty

235 => Alias column

236 -> Column columns (column ::: ty)

237deriving instance Show (Column columns columnty)

238deriving instance Eq (Column columns columnty)

239deriving instance Ord (Column columns columnty)

240

241renderColumn :: Column columns columnty -> ByteString

242renderColumn (Column column) = renderAlias column

243

244class (KnownSymbol table, KnownSymbol column)

245 => GroupedBy table column bys where

246 getGroup1

247 :: (HasUnique table tables columns, HasColumn column columns ty)

248 => Alias column

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

250 getGroup1 column = UnsafeExpression $ renderAlias column

251 getGroup2

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

253 => Alias table

254 -> Alias column

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

256 getGroup2 table column = UnsafeExpression $

257 renderAlias table <> "." <> renderAlias column

258instance {-# OVERLAPPING #-} (KnownSymbol table, KnownSymbol column)

259 => GroupedBy table column ('(table,column) ': bys)

260instance {-# OVERLAPPABLE #-}

261 ( KnownSymbol table

262 , KnownSymbol column

263 , GroupedBy table column bys

264 ) => GroupedBy table column (tabcol ': bys)

265

266instance

267 ( HasUnique table tables columns

268 , HasColumn column columns ty

269 , GroupedBy table column bys

270 ) => IsLabel column

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

272 fromLabel = getGroup1 (Alias @column)

273

274instance

275 ( HasTable table tables columns

276 , HasColumn column columns ty

277 , GroupedBy table column bys

278 ) => IsTableColumn table column

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

280

281-- | >>> renderExpression def

282-- "DEFAULT"

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

284def = UnsafeExpression "DEFAULT"

285

286-- | >>> renderExpression $ unDef false

287-- "FALSE"

288unDef

289 :: Expression '[] 'Ungrouped params ('Required (nullity ty))

290 -> Expression '[] 'Ungrouped params ('Optional (nullity ty))

291unDef = UnsafeExpression . renderExpression

292

293-- | analagous to `Nothing`

294--

295-- >>> renderExpression $ null_

296-- "NULL"

297null_ :: Expression tables grouping params (optionality ('Null ty))

298null_ = UnsafeExpression "NULL"

299

300-- | analagous to `Just`

301--

302-- >>> renderExpression $ unNull true

303-- "TRUE"

304unNull

305 :: Expression tables grouping params (optionality ('NotNull ty))

306 -> Expression tables grouping params (optionality ('Null ty))

307unNull = UnsafeExpression . renderExpression

308

309-- | return the leftmost value which is not NULL

310--

311-- >>> renderExpression $ coalesce [null_, unNull true] false

312-- "COALESCE(NULL, TRUE, FALSE)"

313coalesce

314 :: [Expression tables grouping params ('Required ('Null ty))]

315 -> Expression tables grouping params ('Required ('NotNull ty))

316 -> Expression tables grouping params ('Required ('NotNull ty))

317coalesce nullxs notNullx = UnsafeExpression $

318 "COALESCE" <> parenthesized (commaSeparated

319 ((renderExpression <$> nullxs) <> [renderExpression notNullx]))

320

321-- | analagous to `fromMaybe` using @COALESCE@

322--

323-- >>> renderExpression $ fromNull true null_

324-- "COALESCE(NULL, TRUE)"

325fromNull

326 :: Expression tables grouping params ('Required ('NotNull ty))

327 -> Expression tables grouping params ('Required ('Null ty))

328 -> Expression tables grouping params ('Required ('NotNull ty))

329fromNull notNullx nullx = coalesce [nullx] notNullx

330

331-- | >>> renderExpression $ null_ & isNull

332-- "NULL IS NULL"

333isNull

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

335 -> Condition tables grouping params

336isNull x = UnsafeExpression $ renderExpression x <+> "IS NULL"

337

338-- | >>> renderExpression $ null_ & isn'tNull

339-- "NULL IS NOT NULL"

340isn'tNull

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

342 -> Condition tables grouping params

343isn'tNull x = UnsafeExpression $ renderExpression x <+> "IS NOT NULL"

344

345-- | analagous to `maybe` using @IS NULL@

346--

347-- >>> renderExpression $ matchNull true not_ null_

348-- "CASE WHEN NULL IS NULL THEN TRUE ELSE (NOT NULL) END"

349matchNull

350 :: Expression tables grouping params ('Required nullty)

351 -> ( Expression tables grouping params ('Required ('NotNull ty))

352 -> Expression tables grouping params ('Required nullty) )

353 -> Expression tables grouping params ('Required ('Null ty))

354 -> Expression tables grouping params ('Required nullty)

355matchNull y f x = ifThenElse (isNull x) y

356 (f (UnsafeExpression (renderExpression x)))

357

358-- | right inverse to `fromNull`

359--

360-- >>> :set -XTypeApplications -XDataKinds

361-- >>> renderExpression @_ @_ @'[_] $ fromNull false (nullIf false (param @1))

362-- "COALESCE(NULL IF (FALSE, ($1 :: bool)), FALSE)"

363nullIf

364 :: Expression tables grouping params ('Required ('NotNull ty))

365 -> Expression tables grouping params ('Required ('NotNull ty))

366 -> Expression tables grouping params ('Required ('Null ty))

367nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized

368 (renderExpression x <> ", " <> renderExpression y)

369

370-- | >>> renderExpression @_ @_ @'[_] $ greatest currentTimestamp [param @1]

371-- "GREATEST(CURRENT_TIMESTAMP, ($1 :: timestamp with time zone))"

372greatest

373 :: Expression tables grouping params ('Required nullty)

374 -> [Expression tables grouping params ('Required nullty)]

375 -> Expression tables grouping params ('Required nullty)

376greatest x xs = UnsafeExpression $ "GREATEST("

377 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

378

379-- | >>> renderExpression $ least currentTimestamp [null_]

380-- "LEAST(CURRENT_TIMESTAMP, NULL)"

381least

382 :: Expression tables grouping params ('Required nullty)

383 -> [Expression tables grouping params ('Required nullty)]

384 -> Expression tables grouping params ('Required nullty)

385least x xs = UnsafeExpression $ "LEAST("

386 <> commaSeparated (renderExpression <$> (x:xs)) <> ")"

387

388unsafeBinaryOp

389 :: ByteString

390 -> Expression tables grouping params ('Required ty0)

391 -> Expression tables grouping params ('Required ty1)

392 -> Expression tables grouping params ('Required ty2)

393unsafeBinaryOp op x y = UnsafeExpression $ parenthesized $

394 renderExpression x <+> op <+> renderExpression y

395

396unsafeUnaryOp

397 :: ByteString

398 -> Expression tables grouping params ('Required ty0)

399 -> Expression tables grouping params ('Required ty1)

400unsafeUnaryOp op x = UnsafeExpression $ parenthesized $

401 op <+> renderExpression x

402

403unsafeFunction

404 :: ByteString

405 -> Expression tables grouping params ('Required xty)

406 -> Expression tables grouping params ('Required yty)

407unsafeFunction fun x = UnsafeExpression $

408 fun <> parenthesized (renderExpression x)

409

410instance PGNum ty

411 => Num (Expression tables grouping params ('Required (nullity ty))) where

412 (+) = unsafeBinaryOp "+"

413 (-) = unsafeBinaryOp "-"

414 (*) = unsafeBinaryOp "*"

415 abs = unsafeFunction "abs"

416 signum = unsafeFunction "sign"

417 fromInteger

418 = UnsafeExpression

419 . fromString

420 . show

421

422instance (PGNum ty, PGFloating ty) => Fractional

423 (Expression tables grouping params ('Required (nullity ty))) where

424 (/) = unsafeBinaryOp "/"

425 fromRational x = fromInteger (numerator x) / fromInteger (denominator x)

426

427instance (PGNum ty, PGFloating ty) => Floating

428 (Expression tables grouping params ('Required (nullity ty))) where

429 pi = UnsafeExpression "pi()"

430 exp = unsafeFunction "exp"

431 log = unsafeFunction "ln"

432 sqrt = unsafeFunction "sqrt"

433 b ** x = UnsafeExpression $

434 "power(" <> renderExpression b <> ", " <> renderExpression x <> ")"

435 logBase b y = log y / log b

436 sin = unsafeFunction "sin"

437 cos = unsafeFunction "cos"

438 tan = unsafeFunction "tan"

439 asin = unsafeFunction "asin"

440 acos = unsafeFunction "acos"

441 atan = unsafeFunction "atan"

442 sinh x = (exp x - exp (-x)) / 2

443 cosh x = (exp x + exp (-x)) / 2

444 tanh x = sinh x / cosh x

445 asinh x = log (x + sqrt (x*x + 1))

446 acosh x = log (x + sqrt (x*x - 1))

447 atanh x = log ((1 + x) / (1 - x)) / 2

448

449atan2_

450 :: PGFloating float

451 => Expression tables grouping params ('Required (nullity float))

452 -> Expression tables grouping params ('Required (nullity float))

453 -> Expression tables grouping params ('Required (nullity float))

454atan2_ y x = UnsafeExpression $

455 "atan2(" <> renderExpression y <> ", " <> renderExpression x <> ")"

456

457cast

458 :: TypeExpression ('Required ('Null ty1))

459 -> Expression tables grouping params ('Required (nullity ty0))

460 -> Expression tables grouping params ('Required (nullity ty1))

461cast ty x = UnsafeExpression $ parenthesized $

462 renderExpression x <+> "::" <+> renderTypeExpression ty

463

464div_

465 :: PGIntegral int

466 => Expression tables grouping params ('Required (nullity int))

467 -> Expression tables grouping params ('Required (nullity int))

468 -> Expression tables grouping params ('Required (nullity int))

469div_ = unsafeBinaryOp "/"

470

471mod_

472 :: PGIntegral int

473 => Expression tables grouping params ('Required (nullity int))

474 -> Expression tables grouping params ('Required (nullity int))

475 -> Expression tables grouping params ('Required (nullity int))

476mod_ = unsafeBinaryOp "%"

477

478trunc

479 :: PGFloating frac

480 => Expression tables grouping params ('Required (nullity frac))

481 -> Expression tables grouping params ('Required (nullity frac))

482trunc = unsafeFunction "trunc"

483

484round_

485 :: PGFloating frac

486 => Expression tables grouping params ('Required (nullity frac))

487 -> Expression tables grouping params ('Required (nullity frac))

488round_ = unsafeFunction "round"

489

490ceiling_

491 :: PGFloating frac

492 => Expression tables grouping params ('Required (nullity frac))

493 -> Expression tables grouping params ('Required (nullity frac))

494ceiling_ = unsafeFunction "ceiling"

495

496type Condition tables grouping params =

497 Expression tables grouping params ('Required ('NotNull 'PGbool))

498

499true :: Condition tables grouping params

500true = UnsafeExpression "TRUE"

501

502false :: Condition tables grouping params

503false = UnsafeExpression "FALSE"

504

505not_

506 :: Condition tables grouping params

507 -> Condition tables grouping params

508not_ = unsafeUnaryOp "NOT"

509

510(.&&)

511 :: Condition tables grouping params

512 -> Condition tables grouping params

513 -> Condition tables grouping params

514(.&&) = unsafeBinaryOp "AND"

515

516(.||)

517 :: Condition tables grouping params

518 -> Condition tables grouping params

519 -> Condition tables grouping params

520(.||) = unsafeBinaryOp "OR"

521

522caseWhenThenElse

523 :: [ ( Condition tables grouping params

524 , Expression tables grouping params ('Required ty)

525 ) ]

526 -> Expression tables grouping params ('Required ty)

527 -> Expression tables grouping params ('Required ty)

528caseWhenThenElse whenThens else_ = UnsafeExpression $ mconcat

529 [ "CASE"

530 , mconcat

531 [ mconcat

532 [ " WHEN ", renderExpression when_

533 , " THEN ", renderExpression then_

534 ]

535 | (when_,then_) <- whenThens

536 ]

537 , " ELSE ", renderExpression else_

538 , " END"

539 ]

540

541ifThenElse

542 :: Condition tables grouping params

543 -> Expression tables grouping params ('Required ty)

544 -> Expression tables grouping params ('Required ty)

545 -> Expression tables grouping params ('Required ty)

546ifThenElse if_ then_ else_ = caseWhenThenElse [(if_,then_)] else_

547

548(.==)

549 :: Expression tables grouping params ('Required (nullity ty))

550 -> Expression tables grouping params ('Required (nullity ty))

551 -> Expression tables grouping params ('Required (nullity 'PGbool))

552(.==) = unsafeBinaryOp "="

553infix 4 .==

554

555(./=)

556 :: Expression tables grouping params ('Required (nullity ty))

557 -> Expression tables grouping params ('Required (nullity ty))

558 -> Expression tables grouping params ('Required (nullity 'PGbool))

559(./=) = unsafeBinaryOp "<>"

560infix 4 ./=

561

562(.>=)

563 :: Expression tables grouping params ('Required (nullity ty))

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

565 -> Expression tables grouping params ('Required (nullity 'PGbool))

566(.>=) = unsafeBinaryOp ">="

567infix 4 .>=

568

569(.<)

570 :: Expression tables grouping params ('Required (nullity ty))

571 -> Expression tables grouping params ('Required (nullity ty))

572 -> Expression tables grouping params ('Required (nullity 'PGbool))

573(.<) = unsafeBinaryOp "<"

574infix 4 .<

575

576(.<=)

577 :: Expression tables grouping params ('Required (nullity ty))

578 -> Expression tables grouping params ('Required (nullity ty))

579 -> Expression tables grouping params ('Required (nullity 'PGbool))

580(.<=) = unsafeBinaryOp "<="

581infix 4 .<=

582

583(.>)

584 :: Expression tables grouping params ('Required (nullity ty))

585 -> Expression tables grouping params ('Required (nullity ty))

586 -> Expression tables grouping params ('Required (nullity 'PGbool))

587(.>) = unsafeBinaryOp ">"

588infix 4 .>

589

590currentDate

591 :: Expression tables grouping params ('Required (nullity 'PGdate))

592currentDate = UnsafeExpression "CURRENT_DATE"

593

594currentTime

595 :: Expression tables grouping params ('Required (nullity 'PGtimetz))

596currentTime = UnsafeExpression "CURRENT_TIME"

597

598currentTimestamp

599 :: Expression tables grouping params ('Required (nullity 'PGtimestamptz))

600currentTimestamp = UnsafeExpression "CURRENT_TIMESTAMP"

601

602localTime

603 :: Expression tables grouping params ('Required (nullity 'PGtime))

604localTime = UnsafeExpression "LOCALTIME"

605

606localTimestamp

607 :: Expression tables grouping params ('Required (nullity 'PGtimestamp))

608localTimestamp = UnsafeExpression "LOCALTIMESTAMP"

609

610{-----------------------------------------

611text

612-----------------------------------------}

613

614instance IsString

615 (Expression tables grouping params ('Required (nullity 'PGtext))) where

616 fromString str = UnsafeExpression $

617 "E\'" <> fromString (escape =<< str) <> "\'"

618 where

619 escape = \case

620 '\NUL' -> "\\0"

621 '\'' -> "''"

622 '"' -> "\\\""

623 '\b' -> "\\b"

624 '\n' -> "\\n"

625 '\r' -> "\\r"

626 '\t' -> "\\t"

627 '\\' -> "\\\\"

628 c -> [c]

629

630instance Monoid

631 (Expression tables grouping params ('Required (nullity 'PGtext))) where

632 mempty = fromString ""

633 mappend = unsafeBinaryOp "||"

634

635lower

636 :: Expression tables grouping params ('Required (nullity 'PGtext))

637 -> Expression tables grouping params ('Required (nullity 'PGtext))

638lower = unsafeFunction "lower"

639

640upper

641 :: Expression tables grouping params ('Required (nullity 'PGtext))

642 -> Expression tables grouping params ('Required (nullity 'PGtext))

643upper = unsafeFunction "upper"

644

645charLength

646 :: Expression tables grouping params ('Required (nullity 'PGtext))

647 -> Expression tables grouping params ('Required (nullity 'PGint4))

648charLength = unsafeFunction "char_length"

649

650like

651 :: Expression tables grouping params ('Required (nullity 'PGtext))

652 -> Expression tables grouping params ('Required (nullity 'PGtext))

653 -> Expression tables grouping params ('Required (nullity 'PGbool))

654like = unsafeBinaryOp "LIKE"

655

656{-----------------------------------------

657aggregation

658-----------------------------------------}

659

660unsafeAggregate, unsafeAggregateDistinct

661 :: ByteString

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

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

664unsafeAggregate fun x = UnsafeExpression $ mconcat

665 [fun, "(", renderExpression x, ")"]

666unsafeAggregateDistinct fun x = UnsafeExpression $ mconcat

667 [fun, "(DISTINCT ", renderExpression x, ")"]

668

669sum_, sumDistinct

670 :: PGNum ty

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

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

673sum_ = unsafeAggregate "sum"

674sumDistinct = unsafeAggregateDistinct "sum"

675

676class PGAvg ty avg | ty -> avg where

677 avg, avgDistinct

678 :: Expression tables 'Ungrouped params ('Required (nullity ty))

679 -> Expression tables ('Grouped bys) params ('Required (nullity avg))

680 avg = unsafeAggregate "avg"

681 avgDistinct = unsafeAggregateDistinct "avg"

682instance PGAvg 'PGint2 'PGnumeric

683instance PGAvg 'PGint4 'PGnumeric

684instance PGAvg 'PGint8 'PGnumeric

685instance PGAvg 'PGnumeric 'PGnumeric

686instance PGAvg 'PGfloat4 'PGfloat8

687instance PGAvg 'PGfloat8 'PGfloat8

688instance PGAvg 'PGinterval 'PGinterval

689

690bitAnd, bitOr

691 :: PGIntegral int

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

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

694bitAnd = unsafeAggregate "bit_and"

695bitOr = unsafeAggregate "bit_or"

696

697boolAnd, boolOr

698 :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))

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

700boolAnd = unsafeAggregate "bool_and"

701boolOr = unsafeAggregate "bool_or"

702

703countStar

704 :: Expression tables ('Grouped bys) params ('Required ('NotNull 'PGint8))

705countStar = UnsafeExpression $ "count(*)"

706

707count, countDistinct

708 :: Expression tables 'Ungrouped params ('Required ty)

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

710count = unsafeAggregate "count"

711countDistinct = unsafeAggregateDistinct "count"

712

713every, everyDistinct

714 :: Expression tables 'Ungrouped params ('Required (nullity 'PGbool))

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

716every = unsafeAggregate "every"

717everyDistinct = unsafeAggregateDistinct "every"

718

719jsonAgg, jsonAggDistinct

720 :: Expression tables 'Ungrouped params ('Required ty)

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

722jsonAgg = unsafeAggregate "json_agg"

723jsonAggDistinct = unsafeAggregateDistinct "json_agg"

724

725jsonbAgg, jsonbAggDistinct

726 :: Expression tables 'Ungrouped params ('Required ty)

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

728jsonbAgg = unsafeAggregate "jsonb_agg"

729jsonbAggDistinct = unsafeAggregateDistinct "jsonb_agg"

730

731jsonObjectAgg

732 :: Expression tables 'Ungrouped params ('Required ('NotNull keyty))

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

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

735jsonObjectAgg k v = UnsafeExpression $

736 "json_object_agg(" <> renderExpression k

737 <> ", " <> renderExpression v <> ")"

738

739jsonbObjectAgg

740 :: Expression tables 'Ungrouped params ('Required ('NotNull keyty))

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

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

743jsonbObjectAgg k v = UnsafeExpression $

744 "jsonb_object_agg("

745 <> renderExpression k <> ", " <> renderExpression v <> ")"

746

747max_, min_, maxDistinct, minDistinct

748 :: Expression tables 'Ungrouped params ('Required (nullity ty))

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

750max_ = unsafeAggregate "max"

751min_ = unsafeAggregate "min"

752maxDistinct = unsafeAggregateDistinct "max"

753minDistinct = unsafeAggregateDistinct "min"

754

755{-----------------------------------------

756tables

757-----------------------------------------}

758

759newtype Table

760 (schema :: TablesType)

761 (columns :: ColumnsType)

762 = UnsafeTable { renderTable :: ByteString }

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

764

765class KnownSymbol table => HasTable table tables columns

766 | table tables -> columns where

767 getTable :: Alias table -> Table tables columns

768 getTable table = UnsafeTable $ renderAlias table

769instance {-# OVERLAPPING #-} KnownSymbol table

770 => HasTable table ((table ::: columns) ': tables) columns

771instance {-# OVERLAPPABLE #-}

772 (KnownSymbol table, HasTable table schema columns)

773 => HasTable table (table' ': schema) columns

774

775instance HasTable table schema columns

776 => IsLabel table (Table schema columns) where

777 fromLabel = getTable (Alias @table)

778

779{-----------------------------------------

780type expressions

781-----------------------------------------}

782

783newtype TypeExpression (ty :: ColumnType)

784 = UnsafeTypeExpression { renderTypeExpression :: ByteString }

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

786

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

788bool = UnsafeTypeExpression "bool"

789int2 :: TypeExpression ('Required ('Null 'PGint2))

790int2 = UnsafeTypeExpression "int2"

791smallint :: TypeExpression ('Required ('Null 'PGint2))

792smallint = UnsafeTypeExpression "smallint"

793int4 :: TypeExpression ('Required ('Null 'PGint4))

794int4 = UnsafeTypeExpression "int4"

795int :: TypeExpression ('Required ('Null 'PGint4))

796int = UnsafeTypeExpression "int"

797integer :: TypeExpression ('Required ('Null 'PGint4))

798integer = UnsafeTypeExpression "integer"

799int8 :: TypeExpression ('Required ('Null 'PGint8))

800int8 = UnsafeTypeExpression "int8"

801bigint :: TypeExpression ('Required ('Null 'PGint8))

802bigint = UnsafeTypeExpression "bigint"

803numeric :: TypeExpression ('Required ('Null 'PGnumeric))

804numeric = UnsafeTypeExpression "numeric"

805float4 :: TypeExpression ('Required ('Null 'PGfloat4))

806float4 = UnsafeTypeExpression "float4"

807real :: TypeExpression ('Required ('Null 'PGfloat4))

808real = UnsafeTypeExpression "real"

809float8 :: TypeExpression ('Required ('Null 'PGfloat8))

810float8 = UnsafeTypeExpression "float8"

811doublePrecision :: TypeExpression ('Required ('Null 'PGfloat8))

812doublePrecision = UnsafeTypeExpression "double precision"

813serial2 :: TypeExpression ('Optional ('NotNull 'PGint2))

814serial2 = UnsafeTypeExpression "serial2"

815smallserial :: TypeExpression ('Optional ('NotNull 'PGint2))

816smallserial = UnsafeTypeExpression "smallserial"

817serial4 :: TypeExpression ('Optional ('NotNull 'PGint4))

818serial4 = UnsafeTypeExpression "serial4"

819serial :: TypeExpression ('Optional ('NotNull 'PGint4))

820serial = UnsafeTypeExpression "serial"

821serial8 :: TypeExpression ('Optional ('NotNull 'PGint8))

822serial8 = UnsafeTypeExpression "serial8"

823bigserial :: TypeExpression ('Optional ('NotNull 'PGint8))

824bigserial = UnsafeTypeExpression "bigserial"

825text :: TypeExpression ('Required ('Null 'PGtext))

826text = UnsafeTypeExpression "text"

827char

828 :: (KnownNat n, 1 <= n)

829 => proxy n

830 -> TypeExpression ('Required ('Null ('PGchar n)))

831char p = UnsafeTypeExpression $ "char(" <> renderNat p <> ")"

832character

833 :: (KnownNat n, 1 <= n)

834 => proxy n

835 -> TypeExpression ('Required ('Null ('PGchar n)))

836character p = UnsafeTypeExpression $ "character(" <> renderNat p <> ")"

837varchar

838 :: (KnownNat n, 1 <= n)

839 => proxy n

840 -> TypeExpression ('Required ('Null ('PGvarchar n)))

841varchar p = UnsafeTypeExpression $ "varchar(" <> renderNat p <> ")"

842characterVarying

843 :: (KnownNat n, 1 <= n)

844 => proxy n

845 -> TypeExpression ('Required ('Null ('PGvarchar n)))

846characterVarying p = UnsafeTypeExpression $

847 "character varying(" <> renderNat p <> ")"

848bytea :: TypeExpression ('Required ('Null ('PGbytea)))

849bytea = UnsafeTypeExpression "bytea"

850timestamp :: TypeExpression ('Required ('Null ('PGtimestamp)))

851timestamp = UnsafeTypeExpression "timestamp"

852timestampWithTimeZone :: TypeExpression ('Required ('Null ('PGtimestamptz)))

853timestampWithTimeZone = UnsafeTypeExpression "timestamp with time zone"

854date :: TypeExpression ('Required ('Null ('PGdate)))

855date = UnsafeTypeExpression "date"

856time :: TypeExpression ('Required ('Null ('PGtime)))

857time = UnsafeTypeExpression "time"

858timeWithTimeZone :: TypeExpression ('Required ('Null ('PGtimetz)))

859timeWithTimeZone = UnsafeTypeExpression "time with time zone"

860interval :: TypeExpression ('Required ('Null ('PGinterval)))

861interval = UnsafeTypeExpression "interval"

862uuid :: TypeExpression ('Required ('Null ('PGuuid)))

863uuid = UnsafeTypeExpression "uuid"

864json :: TypeExpression ('Required ('Null ('PGjson)))

865json = UnsafeTypeExpression "json"

866jsonb :: TypeExpression ('Required ('Null ('PGjsonb)))

867jsonb = UnsafeTypeExpression "jsonb"

868

869notNull

870 :: TypeExpression (optionality ('Null ty))

871 -> TypeExpression (optionality ('NotNull ty))

872notNull ty = UnsafeTypeExpression $ renderTypeExpression ty <+> "NOT NULL"

873default_

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

875 -> TypeExpression ('Required ty)

876 -> TypeExpression ('Optional ty)

877default_ x ty = UnsafeTypeExpression $

878 renderTypeExpression ty <+> "DEFAULT" <+> renderExpression x

879

880class PGTyped (ty :: PGType) where

881 pgtype :: TypeExpression ('Required ('Null ty))

882instance PGTyped 'PGbool where pgtype = bool

883instance PGTyped 'PGint2 where pgtype = int2

884instance PGTyped 'PGint4 where pgtype = int4

885instance PGTyped 'PGint8 where pgtype = int8

886instance PGTyped 'PGnumeric where pgtype = numeric

887instance PGTyped 'PGfloat4 where pgtype = float4

888instance PGTyped 'PGfloat8 where pgtype = float8

889instance PGTyped 'PGtext where pgtype = text

890instance (KnownNat n, 1 <= n)

891 => PGTyped ('PGchar n) where pgtype = char (Proxy @n)

892instance (KnownNat n, 1 <= n)

893 => PGTyped ('PGvarchar n) where pgtype = varchar (Proxy @n)

894instance PGTyped 'PGbytea where pgtype = bytea

895instance PGTyped 'PGtimestamp where pgtype = timestamp

896instance PGTyped 'PGtimestamptz where pgtype = timestampWithTimeZone

897instance PGTyped 'PGdate where pgtype = date

898instance PGTyped 'PGtime where pgtype = time

899instance PGTyped 'PGtimetz where pgtype = timeWithTimeZone

900instance PGTyped 'PGinterval where pgtype = interval

901instance PGTyped 'PGuuid where pgtype = uuid

902instance PGTyped 'PGjson where pgtype = json

903instance PGTyped 'PGjsonb where pgtype = jsonb