From 40994a70e81c59d0b3650599a3488caa88b52ea1 Mon Sep 17 00:00:00 2001 From: Shane Date: Fri, 22 Oct 2021 14:25:14 +0100 Subject: [PATCH] Move rebind to separate module and allow specifying variable name (#128) This can make the generated SQL a bit easier to follow. --- rel8.cabal | 1 + src/Rel8.hs | 1 + src/Rel8/Query/Evaluate.hs | 25 +++---------------------- src/Rel8/Query/List.hs | 16 +++++++++------- src/Rel8/Query/Rebind.hs | 35 +++++++++++++++++++++++++++++++++++ 5 files changed, 49 insertions(+), 29 deletions(-) create mode 100644 src/Rel8/Query/Rebind.hs diff --git a/rel8.cabal b/rel8.cabal index 1409f07a..fe604465 100644 --- a/rel8.cabal +++ b/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 diff --git a/src/Rel8.hs b/src/Rel8.hs index 4858d21e..2793c3fd 100644 --- a/src/Rel8.hs +++ b/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 diff --git a/src/Rel8/Query/Evaluate.hs b/src/Rel8/Query/Evaluate.hs index 3b14fe6d..5816387c 100644 --- a/src/Rel8/Query/Evaluate.hs +++ b/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 diff --git a/src/Rel8/Query/List.hs b/src/Rel8/Query/List.hs index 2ae3687e..fc0e8ee0 100644 --- a/src/Rel8/Query/List.hs +++ b/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,8 +85,9 @@ 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 @@ -94,8 +95,9 @@ catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $ -- -- @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 @@ -103,7 +105,7 @@ catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $ -- -- @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 @@ -111,7 +113,7 @@ catList = rebind . sunnest typeInformation -- -- @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 diff --git a/src/Rel8/Query/Rebind.hs b/src/Rel8/Query/Rebind.hs new file mode 100644 index 00000000..4cb1f49a --- /dev/null +++ b/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')