master..fd0b449 · rel8

git.iko.soy/rel8

9 files changed+95−49

unifiedsplit

rel8.cabal+1−1 shell.nix+1−1 src/Rel8.hs−1 src/Rel8/Aggregate.hs+19−11 src/Rel8/Expr/Aggregate.hs+70−16 src/Rel8/Expr/Sequence.hs+1−2 src/Rel8/Generic/Rel8able.hs−5 src/Rel8/Query/Indexed.hs+2−2 tests/Rel8/Generic/Rel8able/Test.hs+1−10

rel8.cabal+1−1

@@ -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.6.0

3131 , pretty

3232 , profunctors

3333 , product-profunctors

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−1

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

334334

335335 -- ** @CREATE VIEW@

336336 , createView

337− , createOrReplaceView

338337

339338 -- ** Sequences

340339 , nextval

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/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/Query/Indexed.hs+2−2

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

66-- base

77import Control.Applicative ( liftA2 )

88import Data.Int ( Int64 )

9−import Prelude

9+import Prelude ()

1010

1111-- rel8

1212import Rel8.Expr ( Expr )

@@ -18,4 +18,4 @@ import Rel8.Table.Window ( currentRow )

1818

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

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

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

21+indexed = window (liftA2 (,) rowNumber currentRow)

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