Project individual columns out of ListTable and NonEmptyTable (#125)

Changelog.md

@@ -1,3 +1,7 @@
+# Unreleased
+
+  New `$*` and `$+` operators for projecting out of `ListTable` and `NonEmptyTable` respectively (analogous to the existing `$?` for `MaybeTable`).
+
 # 1.1.0.0 (2021-07-16)
 
 ## New features

src/Rel8.hs

@@ -90,7 +90,7 @@ module Rel8
 
     -- ** @ListTable@
   , ListTable
-  , listTable
+  , listTable, ($*)
   , nameListTable
   , many
   , manyExpr
@@ -99,7 +99,7 @@ module Rel8
 
     -- ** @NonEmptyTable@
   , NonEmptyTable
-  , nonEmptyTable
+  , nonEmptyTable, ($+)
   , nameNonEmptyTable
   , some
   , someExpr

src/Rel8/Schema/HTable/Vectorize.hs

@@ -22,6 +22,7 @@ module Rel8.Schema.HTable.Vectorize
   , hvectorize, hunvectorize
   , happend, hempty
   , hproject
+  , hcolumn
   )
 where
 
@@ -36,9 +37,11 @@ import Rel8.FCF ( Eval, Exp )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.HTable ( HTable, hfield, htabulate, htabulateA, hspecs )
+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
 import Rel8.Schema.HTable.MapTable
-  ( HMapTable, HMapTableField( HMapTableField )
+  ( HMapTable( HMapTable ), HMapTableField( HMapTableField )
   , MapSpec, mapInfo
+  , Precompose( Precompose )
   )
 import qualified Rel8.Schema.HTable.MapTable as HMapTable ( hproject )
 import Rel8.Schema.Null ( Unnullify, NotNull, Nullity( NotNull ) )
@@ -133,3 +136,7 @@ hproject :: ()
   => (forall ctx. t ctx -> t' ctx)
   -> HVectorize list t context -> HVectorize list t' context
 hproject f (HVectorize a) = HVectorize (HMapTable.hproject f a)
+
+
+hcolumn :: HVectorize list (HIdentity a) context -> context (list a)
+hcolumn (HVectorize (HMapTable (HIdentity (Precompose a)))) = a

src/Rel8/Table/List.hs

@@ -11,7 +11,9 @@
 
 module Rel8.Table.List
   ( ListTable(..)
-  , listTable, nameListTable
+  , ($*)
+  , listTable
+  , nameListTable
   )
 where
 
@@ -28,7 +30,7 @@ import Rel8.Schema.HTable.List ( HListTable )
 import Rel8.Schema.HTable.Vectorize
   ( hvectorize, hunvectorize
   , happend, hempty
-  , hproject
+  , hproject, hcolumn
   )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name( Name ) )
@@ -46,7 +48,9 @@ import Rel8.Table.Alternative
   )
 import Rel8.Table.Eq ( EqTable, eqTable )
 import Rel8.Table.Ord ( OrdTable, ordTable )
-import Rel8.Table.Projection ( Projectable, project, apply )
+import Rel8.Table.Projection
+  ( Projectable, Projecting, Projection, project, apply
+  )
 import Rel8.Table.Serialize ( ToExprs )
 
 
@@ -116,6 +120,13 @@ instance (context ~ Expr, Table Expr a) =>
   mempty = ListTable $ hempty $ \Spec {info} -> sempty info
 
 
+-- | Project a single expression out of a 'ListTable'.
+($*) :: Projecting a (Expr b)
+  => Projection a (Expr b) -> ListTable Expr a -> Expr [b]
+f $* ListTable a = hcolumn $ hproject (apply f) a
+infixl 4 $*
+
+
 -- | Construct a @ListTable@ from a list of expressions.
 listTable :: Table Expr a => [a] -> ListTable Expr a
 listTable =

src/Rel8/Table/NonEmpty.hs

@@ -11,7 +11,9 @@
 
 module Rel8.Table.NonEmpty
   ( NonEmptyTable(..)
-  , nonEmptyTable, nameNonEmptyTable
+  , ($+)
+  , nonEmptyTable
+  , nameNonEmptyTable
   )
 where
 
@@ -29,7 +31,7 @@ import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
 import Rel8.Schema.HTable.Vectorize
   ( hvectorize, hunvectorize
   , happend
-  , hproject
+  , hproject, hcolumn
   )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name( Name ) )
@@ -44,7 +46,9 @@ import Rel8.Table
 import Rel8.Table.Alternative ( AltTable, (<|>:) )
 import Rel8.Table.Eq ( EqTable, eqTable )
 import Rel8.Table.Ord ( OrdTable, ordTable )
-import Rel8.Table.Projection ( Projectable, project, apply )
+import Rel8.Table.Projection
+  ( Projectable, Projecting, Projection, project, apply
+  )
 import Rel8.Table.Serialize ( ToExprs )
 
 
@@ -110,6 +114,13 @@ instance (Table Expr a, context ~ Expr) => Semigroup (NonEmptyTable context a)
     happend (const sappend1) as bs
 
 
+-- | Project a single expression out of a 'NonEmptyTable'.
+($+) :: Projecting a (Expr b)
+  => Projection a (Expr b) -> NonEmptyTable Expr a -> Expr (NonEmpty b)
+f $+ NonEmptyTable a = hcolumn $ hproject (apply f) a
+infixl 4 $+
+
+
 -- | Construct a @NonEmptyTable@ from a non-empty list of expressions.
 nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable Expr a
 nonEmptyTable =