Move rebind to separate module and allow specifying variable name (#128)

This can make the generated SQL a bit easier to follow.

rel8.cabal

@@ -113,6 +113,7 @@ library
     Rel8.Query.Null
     Rel8.Query.Opaleye
     Rel8.Query.Order
+    Rel8.Query.Rebind
     Rel8.Query.Set
     Rel8.Query.SQL
     Rel8.Query.These

src/Rel8.hs

@@ -331,6 +331,7 @@ import Rel8.Query.List
 import Rel8.Query.Maybe
 import Rel8.Query.Null
 import Rel8.Query.Order
+import Rel8.Query.Rebind
 import Rel8.Query.SQL (showQuery)
 import Rel8.Query.Set
 import Rel8.Query.These

src/Rel8/Query/Evaluate.hs

@@ -3,7 +3,6 @@
 
 module Rel8.Query.Evaluate
   ( evaluate
-  , rebind
   )
 where
 
@@ -16,28 +15,23 @@ import Prelude hiding ( undefined )
 
 -- opaleye
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
-import qualified Opaleye.Internal.PackMap as Opaleye
-import qualified Opaleye.Internal.PrimQuery as Opaleye
-import qualified Opaleye.Internal.QueryArr as Opaleye
-import qualified Opaleye.Internal.Tag as Opaleye
-import qualified Opaleye.Internal.Unpackspec as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( (&&.) )
 import Rel8.Expr.Opaleye ( fromPrimExpr )
 import Rel8.Query ( Query( Query ) )
+import Rel8.Query.Rebind ( rebind )
 import Rel8.Table ( Table )
 import Rel8.Table.Bool ( case_ )
-import Rel8.Table.Opaleye ( unpackspec )
-import Rel8.Table.Undefined
+import Rel8.Table.Undefined ( undefined )
 
 
 -- | 'evaluate' takes expressions that could potentially have side effects and
 -- \"runs\" them in the 'Query' monad. The returned expressions have no side
 -- effects and can safely be reused.
 evaluate :: Table Expr a => a -> Query a
-evaluate = laterally >=> rebind
+evaluate = laterally >=> rebind "eval"
 
 
 laterally :: Table Expr a => a -> Query a
@@ -51,18 +45,5 @@ laterally a = Query $ \bindings -> pure $ (Any True,) $
             go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull
 
 
--- | 'rebind' takes some expressions, and binds each of them to a new
--- variable in the SQL. The @a@ returned consists only of these
--- variables. It's essentially a @let@ binding for Postgres expressions.
-rebind :: Table Expr a => a -> Query a
-rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->
-  let
-    tag' = Opaleye.next tag
-    (a', bindings) = Opaleye.run $
-      Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag) a
-  in
-    ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')
-
-
 foldl1' :: (a -> a -> a) -> NonEmpty a -> a
 foldl1' f (a :| as) = foldl' f a as

src/Rel8/Query/List.hs

@@ -24,8 +24,8 @@ import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )
 import Rel8.Expr.Opaleye ( mapPrimExpr )
 import Rel8.Query ( Query )
 import Rel8.Query.Aggregate ( aggregate )
-import Rel8.Query.Evaluate ( rebind )
 import Rel8.Query.Maybe ( optional )
+import Rel8.Query.Rebind ( rebind )
 import Rel8.Schema.HTable.Vectorize ( hunvectorize )
 import Rel8.Schema.Null ( Sql, Unnullify )
 import Rel8.Schema.Spec ( Spec( Spec, info ) )
@@ -85,33 +85,35 @@ someExpr = aggregate . fmap nonEmptyAggExpr
 --
 -- @catListTable@ is an inverse to 'many'.
 catListTable :: Table Expr a => ListTable Expr a -> Query a
-catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $
-  hunvectorize (\Spec {info} -> pure . sunnest info) as
+catListTable (ListTable as) =
+  rebind "unnest" $ fromColumns $ runIdentity $
+    hunvectorize (\Spec {info} -> pure . sunnest info) as
 
 
 -- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an
 -- element of the given @NonEmptyTable@.
 --
 -- @catNonEmptyTable@ is an inverse to 'some'.
 catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a
-catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $
-  hunvectorize (\Spec {info} -> pure . sunnest info) as
+catNonEmptyTable (NonEmptyTable as) =
+  rebind "unnest" $ fromColumns $ runIdentity $
+    hunvectorize (\Spec {info} -> pure . sunnest info) as
 
 
 -- | Expand an expression that contains a list into a 'Query', where each row
 -- in the query is an element of the given list.
 --
 -- @catList@ is an inverse to 'manyExpr'.
 catList :: Sql DBType a => Expr [a] -> Query (Expr a)
-catList = rebind . sunnest typeInformation
+catList = rebind "unnest" . sunnest typeInformation
 
 
 -- | Expand an expression that contains a non-empty list into a 'Query', where
 -- each row in the query is an element of the given list.
 --
 -- @catNonEmpty@ is an inverse to 'someExpr'.
 catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)
-catNonEmpty = rebind . sunnest typeInformation
+catNonEmpty = rebind "unnest" . sunnest typeInformation
 
 
 sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a

src/Rel8/Query/Rebind.hs

@@ -0,0 +1,35 @@
+{-# language FlexibleContexts #-}
+
+module Rel8.Query.Rebind
+  ( rebind
+  )
+where
+
+-- base
+import Prelude
+
+-- opaleye
+import qualified Opaleye.Internal.PackMap as Opaleye
+import qualified Opaleye.Internal.PrimQuery as Opaleye
+import qualified Opaleye.Internal.QueryArr as Opaleye
+import qualified Opaleye.Internal.Tag as Opaleye
+import qualified Opaleye.Internal.Unpackspec as Opaleye
+
+-- rel8
+import Rel8.Expr ( Expr )
+import Rel8.Query ( Query( Query ) )
+import Rel8.Table ( Table )
+import Rel8.Table.Opaleye ( unpackspec )
+
+
+-- | 'rebind' takes a variable name, some expressions, and binds each of them
+-- to a new variable in the SQL. The @a@ returned consists only of these
+-- variables. It's essentially a @let@ binding for Postgres expressions.
+rebind :: Table Expr a => String -> a -> Query a
+rebind prefix a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->
+  let
+    tag' = Opaleye.next tag
+    (a', bindings) = Opaleye.run $
+      Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr prefix tag) a
+  in
+    ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')