Add head and last functions for extracting elements of ListTable (#245)

rel8.cabal

@@ -78,6 +78,8 @@ library
     Rel8.Expr.Default
     Rel8.Expr.Eq
     Rel8.Expr.Function
+    Rel8.Expr.List
+    Rel8.Expr.NonEmpty
     Rel8.Expr.Null
     Rel8.Expr.Opaleye
     Rel8.Expr.Ord

src/Rel8.hs

@@ -100,6 +100,10 @@ module Rel8
   , manyExpr
   , catListTable
   , catList
+  , head
+  , headExpr
+  , last
+  , lastExpr
 
     -- ** @NonEmptyTable@
   , NonEmptyTable
@@ -109,6 +113,10 @@ module Rel8
   , someExpr
   , catNonEmptyTable
   , catNonEmpty
+  , head1
+  , head1Expr
+  , last1
+  , last1Expr
 
     -- ** @NullTable@
   , NullTable
@@ -373,6 +381,8 @@ import Rel8.Expr.Bool
 import Rel8.Expr.Default
 import Rel8.Expr.Eq
 import Rel8.Expr.Function
+import Rel8.Expr.List
+import Rel8.Expr.NonEmpty
 import Rel8.Expr.Null
 import Rel8.Expr.Opaleye (unsafeCastExpr, unsafeLiteral)
 import Rel8.Expr.Ord

src/Rel8/Expr/List.hs

@@ -0,0 +1,38 @@
+module Rel8.Expr.List (
+  headExpr,
+  indexExpr,
+  lastExpr,
+) where
+
+-- base
+import Data.Int (Int64)
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
+
+-- rel8
+import Rel8.Expr (Expr)
+import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr)
+import Rel8.Schema.Null (Nullify)
+
+
+headExpr :: Expr [a] -> Expr (Nullify a)
+headExpr array = indexExpr array index
+  where
+    index = fromPrimExpr $ Opaleye.FunExpr "array_lower" [toPrimExpr array, one]
+      where
+        one = Opaleye.ConstExpr (Opaleye.IntegerLit 1)
+
+
+indexExpr :: Expr [a] -> Expr Int64 -> Expr (Nullify a)
+indexExpr array index =
+  fromPrimExpr (Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr index))
+
+
+lastExpr :: Expr [a] -> Expr (Nullify a)
+lastExpr array = indexExpr array index
+  where
+    index = fromPrimExpr $ Opaleye.FunExpr "array_upper" [toPrimExpr array, one]
+      where
+        one = Opaleye.ConstExpr (Opaleye.IntegerLit 1)

src/Rel8/Expr/NonEmpty.hs

@@ -0,0 +1,39 @@
+module Rel8.Expr.NonEmpty (
+  head1Expr,
+  index1Expr,
+  last1Expr,
+) where
+
+-- base
+import Data.Int (Int64)
+import Data.List.NonEmpty (NonEmpty)
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
+
+-- rel8
+import Rel8.Expr (Expr)
+import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr)
+import Rel8.Schema.Null (Nullify)
+
+
+head1Expr :: Expr (NonEmpty a) -> Expr a
+head1Expr array = fromPrimExpr $ toPrimExpr $ index1Expr array index
+  where
+    index = fromPrimExpr $ Opaleye.FunExpr "array_lower" [toPrimExpr array, one]
+      where
+        one = Opaleye.ConstExpr (Opaleye.IntegerLit 1)
+
+
+index1Expr :: Expr (NonEmpty a) -> Expr Int64 -> Expr (Nullify a)
+index1Expr array index =
+  fromPrimExpr (Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr index))
+
+
+last1Expr :: Expr (NonEmpty a) -> Expr a
+last1Expr array = fromPrimExpr $ toPrimExpr $ index1Expr array index
+  where
+    index = fromPrimExpr $ Opaleye.FunExpr "array_upper" [toPrimExpr array, one]
+      where
+        one = Opaleye.ConstExpr (Opaleye.IntegerLit 1)

src/Rel8/Schema/HTable/Vectorize.hs

@@ -9,6 +9,7 @@
 {-# language GADTs #-}
 {-# language LambdaCase #-}
 {-# language MultiParamTypeClasses #-}
+{-# language NamedFieldPuns #-}
 {-# language RankNTypes #-}
 {-# language RecordWildCards #-}
 {-# language ScopedTypeVariables #-}
@@ -20,6 +21,7 @@
 module Rel8.Schema.HTable.Vectorize
   ( HVectorize
   , hvectorize, hvectorizeA, hunvectorize
+  , hnullify
   , happend, hempty
   , hproject
   , hcolumn
@@ -46,7 +48,8 @@ import Rel8.Schema.HTable.MapTable
   , Precompose( Precompose )
   )
 import qualified Rel8.Schema.HTable.MapTable as HMapTable ( hproject )
-import Rel8.Schema.Null ( Unnullify, NotNull, Nullity( NotNull ) )
+import Rel8.Schema.HTable.Nullify (HNullify (HNullify))
+import Rel8.Schema.Null (Nullify, Unnullify, NotNull, Nullity (NotNull))
 import Rel8.Schema.Spec ( Spec(..) )
 import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
 import Rel8.Type.Information ( TypeInformation )
@@ -156,3 +159,13 @@ 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
+
+
+hnullify :: forall t list context. (HTable t, Vector list)
+  => (forall a. Spec a -> context (list a) -> context (Nullify a))
+  -> HVectorize list t context
+  -> HNullify t context
+hnullify f (HVectorize table) = HNullify $
+  htabulate $ \(HMapTableField field) -> case hfield hspecs field of
+    spec -> case hfield table (HMapTableField field) of
+      a -> f spec a

src/Rel8/Table/List.hs

@@ -15,21 +15,25 @@ module Rel8.Table.List
   , ($*)
   , listTable
   , nameListTable
+  , head
+  , last
   )
 where
 
 -- base
-import Data.Functor.Identity ( Identity( Identity ) )
+import Data.Functor.Identity (Identity (Identity))
 import Data.Kind ( Type )
-import Prelude
+import Prelude hiding (head, last)
 
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Array ( sappend, sempty, slistOf )
+import Rel8.Expr.List (headExpr, lastExpr)
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.List ( HListTable )
 import Rel8.Schema.HTable.Vectorize
   ( hvectorize, hunvectorize
+  , hnullify
   , happend, hempty
   , hproject, hcolumn
   )
@@ -48,6 +52,7 @@ import Rel8.Table.Alternative
   , AlternativeTable, emptyTable
   )
 import Rel8.Table.Eq ( EqTable, eqTable )
+import Rel8.Table.Null (NullTable)
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Projection
   ( Projectable, Projecting, Projection, project, apply
@@ -148,3 +153,19 @@ nameListTable =
   hvectorize (\_ (Identity (Name a)) -> Name a) .
   pure .
   toColumns
+
+
+-- | Get the first element of a 'ListTable' (or 'Rel8.nullTable' if empty).
+head :: Table Expr a => ListTable Expr a -> NullTable Expr a
+head =
+  fromColumns .
+  hnullify (const headExpr) .
+  toColumns
+
+
+-- | Get the last element of a 'ListTable' (or 'Rel8.nullTable' if empty).
+last :: Table Expr a => ListTable Expr a -> NullTable Expr a
+last =
+  fromColumns .
+  hnullify (const lastExpr) .
+  toColumns

src/Rel8/Table/NonEmpty.hs

@@ -15,18 +15,21 @@ module Rel8.Table.NonEmpty
   , ($+)
   , nonEmptyTable
   , nameNonEmptyTable
+  , head1
+  , last1
   )
 where
 
 -- base
-import Data.Functor.Identity ( Identity( Identity ) )
+import Data.Functor.Identity (Identity (Identity), runIdentity)
 import Data.Kind ( Type )
 import Data.List.NonEmpty ( NonEmpty )
 import Prelude hiding ( id )
 
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Array ( sappend1, snonEmptyOf )
+import Rel8.Expr.NonEmpty (head1Expr, last1Expr)
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
 import Rel8.Schema.HTable.Vectorize
@@ -142,3 +145,21 @@ nameNonEmptyTable =
   hvectorize (\_ (Identity (Name a)) -> Name a) .
   pure .
   toColumns
+
+
+-- | Get the first element of a 'NonEmptyTable'.
+head1 :: Table Expr a => NonEmptyTable Expr a -> a
+head1 =
+  fromColumns .
+  runIdentity .
+  hunvectorize (\_ -> Identity . head1Expr) .
+  toColumns
+
+
+-- | Get the last element of a 'NonEmptyTable'.
+last1 :: Table Expr a => NonEmptyTable Expr a -> a
+last1 =
+  fromColumns .
+  runIdentity .
+  hunvectorize (\_ -> Identity . last1Expr) .
+  toColumns