40994a7 · rel8 · git.iko.soy

git.iko.soy/rel8

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

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

commit40994a70e81c59d0b3650599a3488caa88b52ea1 authorShane <shane.obrien@circuithub.com> dateFri 22 Oct 2021, 14:25 (5 years ago) parent0272bcc

5 files changed+49−29

compare with master

unifiedsplit

rel8.cabal+1 src/Rel8.hs+1 src/Rel8/Query/Evaluate.hs+3−22 src/Rel8/Query/List.hs+9−7 src/Rel8/Query/Rebind.hs+35

rel8.cabal+1

@@ -113,6 +113,7 @@ library

113113 Rel8.Query.Null

114114 Rel8.Query.Opaleye

115115 Rel8.Query.Order

116+ Rel8.Query.Rebind

116117 Rel8.Query.Set

117118 Rel8.Query.SQL

118119 Rel8.Query.These

src/Rel8.hs+1

@@ -331,6 +331,7 @@ import Rel8.Query.List

331331import Rel8.Query.Maybe

332332import Rel8.Query.Null

333333import Rel8.Query.Order

334+import Rel8.Query.Rebind

334335import Rel8.Query.SQL (showQuery)

335336import Rel8.Query.Set

336337import Rel8.Query.These

src/Rel8/Query/Evaluate.hs+3−22

@@ -3,7 +3,6 @@

44module Rel8.Query.Evaluate

55 ( evaluate

6− , rebind

76 )

87where

@@ -16,28 +15,23 @@ import Prelude hiding ( undefined )

1615

1716-- opaleye

1817import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

19−import qualified Opaleye.Internal.PackMap as Opaleye

20−import qualified Opaleye.Internal.PrimQuery as Opaleye

21−import qualified Opaleye.Internal.QueryArr as Opaleye

22−import qualified Opaleye.Internal.Tag as Opaleye

23−import qualified Opaleye.Internal.Unpackspec as Opaleye

2418

2519-- rel8

2620import Rel8.Expr ( Expr )

2721import Rel8.Expr.Bool ( (&&.) )

2822import Rel8.Expr.Opaleye ( fromPrimExpr )

2923import Rel8.Query ( Query( Query ) )

24+import Rel8.Query.Rebind ( rebind )

3025import Rel8.Table ( Table )

3126import Rel8.Table.Bool ( case_ )

32−import Rel8.Table.Opaleye ( unpackspec )

33−import Rel8.Table.Undefined

27+import Rel8.Table.Undefined ( undefined )

3428

3529

3630-- | 'evaluate' takes expressions that could potentially have side effects and

3731-- \"runs\" them in the 'Query' monad. The returned expressions have no side

3832-- effects and can safely be reused.

3933evaluate :: Table Expr a => a -> Query a

40−evaluate = laterally >=> rebind

34+evaluate = laterally >=> rebind "eval"

4135

4236

4337laterally :: Table Expr a => a -> Query a

@@ -51,18 +45,5 @@ laterally a = Query $ \bindings -> pure $ (Any True,) $

5145 go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull

5246

5347

54−-- | 'rebind' takes some expressions, and binds each of them to a new

55−-- variable in the SQL. The @a@ returned consists only of these

56−-- variables. It's essentially a @let@ binding for Postgres expressions.

57−rebind :: Table Expr a => a -> Query a

58−rebind a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->

59− let

60− tag' = Opaleye.next tag

61− (a', bindings) = Opaleye.run $

62− Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "eval" tag) a

63− in

64− ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')

65−

66−

6748foldl1' :: (a -> a -> a) -> NonEmpty a -> a

6849foldl1' f (a :| as) = foldl' f a as

src/Rel8/Query/List.hs+9−7

@@ -24,8 +24,8 @@ import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )

2424import Rel8.Expr.Opaleye ( mapPrimExpr )

2525import Rel8.Query ( Query )

2626import Rel8.Query.Aggregate ( aggregate )

27−import Rel8.Query.Evaluate ( rebind )

2827import Rel8.Query.Maybe ( optional )

28+import Rel8.Query.Rebind ( rebind )

2929import Rel8.Schema.HTable.Vectorize ( hunvectorize )

3030import Rel8.Schema.Null ( Sql, Unnullify )

3131import Rel8.Schema.Spec ( Spec( Spec, info ) )

@@ -85,8 +85,9 @@ someExpr = aggregate . fmap nonEmptyAggExpr

8585--

8686-- @catListTable@ is an inverse to 'many'.

8787catListTable :: Table Expr a => ListTable Expr a -> Query a

88−catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $

89− hunvectorize (\Spec {info} -> pure . sunnest info) as

88+catListTable (ListTable as) =

89+ rebind "unnest" $ fromColumns $ runIdentity $

90+ hunvectorize (\Spec {info} -> pure . sunnest info) as

9091

9192

9293-- | Expand a 'NonEmptyTable' into a 'Query', where each row in the query is an

@@ -94,8 +95,9 @@ catListTable (ListTable as) = rebind $ fromColumns $ runIdentity $

9495--

9596-- @catNonEmptyTable@ is an inverse to 'some'.

9697catNonEmptyTable :: Table Expr a => NonEmptyTable Expr a -> Query a

97−catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $

98− hunvectorize (\Spec {info} -> pure . sunnest info) as

98+catNonEmptyTable (NonEmptyTable as) =

99+ rebind "unnest" $ fromColumns $ runIdentity $

100+ hunvectorize (\Spec {info} -> pure . sunnest info) as

99101

100102

101103-- | Expand an expression that contains a list into a 'Query', where each row

@@ -103,7 +105,7 @@ catNonEmptyTable (NonEmptyTable as) = rebind $ fromColumns $ runIdentity $

103105--

104106-- @catList@ is an inverse to 'manyExpr'.

105107catList :: Sql DBType a => Expr [a] -> Query (Expr a)

106−catList = rebind . sunnest typeInformation

108+catList = rebind "unnest" . sunnest typeInformation

107109

108110

109111-- | Expand an expression that contains a non-empty list into a 'Query', where

@@ -111,7 +113,7 @@ catList = rebind . sunnest typeInformation

111113--

112114-- @catNonEmpty@ is an inverse to 'someExpr'.

113115catNonEmpty :: Sql DBType a => Expr (NonEmpty a) -> Query (Expr a)

114−catNonEmpty = rebind . sunnest typeInformation

116+catNonEmpty = rebind "unnest" . sunnest typeInformation

115117

116118

117119sunnest :: TypeInformation (Unnullify a) -> Expr (list a) -> Expr a

src/Rel8/Query/Rebind.hsnew file+35

@@ -0,0 +1,35 @@

1+{-# language FlexibleContexts #-}

3+module Rel8.Query.Rebind

4+ ( rebind

5+ )

6+where

8+-- base

9+import Prelude

10+

11+-- opaleye

12+import qualified Opaleye.Internal.PackMap as Opaleye

13+import qualified Opaleye.Internal.PrimQuery as Opaleye

14+import qualified Opaleye.Internal.QueryArr as Opaleye

15+import qualified Opaleye.Internal.Tag as Opaleye

16+import qualified Opaleye.Internal.Unpackspec as Opaleye

17+

18+-- rel8

19+import Rel8.Expr ( Expr )

20+import Rel8.Query ( Query( Query ) )

21+import Rel8.Table ( Table )

22+import Rel8.Table.Opaleye ( unpackspec )

23+

24+

25+-- | 'rebind' takes a variable name, some expressions, and binds each of them

26+-- to a new variable in the SQL. The @a@ returned consists only of these

27+-- variables. It's essentially a @let@ binding for Postgres expressions.

28+rebind :: Table Expr a => String -> a -> Query a

29+rebind prefix a = Query $ \_ -> Opaleye.QueryArr $ \(_, tag) ->

30+ let

31+ tag' = Opaleye.next tag

32+ (a', bindings) = Opaleye.run $

33+ Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr prefix tag) a

34+ in

35+ ((mempty, a'), \_ -> Opaleye.Rebind True bindings, tag')