master..2e82fcc · rel8

git.iko.soy/rel8

13 files changed+105−97

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.hs+1−14 src/Rel8/Query/Indexed.hs+2−2 src/Rel8/Statement/Select.hs+3−2 src/Rel8/Statement/View.hs+5−30 src/Rel8/Tabulate.hs+1−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.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+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)

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/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

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