Add length{,1} functions for getting the length of `{List,NonEmpty}…

…Table`s (#268)

changelog.d/20230707_185339_ollie_scriv.md

@@ -1,3 +1,3 @@
 ### Added
 
-- `Rel8.head`, `Rel8.headTable`, `Rel8.last`, `Rel8.lastExpr` for accessing the first/last elements of arrays and `ListTable`s. We have also added variants for non-empty arrays/`NonEmptyTable` with the `1` suffix (e.g., `head1`). ([#245](https://github.com/circuithub/rel8/pull/245))
+- `Rel8.head`, `Rel8.headExpr`, `Rel8.last`, `Rel8.lastExpr` for accessing the first/last elements of `ListTable`s and arrays. We have also added variants for `NonEmptyTable`s/non-empty arrays with the `1` suffix (e.g., `head1`). ([#245](https://github.com/circuithub/rel8/pull/245))

changelog.d/20230815_190143_shane.obrien_array_length.md

@@ -0,0 +1,3 @@
+### Added
+
+- `Rel8.length` and `Rel8.lengthExpr` for getting the length `ListTable`s and arrays. We have also added variants for `NonEmptyTable`s/non-empty arrays with the `1` suffix (e.g., `length1`).

src/Rel8.hs

@@ -105,6 +105,8 @@ module Rel8
   , headExpr
   , last
   , lastExpr
+  , length
+  , lengthExpr
 
     -- ** @NonEmptyTable@
   , NonEmptyTable
@@ -118,6 +120,8 @@ module Rel8
   , head1Expr
   , last1
   , last1Expr
+  , length1
+  , length1Expr
 
     -- ** @NullTable@
   , NullTable

src/Rel8/Expr/Array.hs

@@ -12,22 +12,19 @@ module Rel8.Expr.Array
 where
 
 -- base
-import Data.List.NonEmpty ( NonEmpty )
+import Data.List.NonEmpty (NonEmpty)
 import Prelude
 
 -- opaleye
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
 -- rel8
 import {-# SOURCE #-} Rel8.Expr ( Expr )
-import Rel8.Expr.Opaleye
-  ( fromPrimExpr, toPrimExpr
-  , zipPrimExprsWith
-  )
+import Rel8.Expr.Opaleye (fromPrimExpr, toPrimExpr, zipPrimExprsWith)
 import Rel8.Type ( DBType, typeInformation )
-import Rel8.Type.Array ( array )
+import Rel8.Type.Array (array)
 import Rel8.Type.Information ( TypeInformation(..) )
-import Rel8.Schema.Null ( Unnullify, Sql )
+import Rel8.Schema.Null (Unnullify, Sql)
 
 
 sappend :: Expr [a] -> Expr [a] -> Expr [a]

src/Rel8/Expr/List.hs

@@ -1,38 +1,42 @@
+{-# language FlexibleContexts #-}
+{-# language MonoLocalBinds #-}
+
 module Rel8.Expr.List (
   headExpr,
-  indexExpr,
   lastExpr,
+  sheadExpr,
+  slastExpr,
+  lengthExpr,
 ) where
 
 -- base
-import Data.Int (Int64)
+import Data.Int (Int32)
 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)
+import Rel8.Schema.Null (Nullify, Sql, Unnullify)
+import Rel8.Type (DBType, typeInformation)
+import Rel8.Type.Information (TypeInformation)
+import qualified Rel8.Type.Array as Prim
+
+
+headExpr :: Sql DBType a => Expr [a] -> Expr (Nullify a)
+headExpr = sheadExpr typeInformation
+
+
+lastExpr :: Sql DBType a => Expr [a] -> Expr (Nullify a)
+lastExpr = slastExpr typeInformation
 
 
-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)
+sheadExpr :: TypeInformation (Unnullify a) -> Expr [a] -> Expr (Nullify a)
+sheadExpr info = fromPrimExpr . Prim.head info . toPrimExpr
 
 
-indexExpr :: Expr [a] -> Expr Int64 -> Expr (Nullify a)
-indexExpr array index =
-  fromPrimExpr (Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr index))
+slastExpr :: TypeInformation (Unnullify a) -> Expr [a] -> Expr (Nullify a)
+slastExpr info = fromPrimExpr . Prim.last info . toPrimExpr
 
 
-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)
+lengthExpr :: Expr [a] -> Expr Int32
+lengthExpr = fromPrimExpr . Prim.length . toPrimExpr

src/Rel8/Expr/NonEmpty.hs

@@ -1,39 +1,43 @@
+{-# language FlexibleContexts #-}
+{-# language MonoLocalBinds #-}
+
 module Rel8.Expr.NonEmpty (
   head1Expr,
-  index1Expr,
   last1Expr,
+  shead1Expr,
+  slast1Expr,
+  length1Expr,
 ) where
 
 -- base
-import Data.Int (Int64)
+import Data.Int (Int32)
 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)
+import Rel8.Schema.Null (Sql, Unnullify)
+import Rel8.Type (DBType, typeInformation)
+import Rel8.Type.Information (TypeInformation)
+import qualified Rel8.Type.Array as Prim
+
+
+head1Expr :: Sql DBType a => Expr (NonEmpty a) -> Expr a
+head1Expr = shead1Expr typeInformation
+
+
+last1Expr :: Sql DBType a => Expr (NonEmpty a) -> Expr a
+last1Expr = slast1Expr typeInformation
 
 
-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)
+shead1Expr :: TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a
+shead1Expr info = fromPrimExpr . Prim.head info . toPrimExpr
 
 
-index1Expr :: Expr (NonEmpty a) -> Expr Int64 -> Expr (Nullify a)
-index1Expr array index =
-  fromPrimExpr (Opaleye.ArrayIndex (toPrimExpr array) (toPrimExpr index))
+slast1Expr :: TypeInformation (Unnullify a) -> Expr (NonEmpty a) -> Expr a
+slast1Expr info = fromPrimExpr . Prim.last info . toPrimExpr
 
 
-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)
+length1Expr :: Expr (NonEmpty a) -> Expr Int32
+length1Expr = fromPrimExpr . Prim.length . toPrimExpr

src/Rel8/Schema/HTable/Vectorize.hs

@@ -2,8 +2,9 @@
 {-# language ConstraintKinds #-}
 {-# language DataKinds #-}
 {-# language DeriveAnyClass #-}
+{-# language DeriveFunctor #-}
 {-# language DeriveGeneric #-}
-{-# language DerivingStrategies #-}
+{-# language DerivingVia #-}
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language GADTs #-}
@@ -25,12 +26,14 @@ module Rel8.Schema.HTable.Vectorize
   , happend, hempty
   , hproject
   , hcolumn
+  , First (..)
   )
 where
 
 -- base
 import Data.Kind ( Constraint, Type )
 import Data.List.NonEmpty ( NonEmpty )
+import qualified Data.Semigroup as Base
 import GHC.Generics (Generic)
 import Prelude
 
@@ -55,7 +58,8 @@ import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )
 import Rel8.Type.Information ( TypeInformation )
 
 -- semialign
-import Data.Zip ( Unzip, Zip, Zippy(..) )
+import Data.Align (Semialign, alignWith)
+import Data.Zip (Unzip, Zip, Zippy(..), zipWith)
 
 -- semigroupoids
 import Data.Functor.Apply (Apply)
@@ -169,3 +173,16 @@ hnullify f (HVectorize table) = HNullify $
   htabulate $ \(HMapTableField field) -> case hfield hspecs field of
     spec -> case hfield table (HMapTableField field) of
       a -> f spec a
+
+
+newtype First a b = First {getFirst :: a}
+  deriving stock Functor
+  deriving (Semigroup) via (Base.First a)
+
+
+instance Semialign (First a) where
+  alignWith _ (First a) _ = First a
+
+
+instance Zip (First a) where
+  zipWith _ (First a) _ = First a

src/Rel8/Table/List.hs

@@ -17,25 +17,28 @@ module Rel8.Table.List
   , nameListTable
   , head
   , last
+  , length
   )
 where
 
 -- base
 import Data.Functor.Identity (Identity (Identity))
+import Data.Int (Int32)
 import Data.Kind ( Type )
-import Prelude hiding (head, last)
+import Prelude hiding (head, last, length)
 
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Array ( sappend, sempty, slistOf )
-import Rel8.Expr.List (headExpr, lastExpr)
+import Rel8.Expr.List (lengthExpr, sheadExpr, slastExpr)
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.List ( HListTable )
 import Rel8.Schema.HTable.Vectorize
   ( hvectorize, hunvectorize
   , hnullify
   , happend, hempty
   , hproject, hcolumn
+  , First (..)
   )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name( Name ) )
@@ -159,13 +162,21 @@ nameListTable =
 head :: Table Expr a => ListTable Expr a -> NullTable Expr a
 head =
   fromColumns .
-  hnullify (const headExpr) .
+  hnullify (\Spec {info} -> sheadExpr info) .
   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) .
+  hnullify (\Spec {info} -> slastExpr info) .
+  toColumns
+
+
+-- | Get the length of a 'ListTable'
+length :: Table Expr a => ListTable Expr a -> Expr Int32
+length =
+  getFirst .
+  hunvectorize (\_ -> First . lengthExpr) .
   toColumns

src/Rel8/Table/NonEmpty.hs

@@ -17,25 +17,28 @@ module Rel8.Table.NonEmpty
   , nameNonEmptyTable
   , head1
   , last1
+  , length1
   )
 where
 
 -- base
 import Data.Functor.Identity (Identity (Identity), runIdentity)
+import Data.Int (Int32)
 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.Expr.NonEmpty (length1Expr, shead1Expr, slast1Expr)
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
 import Rel8.Schema.HTable.Vectorize
   ( hvectorize, hunvectorize
   , happend
   , hproject, hcolumn
+  , First (..)
   )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name( Name ) )
@@ -152,7 +155,7 @@ head1 :: Table Expr a => NonEmptyTable Expr a -> a
 head1 =
   fromColumns .
   runIdentity .
-  hunvectorize (\_ -> Identity . head1Expr) .
+  hunvectorize (\Spec {info} -> Identity . shead1Expr info) .
   toColumns
 
 
@@ -161,5 +164,13 @@ last1 :: Table Expr a => NonEmptyTable Expr a -> a
 last1 =
   fromColumns .
   runIdentity .
-  hunvectorize (\_ -> Identity . last1Expr) .
+  hunvectorize (\Spec {info} -> Identity . slast1Expr info) .
+  toColumns
+
+
+-- | Get the length of a 'NonEmptyTable'
+length1 :: Table Expr a => NonEmptyTable Expr a -> Expr Int32
+length1 =
+  getFirst .
+  hunvectorize (\_ -> First . length1Expr) .
   toColumns

src/Rel8/Type/Array.hs

@@ -9,13 +9,14 @@ module Rel8.Type.Array
   ( array, encodeArrayElement, extractArrayElement
   , listTypeInformation
   , nonEmptyTypeInformation
+  , head, last, length
   )
 where
 
 -- base
 import Data.Foldable ( toList )
 import Data.List.NonEmpty ( NonEmpty, nonEmpty )
-import Prelude hiding ( null, repeat, zipWith )
+import Prelude hiding ( head, last, length, null, repeat, zipWith )
 
 -- hasql
 import qualified Hasql.Decoders as Hasql
@@ -126,3 +127,31 @@ extractArrayElement info
                 where
                   pattern = string [char, char]
                   replacement = string [char]
+
+
+head :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
+head info a = extractArrayElement info $ index (lower a) a
+
+
+last :: TypeInformation a -> Opaleye.PrimExpr -> Opaleye.PrimExpr
+last info a = extractArrayElement info $ index (upper a) a
+
+
+index :: Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr
+index i a = Opaleye.ArrayIndex a i
+
+
+lower :: Opaleye.PrimExpr -> Opaleye.PrimExpr
+lower a = Opaleye.FunExpr "array_lower" [a, one]
+
+
+upper :: Opaleye.PrimExpr -> Opaleye.PrimExpr
+upper a = Opaleye.FunExpr "array_lower" [a, one]
+
+
+length :: Opaleye.PrimExpr -> Opaleye.PrimExpr
+length a = Opaleye.FunExpr "array_length" [a, one]
+
+
+one :: Opaleye.PrimExpr
+one = Opaleye.ConstExpr (Opaleye.IntegerLit 1)