40994a7 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

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

40994a7Shane5 years ago

rel8.cabal+1

compare with master

unifiedsplit

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

113 Rel8.Query.Null

114 Rel8.Query.Opaleye

115 Rel8.Query.Order

116+ Rel8.Query.Rebind

116 Rel8.Query.Set

117 Rel8.Query.Set

117 Rel8.Query.SQL

118 Rel8.Query.SQL

118 Rel8.Query.These

119 Rel8.Query.These

src/Rel8.hs+1

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

331import Rel8.Query.Maybe

332import Rel8.Query.Null

333import Rel8.Query.Order

334+import Rel8.Query.Rebind

334import Rel8.Query.SQL (showQuery)

335import Rel8.Query.SQL (showQuery)

335import Rel8.Query.Set

336import Rel8.Query.Set

336import Rel8.Query.These

337import Rel8.Query.These

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

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

4module Rel8.Query.Evaluate

5 ( evaluate

6− , rebind

7 )

6 )

8where

7where

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

17-- opaleye

16-- opaleye

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

17import 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

25-- rel8

19-- rel8

26import Rel8.Expr ( Expr )

20import Rel8.Expr ( Expr )

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

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

28import Rel8.Expr.Opaleye ( fromPrimExpr )

22import Rel8.Expr.Opaleye ( fromPrimExpr )

29import Rel8.Query ( Query( Query ) )

23import Rel8.Query ( Query( Query ) )

24+import Rel8.Query.Rebind ( rebind )

30import Rel8.Table ( Table )

25import Rel8.Table ( Table )

31import Rel8.Table.Bool ( case_ )

26import Rel8.Table.Bool ( case_ )

32−import Rel8.Table.Opaleye ( unpackspec )

27+import Rel8.Table.Undefined ( undefined )

33−import Rel8.Table.Undefined

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

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

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

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

38-- effects and can safely be reused.

32-- effects and can safely be reused.

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

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

40−evaluate = laterally >=> rebind

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

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

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

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

51 go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull

45 go = fromPrimExpr . Opaleye.UnExpr Opaleye.OpIsNotNull

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−

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

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

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

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

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

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

24import Rel8.Expr.Opaleye ( mapPrimExpr )

25import Rel8.Query ( Query )

26import Rel8.Query.Aggregate ( aggregate )

27−import Rel8.Query.Evaluate ( rebind )

28import Rel8.Query.Maybe ( optional )

27import Rel8.Query.Maybe ( optional )

28+import Rel8.Query.Rebind ( rebind )

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

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

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

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

85--

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

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

88+catListTable (ListTable as) =

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

89+ rebind "unnest" $ fromColumns $ runIdentity $

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

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

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

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

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

94--

95--

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

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

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

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

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

98+catNonEmptyTable (NonEmptyTable as) =

99+ rebind "unnest" $ fromColumns $ runIdentity $

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

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

101

100

102

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

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

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

103--

105--

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

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

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

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

106−catList = rebind . sunnest typeInformation

108+catList = rebind "unnest" . sunnest typeInformation

107

109

108

110

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

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

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

111--

113--

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

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

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

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

114−catNonEmpty = rebind . sunnest typeInformation

116+catNonEmpty = rebind "unnest" . sunnest typeInformation

115

117

116

118

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

119sunnest :: 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')