b86f445 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Rename singularize to distinctTabulation and implement in terms of distinctOn

b86f445Shane O'Brien5 years ago

src/Rel8.hs−1

compare with master

unifiedsplit

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

221 , aggregate

222 , countRows

223 , groupBy

224− , headAgg

225 , listAgg, listAggExpr

224 , listAgg, listAggExpr

226 , nonEmptyAgg, nonEmptyAggExpr

225 , nonEmptyAgg, nonEmptyAggExpr

227 , DBMax, max

226 , DBMax, max

src/Rel8/Aggregate/Legacy.hs+1−8

@@ -14,7 +14,6 @@ module Rel8.Aggregate.Legacy

14 , aggregate

15 , aggregateTabulation

16 , groupBy

17− , headAgg

18 , listAgg

17 , listAgg

19 , nonEmptyAgg

18 , nonEmptyAgg

@@ -37,7 +36,6 @@ import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )

37import Rel8.Expr ( Col( E ), Expr )

36import Rel8.Expr ( Col( E ), Expr )

38import Rel8.Expr.Aggregate

37import Rel8.Expr.Aggregate

39 ( groupByExpr

38 ( groupByExpr

40− , headAggExpr

41 , slistAggExpr

39 , slistAggExpr

42 , snonEmptyAggExpr

40 , snonEmptyAggExpr

43 )

41 )

@@ -47,7 +45,7 @@ import Rel8.Kind.Algebra ( Algebra( Sum ) )

47import Rel8.Query ( Query )

45import Rel8.Query ( Query )

48import Rel8.Query.Opaleye ( mapOpaleye )

46import Rel8.Query.Opaleye ( mapOpaleye )

49import Rel8.Schema.Dict ( Dict( Dict ) )

47import Rel8.Schema.Dict ( Dict( Dict ) )

50−import Rel8.Schema.HTable ( hmap, hfield, htabulate )

48+import Rel8.Schema.HTable ( hfield, htabulate )

51import Rel8.Schema.HTable.Vectorize ( hvectorize )

49import Rel8.Schema.HTable.Vectorize ( hvectorize )

52import Rel8.Schema.Kind ( Rel8able )

50import Rel8.Schema.Kind ( Rel8able )

53import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

51import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

@@ -84,11 +82,6 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

84 E expr -> A $ groupByExpr expr

82 E expr -> A $ groupByExpr expr

87−-- | Keep only the first row's values.

88−headAgg :: Aggregates aggregates exprs => exprs -> aggregates

89−headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns

90−

91−

92-- | Aggregate rows into a single row containing an array of all aggregated

85-- | Aggregate rows into a single row containing an array of all aggregated

93-- rows. This can be used to associate multiple rows with a single row, without

86-- rows. This can be used to associate multiple rows with a single row, without

94-- changing the over cardinality of the query. This allows you to essentially

87-- changing the over cardinality of the query. This allows you to essentially

src/Rel8/Expr/Aggregate.hs−15

@@ -12,7 +12,6 @@ module Rel8.Expr.Aggregate

12 , sum, sumWhere

13 , stringAgg

14 , groupByExpr

15− , headAggExpr

16 , listAggExpr, nonEmptyAggExpr

15 , listAggExpr, nonEmptyAggExpr

17 , slistAggExpr, snonEmptyAggExpr

16 , slistAggExpr, snonEmptyAggExpr

18 )

17 )

@@ -156,20 +155,6 @@ groupByExpr :: Sql DBEq a => Expr a -> Aggregate (Expr a)

156groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

155groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

157

156

158

157

159−-- | Keep only the first value.

160−headAggExpr :: Expr a -> Aggregate (Expr a)

161−headAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

162− Aggregator

163− { operation = Opaleye.AggrArr

164− , ordering = []

165− , distinction = Opaleye.AggrAll

166− }

167− where

168− from = fromPrimExpr . flip Opaleye.ArrayIndex one

169− where

170− one = Opaleye.ConstExpr (Opaleye.NumericLit 1)

171−

172−

173-- | Collect expressions values as a list.

158-- | Collect expressions values as a list.

174listAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr [a])

159listAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr [a])

175listAggExpr = slistAggExpr typeInformation

160listAggExpr = slistAggExpr typeInformation

src/Rel8/Table/Aggregate.hs+1−8

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

8module Rel8.Table.Aggregate

9 ( groupBy

10− , headAgg

11 , listAgg, nonEmptyAgg

10 , listAgg, nonEmptyAgg

12 )

11 )

13where

12where

@@ -21,12 +20,11 @@ import Rel8.Aggregate ( Aggregate, Col( A ) )

21import Rel8.Expr ( Expr, Col( E ) )

20import Rel8.Expr ( Expr, Col( E ) )

22import Rel8.Expr.Aggregate

21import Rel8.Expr.Aggregate

23 ( groupByExpr

22 ( groupByExpr

24− , headAggExpr

25 , slistAggExpr

23 , slistAggExpr

26 , snonEmptyAggExpr

24 , snonEmptyAggExpr

27 )

25 )

28import Rel8.Schema.Dict ( Dict( Dict ) )

26import Rel8.Schema.Dict ( Dict( Dict ) )

29−import Rel8.Schema.HTable ( hfield, hmap, htabulate )

27+import Rel8.Schema.HTable ( hfield, htabulate )

30import Rel8.Schema.HTable.Vectorize ( hvectorize )

28import Rel8.Schema.HTable.Vectorize ( hvectorize )

31import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

29import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

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

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

@@ -44,11 +42,6 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

44 E expr -> A $ groupByExpr expr

42 E expr -> A $ groupByExpr expr

47−-- | Keep only the first row.

48−headAgg :: Table Expr a => a -> Aggregate a

49−headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns

50−

51−

52-- | Aggregate rows into a single row containing an array of all aggregated

45-- | Aggregate rows into a single row containing an array of all aggregated

53-- rows. This can be used to associate multiple rows with a single row, without

46-- rows. This can be used to associate multiple rows with a single row, without

54-- changing the over cardinality of the query. This allows you to essentially

47-- changing the over cardinality of the query. This allows you to essentially

src/Rel8/Tabulate.hs+19−11

@@ -26,7 +26,7 @@ module Rel8.Tabulate

26 , difference

27 , aggregateTabulation

28 , orderTabulation

29− , singularize

29+ , distinctTabulation

30 , optionalTabulation

31 , manyTabulation

32 , someTabulation

@@ -48,13 +48,14 @@ import Rel8.Expr ( Expr )

48import Rel8.Order ( Order )

49import Rel8.Query ( Query )

50import Rel8.Query.Aggregate ( aggregate )

51+import Rel8.Query.Distinct ( distinctOn )

51import Rel8.Query.Exists ( withBy, withoutBy )

52import Rel8.Query.Exists ( withBy, withoutBy )

52import Rel8.Query.Filter ( filter, where_ )

53import Rel8.Query.Filter ( filter, where_ )

53import Rel8.Query.Maybe ( optional )

54import Rel8.Query.Maybe ( optional )

54import Rel8.Query.Order ( orderBy )

55import Rel8.Query.Order ( orderBy )

55import Rel8.Query.These ( alignBy )

56import Rel8.Query.These ( alignBy )

56import Rel8.Table ( Table )

57import Rel8.Table ( Table )

57−import Rel8.Table.Aggregate ( groupBy, headAgg, listAgg, nonEmptyAgg )

58+import Rel8.Table.Aggregate ( groupBy, listAgg, nonEmptyAgg )

58import Rel8.Table.Alternative

59import Rel8.Table.Alternative

59 ( AltTable, (<|>:)

60 ( AltTable, (<|>:)

60 , AlternativeTable, emptyTable

61 , AlternativeTable, emptyTable

@@ -63,6 +64,8 @@ import Rel8.Table.Eq ( EqTable, (==:) )

63import Rel8.Table.List ( ListTable )

64import Rel8.Table.List ( ListTable )

64import Rel8.Table.Maybe ( MaybeTable, maybeTable )

65import Rel8.Table.Maybe ( MaybeTable, maybeTable )

65import Rel8.Table.NonEmpty ( NonEmptyTable )

66import Rel8.Table.NonEmpty ( NonEmptyTable )

67+import Rel8.Table.Ord ( OrdTable )

68+import Rel8.Table.Order ( ascTable )

66import Rel8.Table.These ( TheseTable, theseTable )

69import Rel8.Table.These ( TheseTable, theseTable )

68-- semigroupoids

71-- semigroupoids

@@ -337,26 +340,26 @@ difference kas kbs = do

337

340

338aggregateTabulation :: EqTable k

341aggregateTabulation :: EqTable k

339 => Tabulation k (Aggregate a) -> Tabulation k a

342 => Tabulation k (Aggregate a) -> Tabulation k a

340−aggregateTabulation kas = do

341− as <- toQuery kas

342− fromQuery $ aggregate $ bitraverse1 groupBy id <$> as

343+aggregateTabulation = mapQuery (aggregate . fmap (bitraverse1 groupBy id))

343

344

345

345−-- | 'orderTabulation' orders the /values/ of a 'Tabulation' (not the keys).

346+-- | 'orderTabulation' orders the /values/ of a 'Tabulation' within each key.

347+--

346-- In general this is meaningless, but if used together with 'manyTabulation'

348-- In general this is meaningless, but if used together with 'manyTabulation'

347-- or 'someTabulation', the resulting lists will be ordered according to

349-- or 'someTabulation', the resulting lists will be ordered according to

348-- ordering given to 'orderTabulation'.

350-- ordering given to 'orderTabulation'.

349−orderTabulation :: Order a -> Tabulation k a -> Tabulation k a

351+orderTabulation :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a

350−orderTabulation ordering (Tabulation as) =

352+orderTabulation ordering = mapQuery $ orderBy ordering'

351− Tabulation $ orderBy (snd >$< ordering) . as

353+ where

354+ ordering' = (fst >$< ascTable) <> (snd >$< ordering)

352

355

353

356

354-- | Turns the given 'Tabulation' from a \"multimap\" into a \"map\". If there

357-- | Turns the given 'Tabulation' from a \"multimap\" into a \"map\". If there

355-- is more than one value at a particular key, only the first one is kept.

358-- is more than one value at a particular key, only the first one is kept.

356-- \"First\" is in general undefined, but 'orderTabulation' can be used to

359-- \"First\" is in general undefined, but 'orderTabulation' can be used to

357-- make it deterministic.

360-- make it deterministic.

358−singularize :: (EqTable k, Table Expr a) => Tabulation k a -> Tabulation k a

361+distinctTabulation :: EqTable k => Tabulation k a -> Tabulation k a

359−singularize = aggregateTabulation . fmap headAgg

362+distinctTabulation = mapQuery (distinctOn fst)

360

363

361

364

362optionalTabulation :: EqTable k

365optionalTabulation :: EqTable k

@@ -380,6 +383,11 @@ someTabulation :: (EqTable k, Table Expr a)

380someTabulation = aggregateTabulation . fmap nonEmptyAgg

383someTabulation = aggregateTabulation . fmap nonEmptyAgg

381

384

382

385

386+mapQuery :: (Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b

387+mapQuery f (Tabulation query) = Tabulation $ \k ->

388+ first Just <$> f (first (fromMaybe k) <$> query k)

389+

390+

383toQuery :: Tabulation k a -> Tabulation k (Query (k, a))

391toQuery :: Tabulation k a -> Tabulation k (Query (k, a))

384toQuery (Tabulation as) = Tabulation $ \k ->

392toQuery (Tabulation as) = Tabulation $ \k ->

385 pure (Nothing, first (fromMaybe k) <$> as k)

393 pure (Nothing, first (fromMaybe k) <$> as k)