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.
+
+-->

flake.lock

@@ -105,11 +105,11 @@
         "systems": "systems"
       },
       "locked": {
-        "lastModified": 1687709756,
-        "narHash": "sha256-Y5wKlQSkgEK2weWdOu4J3riRd+kV/VCgHsqLNTTWQ/0=",
+        "lastModified": 1689068808,
+        "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "dbabf0ca0c0c4bce6ea5eaf65af5cb694d2082c7",
+        "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4",
         "type": "github"
       },
       "original": {
@@ -154,11 +154,11 @@
     "hackage": {
       "flake": false,
       "locked": {
-        "lastModified": 1688689629,
-        "narHash": "sha256-hNkTA2oaMSnhkvSFnOc76yN0CUl+EyHbxLXFPOJhOlk=",
+        "lastModified": 1689035195,
+        "narHash": "sha256-7riFea4N1ubgzTStbS6Cgx/rDDyHC2e+6IPfqwEtWpM=",
         "owner": "input-output-hk",
         "repo": "hackage.nix",
-        "rev": "902793475a701a03a31411381ee17a6885b76c0b",
+        "rev": "85426e6329d6b163d17bd615315c2a24ba469e59",
         "type": "github"
       },
       "original": {
@@ -198,11 +198,11 @@
         "stackage": "stackage"
       },
       "locked": {
-        "lastModified": 1688713029,
-        "narHash": "sha256-bK2RwnBLaJgtXYwPfpWL3XQJwlRkOimhsieg13Ve5bM=",
+        "lastModified": 1689036680,
+        "narHash": "sha256-VdKBo/E7QTFjmzTfz9e4XPspTjE7EHoQSInAIXm9PMw=",
         "owner": "input-output-hk",
         "repo": "haskell.nix",
-        "rev": "f629a8abac1bbb2168c1c763b9a80effef7156ea",
+        "rev": "c9a78e1d2ce5b0b9b753d12a0175534f98dee485",
         "type": "github"
       },
       "original": {
@@ -231,16 +231,16 @@
     "hls-2.0": {
       "flake": false,
       "locked": {
-        "lastModified": 1684398654,
-        "narHash": "sha256-RW44up2BIyBBYN6tZur5f9kDDR3kr0Rd+TgPbLTfwB4=",
+        "lastModified": 1687698105,
+        "narHash": "sha256-OHXlgRzs/kuJH8q7Sxh507H+0Rb8b7VOiPAjcY9sM1k=",
         "owner": "haskell",
         "repo": "haskell-language-server",
-        "rev": "20c6d1e731cd9c0beef7338e2fc7a8126ba9b6fb",
+        "rev": "783905f211ac63edf982dd1889c671653327e441",
         "type": "github"
       },
       "original": {
         "owner": "haskell",
-        "ref": "2.0.0.0",
+        "ref": "2.0.0.1",
         "repo": "haskell-language-server",
         "type": "github"
       }
@@ -512,11 +512,11 @@
     "stackage": {
       "flake": false,
       "locked": {
-        "lastModified": 1688688652,
-        "narHash": "sha256-HHTZ2N1qLL029/ucCidOeSNW61khhesMa062bYWBKCU=",
+        "lastModified": 1689034277,
+        "narHash": "sha256-Ido3tEL8bQKsHFlZa5X8lv+RW8ntplVV1Dcmdt5z3ww=",
         "owner": "input-output-hk",
         "repo": "stackage.nix",
-        "rev": "e00911e5f687ee2fa69cba203881e31d3dedd888",
+        "rev": "7a999b71591f8d357d7c838d38ad787d171f3b1f",
         "type": "github"
       },
       "original": {

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