master..c69504e · rel8

git.iko.soy/rel8

on c69504e help sign in

20 files changed+124−424

since splitsnapshots

unifiedsplit

rel8.cabal+1−7

@@ -27,7 +27,7 @@ library

2727 , comonad

2828 , contravariant

2929 , hasql ^>= 1.4.5.1 || ^>= 1.5.0.0 || ^>= 1.6.0.0

30− , opaleye ^>= 0.9.6.1

30+ , opaleye ^>= 0.9.3.3

3131 , pretty

3232 , profunctors

3333 , product-profunctors

@@ -82,7 +82,6 @@ library

8282 Rel8.Expr.Order

8383 Rel8.Expr.Sequence

8484 Rel8.Expr.Serialize

85− Rel8.Expr.Window

8685

8786 Rel8.FCF

8887

@@ -121,7 +120,6 @@ library

121120 Rel8.Query.SQL

122121 Rel8.Query.These

123122 Rel8.Query.Values

124− Rel8.Query.Window

125123

126124 Rel8.Schema.Context.Nullify

127125 Rel8.Schema.Dict

@@ -181,7 +179,6 @@ library

181179 Rel8.Table.These

182180 Rel8.Table.Transpose

183181 Rel8.Table.Undefined

184− Rel8.Table.Window

185182

186183 Rel8.Type

187184 Rel8.Type.Array

@@ -200,9 +197,6 @@ library

200197 Rel8.Type.Sum

201198 Rel8.Type.Tag

202199

203− Rel8.Window

204−

205−

206200test-suite tests

207201 type: exitcode-stdio-1.0

208202 build-depends:

shell.nix+1−1

@@ -1,6 +1,6 @@

11let

22 sources = import ./nix/sources.nix;

3− pkgs = import sources.nixpkgs {overlays = [];};

3+ pkgs = import sources.nixpkgs {};

44 hsPkgs = import ./default.nix;

55in

66 hsPkgs.shellFor {

src/Rel8.hs−25

@@ -275,26 +275,6 @@ module Rel8

275275 , nullsLast

276276

277277 -- ** Window functions

278− , Window

279− , window

280− , Partition

281− , over

282− , partitionBy

283− , orderPartitionBy

284− , cumulative

285− , cumulative_

286− , currentRow

287− , rowNumber

288− , rank

289− , denseRank

290− , percentRank

291− , cumeDist

292− , ntile

293− , lag

294− , lead

295− , firstValue

296− , lastValue

297− , nthValue

298278 , indexed

299279

300280 -- ** Bindings

@@ -334,7 +314,6 @@ module Rel8

334314

335315 -- ** @CREATE VIEW@

336316 , createView

337− , createOrReplaceView

338317

339318 -- ** Sequences

340319 , nextval

@@ -368,7 +347,6 @@ import Rel8.Expr.Order

368347import Rel8.Expr.Serialize

369348import Rel8.Expr.Sequence

370349import Rel8.Expr.Text ( like, ilike )

371−import Rel8.Expr.Window hiding ( cumulative )

372350import Rel8.Generic.Rel8able ( KRel8able, Rel8able )

373351import Rel8.Order

374352import Rel8.Query

@@ -390,7 +368,6 @@ import Rel8.Query.SQL (showQuery)

390368import Rel8.Query.Set

391369import Rel8.Query.These

392370import Rel8.Query.Values

393−import Rel8.Query.Window

394371import Rel8.Schema.Field

395372import Rel8.Schema.HTable

396373import Rel8.Schema.Name

@@ -426,7 +403,6 @@ import Rel8.Table.Rel8able ()

426403import Rel8.Table.Serialize

427404import Rel8.Table.These

428405import Rel8.Table.Transpose

429−import Rel8.Table.Window

430406import Rel8.Type

431407import Rel8.Type.Composite

432408import Rel8.Type.Eq

@@ -441,7 +417,6 @@ import Rel8.Type.ReadShow

441417import Rel8.Type.Semigroup

442418import Rel8.Type.String

443419import Rel8.Type.Sum

444−import Rel8.Window

445420

446421

447422-- $running

src/Rel8/Aggregate.hs+19−11

@@ -2,6 +2,7 @@

22{-# language FlexibleContexts #-}

33{-# language FlexibleInstances #-}

44{-# language MultiParamTypeClasses #-}

5+{-# language NamedFieldPuns #-}

56{-# language RankNTypes #-}

67{-# language StandaloneKindSignatures #-}

78{-# language TypeFamilies #-}

@@ -9,7 +10,7 @@

910

1011module Rel8.Aggregate

1112 ( Aggregate(..), zipOutputs

12− , unsafeMakeAggregate

13+ , Aggregator(..), unsafeMakeAggregate

1314 , Aggregates

1415 )

1516where

@@ -20,13 +21,10 @@ import Data.Functor.Identity ( Identity( Identity ) )

2021import Data.Kind ( Constraint, Type )

2122import Prelude

2223

23−-- profunctors

24−import Data.Profunctor ( dimap )

25−

2624-- opaleye

27−import qualified Opaleye.Aggregate as Opaleye

25+import qualified Opaleye.Internal.Aggregate as Opaleye

2826import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

29−import qualified Opaleye.Internal.Column as Opaleye

27+import qualified Opaleye.Internal.PackMap as Opaleye

3028

3129-- rel8

3230import Rel8.Expr ( Expr )

@@ -71,13 +69,23 @@ zipOutputs :: ()

7169zipOutputs f (Aggregate a) (Aggregate b) = Aggregate (liftA2 f a b)

7270

7371

74−unsafeMakeAggregate :: forall (input :: Type) (output :: Type) n n' a a'. ()

72+type Aggregator :: Type

73+data Aggregator = Aggregator

74+ { operation :: Opaleye.AggrOp

75+ , ordering :: [Opaleye.OrderExpr]

76+ , distinction :: Opaleye.AggrDistinct

77+ }

78+

79+

80+unsafeMakeAggregate :: forall (input :: Type) (output :: Type). ()

7581 => (Expr input -> Opaleye.PrimExpr)

7682 -> (Opaleye.PrimExpr -> Expr output)

77− -> Opaleye.Aggregator (Opaleye.Field_ n a) (Opaleye.Field_ n' a')

83+ -> Maybe Aggregator

7884 -> Expr input

7985 -> Aggregate output

8086unsafeMakeAggregate input output aggregator expr =

81− Aggregate $ dimap in_ out aggregator

82− where out = output . Opaleye.unColumn

83− in_ = Opaleye.Column . input . const expr

87+ Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ \f _ ->

88+ output <$> f (tuplize <$> aggregator, input expr)

89+ where

90+ tuplize Aggregator {operation, ordering, distinction} =

91+ (operation, ordering, distinction)

src/Rel8/Expr/Aggregate.hs+70−16

@@ -24,12 +24,10 @@ import Data.List.NonEmpty ( NonEmpty )

2424import Prelude hiding ( and, max, min, null, or, sum )

2525

2626-- opaleye

27−import qualified Opaleye.Internal.Aggregate as Opaleye

28−import Opaleye.Internal.Column ( Field_( Column ) )

29−import qualified Opaleye.Aggregate as Opaleye

27+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

3028

3129-- rel8

32−import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

30+import Rel8.Aggregate ( Aggregate, Aggregator(..), unsafeMakeAggregate )

3331import Rel8.Expr ( Expr )

3432import Rel8.Expr.Bool ( caseExpr )

3533import Rel8.Expr.Opaleye

@@ -53,13 +51,23 @@ import Rel8.Type.Sum ( DBSum )

5351

5452-- | Count the occurances of a single column. Corresponds to @COUNT(a)@

5553count :: Expr a -> Aggregate Int64

56−count = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.count

54+count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

55+ Just Aggregator

56+ { operation = Opaleye.AggrCount

57+ , ordering = []

58+ , distinction = Opaleye.AggrAll

59+ }

60+

5761

5862-- | Count the number of distinct occurances of a single column. Corresponds to

5963-- @COUNT(DISTINCT a)@

6064countDistinct :: Sql DBEq a => Expr a -> Aggregate Int64

6165countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

62− Opaleye.distinctAggregator Opaleye.count

66+ Just Aggregator

67+ { operation = Opaleye.AggrCount

68+ , ordering = []

69+ , distinction = Opaleye.AggrDistinct

70+ }

6371

6472

6573-- | Corresponds to @COUNT(*)@.

@@ -74,22 +82,42 @@ countWhere condition = count (caseExpr [(condition, litExpr (Just True))] null)

7482

7583-- | Corresponds to @bool_and@.

7684and :: Expr Bool -> Aggregate Bool

77−and = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.boolAnd

85+and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

86+ Just Aggregator

87+ { operation = Opaleye.AggrBoolAnd

88+ , ordering = []

89+ , distinction = Opaleye.AggrAll

90+ }

7891

7992

8093-- | Corresponds to @bool_or@.

8194or :: Expr Bool -> Aggregate Bool

82−or = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.boolOr

95+or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

96+ Just Aggregator

97+ { operation = Opaleye.AggrBoolOr

98+ , ordering = []

99+ , distinction = Opaleye.AggrAll

100+ }

83101

84102

85103-- | Produce an aggregation for @Expr a@ using the @max@ function.

86104max :: Sql DBMax a => Expr a -> Aggregate a

87−max = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.unsafeMax

105+max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

106+ Just Aggregator

107+ { operation = Opaleye.AggrMax

108+ , ordering = []

109+ , distinction = Opaleye.AggrAll

110+ }

88111

89112

90113-- | Produce an aggregation for @Expr a@ using the @max@ function.

91114min :: Sql DBMin a => Expr a -> Aggregate a

92−min = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.unsafeMin

115+min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

116+ Just Aggregator

117+ { operation = Opaleye.AggrMin

118+ , ordering = []

119+ , distinction = Opaleye.AggrAll

120+ }

93121

94122-- | Corresponds to @sum@. Note that in SQL, @sum@ is type changing - for

95123-- example the @sum@ of @integer@ returns a @bigint@. Rel8 doesn't support

@@ -97,7 +125,12 @@ min = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.unsafeMin

97125-- lead to overflows, and if you anticipate very large sums, you should upcast

98126-- your input.

99127sum :: Sql DBSum a => Expr a -> Aggregate a

100−sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) Opaleye.unsafeSum

128+sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

129+ Just Aggregator

130+ { operation = Opaleye.AggrSum

131+ , ordering = []

132+ , distinction = Opaleye.AggrAll

133+ }

101134

102135

103136-- | Corresponds to @avg@. Note that in SQL, @avg@ is type changing - for

@@ -106,7 +139,13 @@ sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) Opaleye.unsafeSum

106139-- need a fractional result on an integral column, you should cast your input

107140-- to 'Double' or 'Data.Scientific.Scientific' before calling 'avg'.

108141avg :: Sql DBSum a => Expr a -> Aggregate a

109−avg = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) Opaleye.unsafeAvg

142+avg = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

143+ Just Aggregator

144+ { operation = Opaleye.AggrAvg

145+ , ordering = []

146+ , distinction = Opaleye.AggrAll

147+ }

148+

110149

111150-- | Take the sum of all expressions that satisfy a predicate.

112151sumWhere :: (Sql DBNum a, Sql DBSum a)

@@ -118,12 +157,17 @@ sumWhere condition a = sum (caseExpr [(condition, a)] 0)

118157stringAgg :: Sql DBString a

119158 => Expr db -> Expr a -> Aggregate a

120159stringAgg delimiter =

121− unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) (Opaleye.stringAgg (Column (toPrimExpr delimiter)))

160+ unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

161+ Just Aggregator

162+ { operation = Opaleye.AggrStringAggr (toPrimExpr delimiter)

163+ , ordering = []

164+ , distinction = Opaleye.AggrAll

165+ }

122166

123167

124168-- | Aggregate a value by grouping by it.

125169groupByExpr :: Sql DBEq a => Expr a -> Aggregate a

126−groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.groupBy

170+groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

127171

128172

129173-- | Collect expressions values as a list.

@@ -138,13 +182,23 @@ nonEmptyAggExpr = snonEmptyAggExpr typeInformation

138182

139183slistAggExpr :: ()

140184 => TypeInformation (Unnullify a) -> Expr a -> Aggregate [a]

141−slistAggExpr info = unsafeMakeAggregate to fromPrimExpr Opaleye.arrayAgg

185+slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

186+ Aggregator

187+ { operation = Opaleye.AggrArr

188+ , ordering = []

189+ , distinction = Opaleye.AggrAll

190+ }

142191 where

143192 to = encodeArrayElement info . toPrimExpr

144193

145194

146195snonEmptyAggExpr :: ()

147196 => TypeInformation (Unnullify a) -> Expr a -> Aggregate (NonEmpty a)

148−snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr Opaleye.arrayAgg

197+snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

198+ Aggregator

199+ { operation = Opaleye.AggrArr

200+ , ordering = []

201+ , distinction = Opaleye.AggrAll

202+ }

149203 where

150204 to = encodeArrayElement info . toPrimExpr

src/Rel8/Expr/Sequence.hs+1−2

@@ -11,7 +11,6 @@ import Prelude

1111import Rel8.Expr ( Expr )

1212import Rel8.Expr.Function ( function )

1313import Rel8.Expr.Serialize ( litExpr )

14−import Rel8.Expr.Text ( quoteIdent )

1514

1615-- text

1716import Data.Text ( pack )

@@ -19,4 +18,4 @@ import Data.Text ( pack )

1918

2019-- | See https://www.postgresql.org/docs/current/functions-sequence.html

2120nextval :: String -> Expr Int64

22−nextval = function "nextval" . quoteIdent . litExpr . pack

21+nextval = function "nextval" . litExpr . pack

src/Rel8/Expr/Window.hsdeleted−121

@@ -1,121 +0,0 @@

1−module Rel8.Expr.Window

2− ( cumulative

3− , rowNumber

4− , rank

5− , denseRank

6− , percentRank

7− , cumeDist

8− , ntile

9− , lag

10− , lead

11− , firstValue

12− , lastValue

13− , nthValue

14− )

15−where

16−

17−-- base

18−import Data.Int ( Int32, Int64 )

19−import Prelude

20−

21−-- opaleye

22−import qualified Opaleye.Internal.Aggregate as Opaleye

23−import qualified Opaleye.Internal.PackMap as Opaleye

24−import qualified Opaleye.Internal.Window as Opaleye

25−import qualified Opaleye.Window as Opaleye

26−

27−-- profunctors

28−import Data.Profunctor (dimap)

29−

30−-- rel8

31−import Rel8.Aggregate ( Aggregate( Aggregate ) )

32−import Rel8.Expr ( Expr )

33−import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr, toColumn, toPrimExpr )

34−import Rel8.Schema.Null ( Nullify )

35−import Rel8.Window ( Window( Window ) )

36−

37−

38−cumulative :: (a -> Aggregate b) -> Window a (Expr b)

39−cumulative f =

40− fromWindowFunction $ Opaleye.aggregatorWindowFunction (fromAggregate f) id

41−

42−

43−-- | [@row_number()@](https://www.postgresql.org/docs/current/functions-window.html)

44−rowNumber :: Window a (Expr Int64)

45−rowNumber = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rowNumber

46−

47−

48−-- | [@rank()@](https://www.postgresql.org/docs/current/functions-window.html)

49−rank :: Window a (Expr Int64)

50−rank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.rank

51−

52−

53−-- | [@dense_rank()@](https://www.postgresql.org/docs/current/functions-window.html)

54−denseRank :: Window a (Expr Int64)

55−denseRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.denseRank

56−

57−

58−-- | [@percent_rank()@](https://www.postgresql.org/docs/current/functions-window.html)

59−percentRank :: Window a (Expr Double)

60−percentRank = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.percentRank

61−

62−

63−-- | [@cume_dist()@](https://www.postgresql.org/docs/current/functions-window.html)

64−cumeDist :: Window a (Expr Double)

65−cumeDist = fromWindowFunction $ fromPrimExpr . fromColumn <$> Opaleye.cumeDist

66−

67−

68−-- | [@ntile(num_buckets)@](https://www.postgresql.org/docs/current/functions-window.html)

69−ntile :: Expr Int32 -> Window a (Expr Int32)

70−ntile buckets = fromWindowFunction $ fromPrimExpr . fromColumn <$>

71− Opaleye.ntile (toColumn (toPrimExpr buckets))

72−

73−

74−-- | [@lag(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)

75−lag :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)

76−lag offset def =

77− fromWindowFunction $

78− dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

79− Opaleye.lag (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))

80−

81−

82−-- | [@lead(value, offset, default)@](https://www.postgresql.org/docs/current/functions-window.html)

83−lead :: Expr Int32 -> Expr a -> Window (Expr a) (Expr a)

84−lead offset def =

85− fromWindowFunction $

86− dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

87− Opaleye.lead (toColumn (toPrimExpr offset)) (toColumn (toPrimExpr def))

88−

89−

90−-- | [@first_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)

91−firstValue :: Window (Expr a) (Expr a)

92−firstValue =

93− fromWindowFunction $

94− dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)

95− Opaleye.firstValue

96−

97−

98−-- | [@last_value(value)@](https://www.postgresql.org/docs/current/functions-window.html)

99−lastValue :: Window (Expr a) (Expr a)

100−lastValue =

101− fromWindowFunction $

102− dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn)

103− Opaleye.lastValue

104−

105−

106−-- | [@nth_value(value, n)@](https://www.postgresql.org/docs/current/functions-window.html)

107−nthValue :: Expr Int32 -> Window (Expr a) (Expr (Nullify a))

108−nthValue n =

109− fromWindowFunction $

110− dimap (toColumn . toPrimExpr) (fromPrimExpr . fromColumn) $

111− Opaleye.nthValue (toColumn (toPrimExpr n))

112−

113−

114−fromAggregate :: (a -> Aggregate b) -> Opaleye.Aggregator a (Expr b)

115−fromAggregate f = Opaleye.Aggregator $ Opaleye.PackMap $ \w a -> case f a of

116− Aggregate (Opaleye.Aggregator (Opaleye.PackMap x)) -> x w ()

117−

118−

119−fromWindowFunction :: Opaleye.WindowFunction a b -> Window a b

120−fromWindowFunction (Opaleye.WindowFunction (Opaleye.PackMap w)) =

121− Window $ Opaleye.Windows $ Opaleye.PackMap $ \f -> w $ \o -> f (o, mempty)

src/Rel8/Generic/Rel8able.hs−5

@@ -63,11 +63,6 @@ type KRel8able = K.Rel8able

6363-- This is almost 'Data.Type.Equality.==', but we add an extra case.

6464type (==) :: k -> k -> Bool

6565type family a == b where

66− -- This extra case is needed to solve the equation "a == a" (where a is a

67− -- KRel8able), which occurs when we have polymorphic Rel8ables

68− -- (e.g., newtype T t f = T { x :: t a })

69− (a :: KRel8able) == (a :: KRel8able) = 'True

70−

7166 -- This extra case is needed to solve the equation "a == Identity a",

7267 -- which occurs when we have polymorphic Rel8ables

7368 -- (e.g., newtype T a f = T { x :: Column f a })

src/Rel8/Order.hs+1

@@ -16,6 +16,7 @@ import Prelude

1616import Data.Functor.Contravariant.Divisible ( Decidable, Divisible )

1717

1818-- opaleye

19+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

1920import qualified Opaleye.Order as Opaleye

2021

2122

src/Rel8/Query.hs+1−14

@@ -1,6 +1,4 @@

1−{-# language FlexibleContexts #-}

21{-# language StandaloneKindSignatures #-}

3−{-# language UndecidableInstances #-}

53module Rel8.Query

64 ( Query( Query )

@@ -22,11 +20,10 @@ import qualified Opaleye.Internal.QueryArr as Opaleye

2220import qualified Opaleye.Internal.Tag as Opaleye

2321

2422-- rel8

25−import Rel8.Expr ( Expr )

2623import Rel8.Query.Set ( unionAll )

2724import Rel8.Query.Opaleye ( fromOpaleye )

2825import Rel8.Query.Values ( values )

29−import Rel8.Table ( Table, fromColumns, toColumns )

26+import Rel8.Table ( fromColumns, toColumns )

3027import Rel8.Table.Alternative

3128 ( AltTable, (<|>:)

3229 , AlternativeTable, emptyTable

@@ -211,13 +208,3 @@ instance AltTable Query where

211208-- | 'emptyTable' = 'values' @[]@.

212209instance AlternativeTable Query where

213210 emptyTable = values []

214−

215−

216−-- | '<>' = 'unionAll'.

217−instance Table Expr a => Semigroup (Query a) where

218− (<>) = (<|>:)

219−

220−

221−-- | 'mempty' = @'values' []@.

222−instance Table Expr a => Monoid (Query a) where

223− mempty = emptyTable

src/Rel8/Query/Indexed.hs+18−5

@@ -4,18 +4,31 @@ module Rel8.Query.Indexed

44where

66-- base

7−import Control.Applicative ( liftA2 )

87import Data.Int ( Int64 )

98import Prelude

109

10+-- opaleye

11+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

12+import qualified Opaleye.Internal.PackMap as Opaleye

13+import qualified Opaleye.Internal.PrimQuery as Opaleye

14+import qualified Opaleye.Internal.QueryArr as Opaleye

15+import qualified Opaleye.Internal.Tag as Opaleye

16+

1117-- rel8

1218import Rel8.Expr ( Expr )

13−import Rel8.Expr.Window ( rowNumber )

19+import Rel8.Expr.Opaleye ( fromPrimExpr )

1420import Rel8.Query ( Query )

15−import Rel8.Query.Window ( window )

16−import Rel8.Table.Window ( currentRow )

21+import Rel8.Query.Opaleye ( mapOpaleye )

1722

1823

1924-- | Pair each row of a query with its index within the query.

2025indexed :: Query a -> Query (Expr Int64, a)

21−indexed = window (liftA2 (,) (subtract 1 <$> rowNumber) currentRow)

26+indexed = mapOpaleye $ \f -> Opaleye.stateQueryArr $ \_ tag ->

27+ let

28+ (a, query, tag') = Opaleye.runStateQueryArr f () tag

29+ tag'' = Opaleye.next tag'

30+ window = Opaleye.ConstExpr $ Opaleye.OtherLit "ROW_NUMBER() OVER () - 1"

31+ (index, bindings) = Opaleye.run $ Opaleye.extractAttr "index" tag' window

32+ query' = query <> Opaleye.aRebind bindings

33+ in

34+ ((fromPrimExpr index, a), query', tag'')

src/Rel8/Query/Window.hsdeleted−26

@@ -1,26 +0,0 @@

1−module Rel8.Query.Window

2− ( window

3− )

4−where

5−

6−-- base

7−import Prelude ()

8−

9−-- opaleye

10−import qualified Opaleye.Window as Opaleye

11−

12−-- rel8

13−import Rel8.Query ( Query )

14−import Rel8.Query.Opaleye ( mapOpaleye )

15−import Rel8.Window ( Window( Window ) )

16−

17−

18−-- | 'window' runs a query composed of expressions containing

19−-- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).

20−-- 'window' is similar to 'Rel8.aggregate', with the main difference being

21−-- that in a window query, each input row corresponds to one output row,

22−-- whereas aggregation queries fold the entire input query down into a single

23−-- row. To put this into a Haskell context, 'Rel8.aggregate' is to 'foldl' as

24−-- 'window' is to 'scanl'.

25−window :: Window a b -> Query a -> Query b

26−window (Window a) = mapOpaleye (Opaleye.runWindows a)

src/Rel8/Schema/HTable.hs+1−7

@@ -16,12 +16,11 @@

1616module Rel8.Schema.HTable

1717 ( HTable (HField, HConstrainTable)

1818 , hfield, htabulate, htraverse, hdicts, hspecs

19− , hfoldMap, hmap, htabulateA, htraverseP, htraversePWithField

19+ , hmap, htabulateA, htraverseP, htraversePWithField

2020 )

2121where

2222

2323-- base

24−import Data.Functor.Const ( Const( Const ), getConst )

2524import Data.Kind ( Constraint, Type )

2625import Data.Functor.Compose ( Compose( Compose ), getCompose )

2726import Data.Proxy ( Proxy )

@@ -120,11 +119,6 @@ class HTable t where

120119 {-# INLINABLE hspecs #-}

121120

122121

123−hfoldMap :: (HTable t, Semigroup s)

124− => (forall a. context a -> s) -> t context -> s

125−hfoldMap f a = getConst $ htraverse (Const . f) a

126−

127−

128122hmap :: HTable t

129123 => (forall a. context a -> context' a) -> t context -> t context'

130124hmap f a = htabulate $ \field -> f (hfield a field)

src/Rel8/Statement/Select.hs+3−2

@@ -19,6 +19,7 @@ where

1919-- base

2020import Data.Foldable ( toList )

2121import Data.Kind ( Type )

22+import Data.List.NonEmpty ( NonEmpty( (:|) ) )

2223import Data.Void ( Void )

2324import Prelude hiding ( undefined )

2425

@@ -91,7 +92,7 @@ ppSelect query =

9192ppRows :: Table Expr a => Query a -> Doc

9293ppRows query = case optimize primQuery of

9394 -- Special case VALUES because we can't use DEFAULT inside a SELECT

94− Optimized (Opaleye.Values symbols rows)

95+ Optimized (Opaleye.Product ((_, Opaleye.Values symbols rows) :| []) [])

9596 | eqSymbols symbols (toList (T.exprs a)) ->

9697 Opaleye.ppValues_ (map Opaleye.sqlExpr <$> toList rows)

9798 _ -> ppSelect query

@@ -119,7 +120,7 @@ ppPrimSelect query =

119120

120121type Optimized :: Type -> Type

121122data Optimized a = Empty | Unit | Optimized a

122− deriving stock (Functor, Foldable, Traversable, Show)

123+ deriving stock (Functor, Foldable, Traversable)

123124

124125

125126optimize :: Opaleye.PrimQuery' a -> Optimized (Opaleye.PrimQuery' Void)

src/Rel8/Statement/View.hs+5−30

@@ -3,7 +3,6 @@

44module Rel8.Statement.View

55 ( createView

6− , createOrReplaceView

76 )

87where

@@ -30,49 +29,25 @@ import qualified Data.Text as Text

3029import Data.Text.Encoding ( encodeUtf8 )

3130

3231

33−data CreateView = Create | CreateOrReplace

34−

35−

3632-- | Given a 'TableSchema' and 'Query', @createView@ runs a @CREATE VIEW@

3733-- statement that will save the given query as a view. This can be useful if

3834-- you want to share Rel8 queries with other applications.

3935createView :: Selects names exprs

4036 => TableSchema names -> Query exprs -> Hasql.Statement () ()

41−createView =

42− createViewGeneric Create

43−

44−

45−-- | Given a 'TableSchema' and 'Query', @createOrReplaceView@ runs a

46−-- @CREATE OR REPLACE VIEW@ statement that will save the given query

47−-- as a view, replacing the current view definition if it exists and

48−-- adheres to the restrictions in place for replacing a view in

49−-- PostgreSQL.

50−createOrReplaceView :: Selects names exprs

51− => TableSchema names -> Query exprs -> Hasql.Statement () ()

52−createOrReplaceView =

53− createViewGeneric CreateOrReplace

54−

55−

56−createViewGeneric :: Selects names exprs

57− => CreateView -> TableSchema names -> Query exprs -> Hasql.Statement () ()

58−createViewGeneric replace schema query =

59− Hasql.Statement bytes params decode prepare

37+createView schema query = Hasql.Statement bytes params decode prepare

6038 where

6139 bytes = encodeUtf8 (Text.pack sql)

6240 params = Hasql.noParams

6341 decode = Hasql.noResult

6442 prepare = False

6543 sql = show doc

66− doc = ppCreateView schema query replace

44+ doc = ppCreateView schema query

6745

6846

6947ppCreateView :: Selects names exprs

70− => TableSchema names -> Query exprs -> CreateView -> Doc

71−ppCreateView schema query replace =

72− createOrReplace replace <+>

48+ => TableSchema names -> Query exprs -> Doc

49+ppCreateView schema query =

50+ text "CREATE VIEW" <+>

7351 ppInto schema $$

7452 text "AS" <+>

7553 ppSelect query

76− where

77− createOrReplace Create = text "CREATE VIEW"

78− createOrReplace CreateOrReplace = text "CREATE OR REPLACE VIEW"

src/Rel8/Table/Opaleye.hs+1

@@ -35,6 +35,7 @@ import qualified Opaleye.Adaptors as Opaleye

3535import qualified Opaleye.Field as Opaleye ( Field_ )

3636import qualified Opaleye.Internal.Aggregate as Opaleye

3737import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

38+import qualified Opaleye.Internal.PackMap as Opaleye

3839import qualified Opaleye.Internal.Values as Opaleye

3940import qualified Opaleye.Table as Opaleye

4041

src/Rel8/Table/Window.hsdeleted−43

@@ -1,43 +0,0 @@

1−{-# language MonoLocalBinds #-}

2−

3−module Rel8.Table.Window

4− ( cumulative

5− , cumulative_

6− , currentRow

7− )

8−where

9−

10−-- base

11−import Prelude

12−

13−-- opaleye

14−import qualified Opaleye.Window as Opaleye

15−

16−-- rel8

17−import Rel8.Aggregate ( Aggregates )

18−import qualified Rel8.Expr.Window as Expr

19−import Rel8.Schema.HTable ( hfield, htabulateA )

20−import Rel8.Table ( fromColumns, toColumns )

21−import Rel8.Window ( Window( Window ) )

22−

23−

24−-- | 'cumulative' allows the use of aggregation functions in 'Window'

25−-- expressions. In particular, @'cumulative' 'Rel8.sum'@

26−-- (when combined with 'Rel8.Window.orderPartitionBy') gives a running total,

27−-- also known as a \"cumulative sum\", hence the name @cumulative@.

28−cumulative :: Aggregates aggregates exprs => (a -> aggregates) -> Window a exprs

29−cumulative f =

30− fmap fromColumns $

31− htabulateA $ \field ->

32− Expr.cumulative ((`hfield` field) . toColumns . f)

33−

34−

35−-- | A version of 'cumulative' for use with nullary aggregators like

36−-- 'Rel8.Expr.Aggregate.countStar'.

37−cumulative_ :: Aggregates aggregates exprs => aggregates -> Window a exprs

38−cumulative_ = cumulative . const

39−

40−

41−-- | Return every column of the current row of a window query.

42−currentRow :: Window a a

43−currentRow = Window $ Opaleye.over (Opaleye.noWindowFunction id) mempty mempty

src/Rel8/Tabulate.hs+1−2

@@ -93,7 +93,6 @@ import Rel8.Query.Filter ( where_ )

9393import Rel8.Query.List ( catNonEmptyTable )

9494import qualified Rel8.Query.Maybe as Q ( optional )

9595import Rel8.Query.Opaleye ( mapOpaleye, unsafePeekQuery )

96−import Rel8.Query.Rebind ( rebind )

9796import Rel8.Query.These ( alignBy )

9897import Rel8.Table ( Table, fromColumns, toColumns )

9998import Rel8.Table.Aggregate ( hgroupBy, listAgg, nonEmptyAgg )

@@ -509,8 +508,8 @@ alignWith :: EqTable k

509508 -> Tabulation k a -> Tabulation k b -> Tabulation k c

510509alignWith f (Tabulation as) (Tabulation bs) = Tabulation $ \p -> do

511510 tkab <- liftF2 (alignBy condition) as bs p

512− k <- traverse (rebind "key") $ recover $ bimap fst fst tkab

513511 let

512+ k = recover $ bimap fst fst tkab

514513 tab = bimap snd snd tkab

515514 pure (k, f tab)

516515 where

src/Rel8/Window.hsdeleted−97

@@ -1,97 +0,0 @@

1−{-# language DerivingVia #-}

2−{-# language FlexibleContexts #-}

3−{-# language GeneralizedNewtypeDeriving #-}

4−{-# language ScopedTypeVariables #-}

5−{-# language StandaloneKindSignatures #-}

6−{-# language TypeApplications #-}

7−

8−module Rel8.Window

9− ( Window(..)

10− , Partition

11− , over

12− , partitionBy

13− , orderPartitionBy

14− )

15−where

16−

17−-- base

18−import Data.Functor.Const ( Const( Const ), getConst )

19−import Data.Functor.Contravariant ( Contravariant, contramap )

20−import Data.Kind ( Type )

21−import Prelude

22−

23−-- opaleye

24−import qualified Opaleye.Internal.Window as Opaleye

25−import qualified Opaleye.Internal.PackMap as Opaleye

26−

27−-- profunctors

28−import Data.Profunctor ( Profunctor )

29−

30−-- product-profunctors

31−import Data.Profunctor.Product ( ProductProfunctor, (****), purePP )

32−

33−-- rel8

34−import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

35−import Rel8.Order( Order( Order ) )

36−import Rel8.Schema.HTable ( hfield, htabulateA )

37−import Rel8.Table ( Columns, toColumns )

38−import Rel8.Table.Eq ( EqTable )

39−

40−-- semigroupoids

41−import Data.Functor.Apply ( Apply, WrappedApplicative(..) )

42−

43−

44−-- | 'Window' is an applicative functor that represents expressions that

45−-- contain

46−-- [window functions](https://www.postgresql.org/docs/current/tutorial-window.html).

47−-- 'Rel8.Query.Window.window' can be used to

48−-- evaluate these expressions over a particular query.

49−type Window :: Type -> Type -> Type

50−newtype Window a b = Window (Opaleye.Windows a b)

51− deriving newtype (Profunctor)

52− deriving newtype (Functor, Applicative)

53− deriving (Apply) via (WrappedApplicative (Window a))

54−

55−

56−instance ProductProfunctor Window where

57− purePP = pure

58− (****) = (<*>)

59−

60−

61−-- | In PostgreSQL, window functions must specify the \"window\" or

62−-- \"partition\" over which they operate. The syntax for this looks like:

63−-- @SUM(salary) OVER (PARTITION BY department)@. The Rel8 type 'Partition'

64−-- represents everything that comes after @OVER@.

65−--

66−-- 'Partition' is a 'Monoid', so 'Window's created with 'partitionBy' and

67−-- 'orderWindowBy' can be combined using '<>'.

68−type Partition :: Type -> Type

69−newtype Partition a = Partition (Opaleye.Window a)

70− deriving newtype (Contravariant, Semigroup, Monoid)

71−

72−

73−-- | 'over' adds a 'Partition' to a 'Window' expression.

74−--

75−-- @@@

76−-- 'Rel8.Table.Window.cumulative' ('Rel8.Expr.Aggregate.sum' . salary) `over` 'partitionBy' department <> 'orderPartitionBy' (salary >$< 'Rel8.desc')

77−-- @@@

78−over :: Window a b -> Partition a -> Window a b

79−over (Window (Opaleye.Windows (Opaleye.PackMap w))) (Partition p) =

80− Window $ Opaleye.Windows $ Opaleye.PackMap $ \f ->

81− w (\(o, p') -> f (o, p' <> p))

82−infixl 1 `over`

83−

84−

85−-- | Restricts a window function to operate only the group of rows that share

86−-- the same value(s) for the given expression(s).

87−partitionBy :: forall b a. EqTable b => (a -> b) -> Partition a

88−partitionBy f =

89− Partition $ contramap (toColumns . f) $ getConst $

90− htabulateA @(Columns b) $ \field ->

91− Const $ Opaleye.partitionBy (toColumn . toPrimExpr . (`hfield` field))

92−

93−

94−-- | Controls the order in which rows are processed by window functions. This

95−-- does not need to match the ordering of the overall query.

96−orderPartitionBy :: Order a -> Partition a

97−orderPartitionBy (Order ordering) = Partition $ Opaleye.orderPartitionBy ordering

tests/Rel8/Generic/Rel8able/Test.hs+1−10

@@ -5,7 +5,6 @@

55{-# language DuplicateRecordFields #-}

66{-# language FlexibleInstances #-}

77{-# language MultiParamTypeClasses #-}

8−{-# language StandaloneKindSignatures #-}

98{-# language TypeFamilies #-}

109{-# language UndecidableInstances #-}

1110

@@ -172,17 +171,9 @@ data NestedTableTestB f = NestedTableTestB

172171 deriving anyclass Rel8able

173172

174173

174+

175175newtype IdRecord a f = IdRecord { recordId :: Column f a }

176176 deriving stock Generic

177177

178178

179179instance DBType a => Rel8able (IdRecord a)

180−

181−

182−type Nest :: KRel8able -> KRel8able -> KRel8able

183−data Nest t u f = Nest

184− { foo :: t f

185− , bar :: u f

186− }

187− deriving stock Generic

188− deriving anyclass Rel8able