2e82fcc..master · rel8

git.iko.soy/rel8

13 files changed+97−105

unifiedsplit

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

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.0

30+ , opaleye ^>= 0.9.6.1

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 {};

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

44 hsPkgs = import ./default.nix;

55in

66 hsPkgs.shellFor {

src/Rel8.hs+1

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

334334

335335 -- ** @CREATE VIEW@

336336 , createView

337+ , createOrReplaceView

337338

338339 -- ** Sequences

339340 , nextval

src/Rel8/Aggregate.hs+11−19

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

22{-# language FlexibleContexts #-}

33{-# language FlexibleInstances #-}

44{-# language MultiParamTypeClasses #-}

5−{-# language NamedFieldPuns #-}

65{-# language RankNTypes #-}

76{-# language StandaloneKindSignatures #-}

87{-# language TypeFamilies #-}

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

109

1110module Rel8.Aggregate

1211 ( Aggregate(..), zipOutputs

13− , Aggregator(..), unsafeMakeAggregate

12+ , unsafeMakeAggregate

1413 , Aggregates

1514 )

1615where

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

2120import Data.Kind ( Constraint, Type )

2221import Prelude

2322

23+-- profunctors

24+import Data.Profunctor ( dimap )

25+

2426-- opaleye

25−import qualified Opaleye.Internal.Aggregate as Opaleye

27+import qualified Opaleye.Aggregate as Opaleye

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

27−import qualified Opaleye.Internal.PackMap as Opaleye

29+import qualified Opaleye.Internal.Column as Opaleye

2830

2931-- rel8

3032import Rel8.Expr ( Expr )

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

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

7072

7173

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). ()

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

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

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

83− -> Maybe Aggregator

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

8478 -> Expr input

8579 -> Aggregate output

8680unsafeMakeAggregate input output aggregator 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)

81+ Aggregate $ dimap in_ out aggregator

82+ where out = output . Opaleye.unColumn

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

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

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

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

2525

2626-- opaleye

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

27+import qualified Opaleye.Internal.Aggregate as Opaleye

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

29+import qualified Opaleye.Aggregate as Opaleye

2830

2931-- rel8

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

32+import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )

3133import Rel8.Expr ( Expr )

3234import Rel8.Expr.Bool ( caseExpr )

3335import Rel8.Expr.Opaleye

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

5153

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

5355count :: Expr a -> Aggregate Int64

54−count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

55− Just Aggregator

56− { operation = Opaleye.AggrCount

57− , ordering = []

58− , distinction = Opaleye.AggrAll

59− }

60−

56+count = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.count

6157

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

6359-- @COUNT(DISTINCT a)@

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

6561countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

66− Just Aggregator

67− { operation = Opaleye.AggrCount

68− , ordering = []

69− , distinction = Opaleye.AggrDistinct

70− }

62+ Opaleye.distinctAggregator Opaleye.count

7163

7264

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

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

8274

8375-- | Corresponds to @bool_and@.

8476and :: Expr Bool -> Aggregate Bool

85−and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

86− Just Aggregator

87− { operation = Opaleye.AggrBoolAnd

88− , ordering = []

89− , distinction = Opaleye.AggrAll

90− }

77+and = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.boolAnd

9178

9279

9380-- | Corresponds to @bool_or@.

9481or :: Expr Bool -> Aggregate Bool

95−or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

96− Just Aggregator

97− { operation = Opaleye.AggrBoolOr

98− , ordering = []

99− , distinction = Opaleye.AggrAll

100− }

82+or = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.boolOr

10183

10284

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

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

105−max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

106− Just Aggregator

107− { operation = Opaleye.AggrMax

108− , ordering = []

109− , distinction = Opaleye.AggrAll

110− }

87+max = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.unsafeMax

11188

11289

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

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

115−min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

116− Just Aggregator

117− { operation = Opaleye.AggrMin

118− , ordering = []

119− , distinction = Opaleye.AggrAll

120− }

92+min = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.unsafeMin

12193

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

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

@@ -125,12 +97,7 @@ min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

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

12698-- your input.

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

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

129− Just Aggregator

130− { operation = Opaleye.AggrSum

131− , ordering = []

132− , distinction = Opaleye.AggrAll

133− }

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

134101

135102

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

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

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

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

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

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

143− Just Aggregator

144− { operation = Opaleye.AggrAvg

145− , ordering = []

146− , distinction = Opaleye.AggrAll

147− }

148−

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

149110

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

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

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

157118stringAgg :: Sql DBString a

158119 => Expr db -> Expr a -> Aggregate a

159120stringAgg delimiter =

160− unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

161− Just Aggregator

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

163− , ordering = []

164− , distinction = Opaleye.AggrAll

165− }

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

166122

167123

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

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

170−groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

126+groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Opaleye.groupBy

171127

172128

173129-- | Collect expressions values as a list.

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

182138

183139slistAggExpr :: ()

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

185−slistAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

186− Aggregator

187− { operation = Opaleye.AggrArr

188− , ordering = []

189− , distinction = Opaleye.AggrAll

190− }

141+slistAggExpr info = unsafeMakeAggregate to fromPrimExpr Opaleye.arrayAgg

191142 where

192143 to = encodeArrayElement info . toPrimExpr

193144

194145

195146snonEmptyAggExpr :: ()

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

197−snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr $ Just

198− Aggregator

199− { operation = Opaleye.AggrArr

200− , ordering = []

201− , distinction = Opaleye.AggrAll

202− }

148+snonEmptyAggExpr info = unsafeMakeAggregate to fromPrimExpr Opaleye.arrayAgg

203149 where

204150 to = encodeArrayElement info . toPrimExpr

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

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

1111import Rel8.Expr ( Expr )

1212import Rel8.Expr.Function ( function )

1313import Rel8.Expr.Serialize ( litExpr )

14+import Rel8.Expr.Text ( quoteIdent )

1415

1516-- text

1617import Data.Text ( pack )

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

1819

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

2021nextval :: String -> Expr Int64

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

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

src/Rel8/Generic/Rel8able.hs+5

@@ -63,6 +63,11 @@ 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+

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

6772 -- which occurs when we have polymorphic Rel8ables

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

src/Rel8/Query.hs+14−1

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

1+{-# language FlexibleContexts #-}

12{-# language StandaloneKindSignatures #-}

3+{-# language UndecidableInstances #-}

35module Rel8.Query

46 ( Query( Query )

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

2022import qualified Opaleye.Internal.Tag as Opaleye

2123

2224-- rel8

25+import Rel8.Expr ( Expr )

2326import Rel8.Query.Set ( unionAll )

2427import Rel8.Query.Opaleye ( fromOpaleye )

2528import Rel8.Query.Values ( values )

26−import Rel8.Table ( fromColumns, toColumns )

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

2730import Rel8.Table.Alternative

2831 ( AltTable, (<|>:)

2932 , AlternativeTable, emptyTable

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

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

209212instance AlternativeTable Query where

210213 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 (,) rowNumber currentRow)

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

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

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

1919-- base

2020import Data.Foldable ( toList )

2121import Data.Kind ( Type )

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

2322import Data.Void ( Void )

2423import Prelude hiding ( undefined )

2524

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

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

9392ppRows query = case optimize primQuery of

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

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

94+ Optimized (Opaleye.Values symbols rows)

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

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

9897 _ -> ppSelect query

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

120119

121120type Optimized :: Type -> Type

122121data Optimized a = Empty | Unit | Optimized a

123− deriving stock (Functor, Foldable, Traversable)

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

124123

125124

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

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

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

44module Rel8.Statement.View

55 ( createView

6+ , createOrReplaceView

67 )

78where

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

2930import Data.Text.Encoding ( encodeUtf8 )

3031

3132

33+data CreateView = Create | CreateOrReplace

34+

35+

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

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

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

3539createView :: Selects names exprs

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

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

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

3860 where

3961 bytes = encodeUtf8 (Text.pack sql)

4062 params = Hasql.noParams

4163 decode = Hasql.noResult

4264 prepare = False

4365 sql = show doc

44− doc = ppCreateView schema query

66+ doc = ppCreateView schema query replace

4567

4668

4769ppCreateView :: Selects names exprs

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

49−ppCreateView schema query =

50− text "CREATE VIEW" <+>

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

71+ppCreateView schema query replace =

72+ createOrReplace replace <+>

5173 ppInto schema $$

5274 text "AS" <+>

5375 ppSelect query

76+ where

77+ createOrReplace Create = text "CREATE VIEW"

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

src/Rel8/Tabulate.hs+2−1

@@ -93,6 +93,7 @@ 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 )

9697import Rel8.Query.These ( alignBy )

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

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

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

508509 -> Tabulation k a -> Tabulation k b -> Tabulation k c

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

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

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

511513 let

512− k = recover $ bimap fst fst tkab

513514 tab = bimap snd snd tkab

514515 pure (k, f tab)

515516 where

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

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

55{-# language DuplicateRecordFields #-}

66{-# language FlexibleInstances #-}

77{-# language MultiParamTypeClasses #-}

8+{-# language StandaloneKindSignatures #-}

89{-# language TypeFamilies #-}

910{-# language UndecidableInstances #-}

1011

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

171172 deriving anyclass Rel8able

172173

173174

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