Rename singularize to distinctTabulation and implement in terms of distinctOn

This also means we can delete `headAgg`.

src/Rel8.hs

@@ -221,7 +221,6 @@ module Rel8
   , aggregate
   , countRows
   , groupBy
-  , headAgg
   , listAgg, listAggExpr
   , nonEmptyAgg, nonEmptyAggExpr
   , DBMax, max

src/Rel8/Aggregate/Legacy.hs

@@ -14,7 +14,6 @@ module Rel8.Aggregate.Legacy
   , aggregate
   , aggregateTabulation
   , groupBy
-  , headAgg
   , listAgg
   , nonEmptyAgg
 
@@ -37,7 +36,6 @@ import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )
 import Rel8.Expr ( Col( E ), Expr )
 import Rel8.Expr.Aggregate
   ( groupByExpr
-  , headAggExpr
   , slistAggExpr
   , snonEmptyAggExpr
   )
@@ -47,7 +45,7 @@ import Rel8.Kind.Algebra ( Algebra( Sum ) )
 import Rel8.Query ( Query )
 import Rel8.Query.Opaleye ( mapOpaleye )
 import Rel8.Schema.Dict ( Dict( Dict ) )
-import Rel8.Schema.HTable ( hmap, hfield, htabulate )
+import Rel8.Schema.HTable ( hfield, htabulate )
 import Rel8.Schema.HTable.Vectorize ( hvectorize )
 import Rel8.Schema.Kind ( Rel8able )
 import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
@@ -84,11 +82,6 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
       E expr -> A $ groupByExpr expr
 
 
--- | Keep only the first row's values.
-headAgg :: Aggregates aggregates exprs => exprs -> aggregates
-headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns
-
-
 -- | Aggregate rows into a single row containing an array of all aggregated
 -- rows. This can be used to associate multiple rows with a single row, without
 -- changing the over cardinality of the query. This allows you to essentially

src/Rel8/Expr/Aggregate.hs

@@ -12,7 +12,6 @@ module Rel8.Expr.Aggregate
   , sum, sumWhere
   , stringAgg
   , groupByExpr
-  , headAggExpr
   , listAggExpr, nonEmptyAggExpr
   , slistAggExpr, snonEmptyAggExpr
   )
@@ -156,20 +155,6 @@ groupByExpr :: Sql DBEq a => Expr a -> Aggregate (Expr a)
 groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing
 
 
--- | Keep only the first value.
-headAggExpr :: Expr a -> Aggregate (Expr a)
-headAggExpr = unsafeMakeAggregate toPrimExpr from $ Just
-  Aggregator
-    { operation = Opaleye.AggrArr
-    , ordering = []
-    , distinction = Opaleye.AggrAll
-    }
-  where
-    from = fromPrimExpr . flip Opaleye.ArrayIndex one
-      where
-        one = Opaleye.ConstExpr (Opaleye.NumericLit 1)
-
-
 -- | Collect expressions values as a list.
 listAggExpr :: Sql DBType a => Expr a -> Aggregate (Expr [a])
 listAggExpr = slistAggExpr typeInformation

src/Rel8/Table/Aggregate.hs

@@ -7,7 +7,6 @@
 
 module Rel8.Table.Aggregate
   ( groupBy
-  , headAgg
   , listAgg, nonEmptyAgg
   )
 where
@@ -21,12 +20,11 @@ import Rel8.Aggregate ( Aggregate, Col( A ) )
 import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.Expr.Aggregate
   ( groupByExpr
-  , headAggExpr
   , slistAggExpr
   , snonEmptyAggExpr
   )
 import Rel8.Schema.Dict ( Dict( Dict ) )
-import Rel8.Schema.HTable ( hfield, hmap, htabulate )
+import Rel8.Schema.HTable ( hfield, htabulate )
 import Rel8.Schema.HTable.Vectorize ( hvectorize )
 import Rel8.Schema.Spec ( SSpec( SSpec, info ) )
 import Rel8.Table ( Table, toColumns, fromColumns )
@@ -44,11 +42,6 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
       E expr -> A $ groupByExpr expr
 
 
--- | Keep only the first row.
-headAgg :: Table Expr a => a -> Aggregate a
-headAgg = fromColumns . hmap (\(E a) -> A $ headAggExpr a) . toColumns
-
-
 -- | Aggregate rows into a single row containing an array of all aggregated
 -- rows. This can be used to associate multiple rows with a single row, without
 -- changing the over cardinality of the query. This allows you to essentially

src/Rel8/Tabulate.hs

@@ -26,7 +26,7 @@ module Rel8.Tabulate
   , difference
   , aggregateTabulation
   , orderTabulation
-  , singularize
+  , distinctTabulation
   , optionalTabulation
   , manyTabulation
   , someTabulation
@@ -48,13 +48,14 @@ import Rel8.Expr ( Expr )
 import Rel8.Order ( Order )
 import Rel8.Query ( Query )
 import Rel8.Query.Aggregate ( aggregate )
+import Rel8.Query.Distinct ( distinctOn )
 import Rel8.Query.Exists ( withBy, withoutBy )
 import Rel8.Query.Filter ( filter, where_ )
 import Rel8.Query.Maybe ( optional )
 import Rel8.Query.Order ( orderBy )
 import Rel8.Query.These ( alignBy )
 import Rel8.Table ( Table )
-import Rel8.Table.Aggregate ( groupBy, headAgg, listAgg, nonEmptyAgg )
+import Rel8.Table.Aggregate ( groupBy, listAgg, nonEmptyAgg )
 import Rel8.Table.Alternative
   ( AltTable, (<|>:)
   , AlternativeTable, emptyTable
@@ -63,6 +64,8 @@ import Rel8.Table.Eq ( EqTable, (==:) )
 import Rel8.Table.List ( ListTable )
 import Rel8.Table.Maybe ( MaybeTable, maybeTable )
 import Rel8.Table.NonEmpty ( NonEmptyTable )
+import Rel8.Table.Ord ( OrdTable )
+import Rel8.Table.Order ( ascTable )
 import Rel8.Table.These ( TheseTable, theseTable )
 
 -- semigroupoids
@@ -337,26 +340,26 @@ difference kas kbs = do
 
 aggregateTabulation :: EqTable k
   => Tabulation k (Aggregate a) -> Tabulation k a
-aggregateTabulation kas = do
-  as <- toQuery kas
-  fromQuery $ aggregate $ bitraverse1 groupBy id <$> as
+aggregateTabulation = mapQuery (aggregate . fmap (bitraverse1 groupBy id))
 
 
--- | 'orderTabulation' orders the /values/ of a 'Tabulation' (not the keys).
+-- | 'orderTabulation' orders the /values/ of a 'Tabulation' within each key.
+--
 -- In general this is meaningless, but if used together with 'manyTabulation'
 -- or 'someTabulation', the resulting lists will be ordered according to
 -- ordering given to 'orderTabulation'.
-orderTabulation :: Order a -> Tabulation k a -> Tabulation k a
-orderTabulation ordering (Tabulation as) =
-  Tabulation $ orderBy (snd >$< ordering) . as
+orderTabulation :: OrdTable k => Order a -> Tabulation k a -> Tabulation k a
+orderTabulation ordering = mapQuery $ orderBy ordering'
+  where
+    ordering' = (fst >$< ascTable) <> (snd >$< ordering)
 
 
 -- | Turns the given 'Tabulation' from a \"multimap\" into a \"map\". If there
 -- is more than one value at a particular key, only the first one is kept.
 -- \"First\" is in general undefined, but 'orderTabulation' can be used to
 -- make it deterministic.
-singularize :: (EqTable k, Table Expr a) => Tabulation k a -> Tabulation k a
-singularize = aggregateTabulation . fmap headAgg
+distinctTabulation :: EqTable k => Tabulation k a -> Tabulation k a
+distinctTabulation = mapQuery (distinctOn fst)
 
 
 optionalTabulation :: EqTable k
@@ -380,6 +383,11 @@ someTabulation :: (EqTable k, Table Expr a)
 someTabulation = aggregateTabulation . fmap nonEmptyAgg
 
 
+mapQuery :: (Query (k, a) -> Query (k, b)) -> Tabulation k a -> Tabulation k b
+mapQuery f (Tabulation query) = Tabulation $ \k ->
+  first Just <$> f (first (fromMaybe k) <$> query k)
+
+
 toQuery :: Tabulation k a -> Tabulation k (Query (k, a))
 toQuery (Tabulation as) = Tabulation $ \k ->
   pure (Nothing, first (fromMaybe k) <$> as k)