Support selecting from table-returning functions with queryFunction (…

…#241)

This fixes #71.

changelog.d/20230711_132805_shane.obrien_query_function.md

@@ -0,0 +1,37 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+<!--
+### Removed
+
+- A bullet item for the Removed category.
+
+-->
+### Added
+
+- Added `queryFunction` for `SELECT`ing from table-returning functions such as `jsonb_to_recordset`.
+
+<!--
+### Changed
+
+- A bullet item for the Changed category.
+
+-->
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+### Fixed
+
+- Fixes [#71](https://github.com/circuithub/rel8/issues/71).
+
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

rel8.cabal

@@ -29,7 +29,7 @@ library
     , contravariant
     , hasql ^>= 1.6.1.2
     , network-ip
-    , opaleye ^>= 0.9.7.0
+    , opaleye ^>= 0.10.0.0
     , pretty
     , profunctors
     , product-profunctors
@@ -116,6 +116,7 @@ library
     Rel8.Query.Evaluate
     Rel8.Query.Exists
     Rel8.Query.Filter
+    Rel8.Query.Function
     Rel8.Query.Indexed
     Rel8.Query.Limit
     Rel8.Query.List

src/Rel8.hs

@@ -201,6 +201,7 @@ module Rel8
   , Arguments
   , function
   , binaryOperator
+  , queryFunction
 
     -- * Queries
   , Query
@@ -408,6 +409,7 @@ import Rel8.Query.Either
 import Rel8.Query.Evaluate
 import Rel8.Query.Exists
 import Rel8.Query.Filter
+import Rel8.Query.Function
 import Rel8.Query.Indexed
 import Rel8.Query.Limit
 import Rel8.Query.List

src/Rel8/Expr/Function.hs

@@ -7,7 +7,9 @@
 {-# language UndecidableInstances #-}
 
 module Rel8.Expr.Function
-  ( Arguments, function
+  ( Arguments
+  , function
+  , primFunction
   , binaryOperator
   )
 where
@@ -52,7 +54,12 @@ instance {-# OVERLAPS #-} Arguments () where
 -- the arguments @arguments@ returning an @'Expr' a@.
 function :: (Arguments arguments, Sql DBType a)
   => QualifiedName -> arguments -> Expr a
-function qualified = castExpr . fromPrimExpr . Opaleye.FunExpr name . arguments
+function qualified = castExpr . fromPrimExpr . primFunction qualified
+
+
+primFunction :: Arguments arguments
+  => QualifiedName -> arguments -> Opaleye.PrimExpr
+primFunction qualified = Opaleye.FunExpr name . arguments
   where
     name = show (ppQualifiedName qualified)
 

src/Rel8/Query/Function.hs

@@ -0,0 +1,32 @@
+{-# language FlexibleContexts #-}
+{-# language MonoLocalBinds #-}
+
+module Rel8.Query.Function
+  ( queryFunction
+  )
+where
+
+-- base
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Internal.Operators as Opaleye
+
+-- rel8
+import Rel8.Expr (Expr)
+import Rel8.Expr.Function (Arguments, primFunction)
+import Rel8.Query (Query)
+import Rel8.Query.Opaleye (fromOpaleye)
+import Rel8.Schema.QualifiedName (QualifiedName)
+import Rel8.Table (Table)
+import Rel8.Table.Opaleye (castTable, relExprPP)
+
+
+-- | Select each row from a function that returns a relation. This is
+-- equivalent to @FROM function(input)@.
+queryFunction :: (Arguments input, Table Expr output)
+  => QualifiedName -> input -> Query output
+queryFunction name input = fmap castTable $ fromOpaleye $
+  Opaleye.relationValuedExprExplicit relExprPP (const expr)
+  where
+    expr = primFunction name input

src/Rel8/Table/Opaleye.hs

@@ -16,6 +16,7 @@ module Rel8.Table.Opaleye
   , exprs
   , exprsWithNames
   , ifPP
+  , relExprPP
   , table
   , tableFields
   , unpackspec
@@ -34,6 +35,7 @@ import Prelude
 import qualified Opaleye.Adaptors as Opaleye
 import qualified Opaleye.Field as Opaleye ( Field_ )
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
+import qualified Opaleye.Internal.Operators as Opaleye
 import qualified Opaleye.Internal.Values as Opaleye
 import qualified Opaleye.Table as Opaleye
 
@@ -100,6 +102,10 @@ ifPP :: Table Expr a => Opaleye.IfPP a a
 ifPP = fromOpaleyespec Opaleye.ifPPField
 
 
+relExprPP :: Table Expr a => Opaleye.RelExprPP a a
+relExprPP = fromOpaleyespec Opaleye.relExprColumn
+
+
 table :: Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs
 table (TableSchema (QualifiedName name schema) columns) =
   case schema of
@@ -128,7 +134,8 @@ unpackspec = fromOpaleyespec Opaleye.unpackspecField
 valuesspec :: Table Expr a => Opaleye.Valuesspec a a
 valuesspec = dimap toColumns fromColumns $
   htraversePWithField (traverseFieldP . Opaleye.valuesspecFieldType . typeName)
-  where typeName = Rel8.Type.Information.typeName . info . hfield hspecs
+  where
+    typeName = Rel8.Type.Information.typeName . info . hfield hspecs
 
 
 view :: Selects names exprs => names -> exprs