diff --git a/src/Rel8/Query/List.hs b/src/Rel8/Query/List.hs index fc0e8ee0..32b64247 100644 --- a/src/Rel8/Query/List.hs +++ b/src/Rel8/Query/List.hs @@ -25,7 +25,7 @@ import Rel8.Expr.Opaleye ( mapPrimExpr ) import Rel8.Query ( Query ) import Rel8.Query.Aggregate ( aggregate ) import Rel8.Query.Maybe ( optional ) -import Rel8.Query.Rebind ( rebind ) +import Rel8.Query.Rebind ( hrebind, rebind ) import Rel8.Schema.HTable.Vectorize ( hunvectorize ) import Rel8.Schema.Null ( Sql, Unnullify ) import Rel8.Schema.Spec ( Spec( Spec, info ) ) @@ -86,7 +86,7 @@ someExpr = aggregate . fmap nonEmptyAggExpr -- @catListTable@ is an inverse to 'many'. catListTable :: Table Expr a => ListTable Expr a -> Query a catListTable (ListTable as) = - rebind "unnest" $ fromColumns $ runIdentity $ + fmap fromColumns $ hrebind "unnest" $ runIdentity $ hunvectorize (\Spec {info} -> pure . sunnest info) as @@ -96,7 +96,7 @@ catListTable (ListTable as) = -- @catNonEmptyTable@ is an inverse to 'some'. catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a catNonEmptyTable (NonEmptyTable as) = - rebind "unnest" $ fromColumns $ runIdentity $ + fmap fromColumns $ hrebind "unnest" $ runIdentity $ hunvectorize (\Spec {info} -> pure . sunnest info) as diff --git a/src/Rel8/Query/Rebind.hs b/src/Rel8/Query/Rebind.hs index a605aad2..159ef012 100644 --- a/src/Rel8/Query/Rebind.hs +++ b/src/Rel8/Query/Rebind.hs @@ -2,6 +2,7 @@ module Rel8.Query.Rebind ( rebind + , hrebind ) where @@ -15,7 +16,9 @@ import qualified Opaleye.Internal.Rebind as Opaleye -- rel8 import Rel8.Expr ( Expr ) import Rel8.Query ( Query ) +import Rel8.Schema.HTable (HTable) import Rel8.Table ( Table ) +import Rel8.Table.Cols (Cols (Cols)) import Rel8.Table.Opaleye ( unpackspec ) import Rel8.Query.Opaleye (fromOpaleye) @@ -25,3 +28,7 @@ import Rel8.Query.Opaleye (fromOpaleye) -- variables. It's essentially a @let@ binding for Postgres expressions. rebind :: Table Expr a => String -> a -> Query a rebind prefix a = fromOpaleye (Opaleye.rebindExplicitPrefix prefix unpackspec <<< pure a) + + +hrebind :: HTable t => String -> t Expr -> Query (t Expr) +hrebind prefix = fmap (\(Cols a) -> a) . rebind prefix . Cols