@@ -1,5 +1,3 @@
1−{-# language DerivingVia #-}
2−{-# language GeneralizedNewtypeDeriving #-}
31{-# language StandaloneKindSignatures #-}
42
53module Rel8.Query
@@ -8,14 +6,22 @@ module Rel8.Query
86where
97
108-- base
9+import Control.Applicative ( liftA2 )
10+import Control.Monad ( liftM2 )
1111import Data.Kind ( Type )
12+import Data.Monoid ( Any( Any ) )
1213import Prelude
1314
1415-- opaleye
15−import qualified Opaleye.Select as Opaleye
16+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
17+import qualified Opaleye.Internal.PackMap as Opaleye
18+import qualified Opaleye.Internal.PrimQuery as Opaleye
19+import qualified Opaleye.Internal.QueryArr as Opaleye
20+import qualified Opaleye.Internal.Tag as Opaleye
1621
1722-- rel8
1823import Rel8.Query.Set ( unionAll )
24+import Rel8.Query.Opaleye ( fromOpaleye )
1925import Rel8.Query.Values ( values )
2026import Rel8.Table.Alternative
2127 ( AltTable, (<|>:)
@@ -23,22 +29,172 @@ import Rel8.Table.Alternative
2329 )
2430
2531-- semigroupoids
26−import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
32+import Data.Functor.Apply ( Apply, (<.>) )
2733import Data.Functor.Bind ( Bind, (>>-) )
2834
2935
3036-- | The @Query@ monad allows you to compose a @SELECT@ query. This monad has
3137-- semantics similar to the list (@[]@) monad.
3238type Query :: Type -> Type
33−newtype Query a = Query (Opaleye.Select a)
34− deriving newtype (Functor, Applicative, Monad)
35− deriving Apply via (WrappedApplicative Opaleye.Select)
39+newtype Query a =
40+ Query (
41+ -- This is based on Opaleye's Select monad, but with two addtions. We
42+ -- maintain a stack of PrimExprs from parent previous subselects. In
43+ -- practice, these are always the results of dummy calls to random().
44+ --
45+ -- We also return a Bool that indicates to the parent subselect whether
46+ -- or not that stack of PrimExprs were used at any point. If they weren't,
47+ -- then the call to random() is never added to the query.
48+ --
49+ -- This is all needed to implement evaluate. Consider the following code:
50+ --
51+ -- do
52+ -- x <- values [lit 'a', lit 'b', lit 'c']
53+ -- y <- evaluate $ nextval "user_id_seq"
54+ -- pure (x, y)
55+ --
56+ -- If we just used Opaleye's Select monad directly, the SQL would come out
57+ -- like this:
58+ --
59+ -- SELECT
60+ -- a, b
61+ -- FROM
62+ -- (VALUES ('a'), ('b'), ('c')) Q1(a),
63+ -- LATERAL (SELECT nextval('user_id_seq')) Q2(b);
64+ --
65+ -- From the Haskell code, you would intuitively expect to get back the
66+ -- results of three different calls to nextval(), but from Postgres' point
67+ -- of view, because the Q2 subquery doesn't reference anything from the Q1
68+ -- query, it thinks it only needs to call nextval() once. This is actually
69+ -- exactly the same problem you get with the deprecated ListT IO monad from
70+ -- the transformers package — *> behaves differently to >>=, so
71+ -- using ApplicativeDo can change the results of a program. ApplicativeDo
72+ -- is exactly the optimisation Postgres does on a "LATERAL" query that
73+ -- doesn't make any references to previous subselects.
74+ --
75+ -- Rel8's solution is generate the following SQL instead:
76+ --
77+ -- SELECT
78+ -- a, b
79+ -- FROM
80+ -- (SELECT
81+ -- random() AS dummy,
82+ -- *
83+ -- FROM
84+ -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
85+ -- LATERAL (SELECT
86+ -- CASE
87+ -- WHEN dummy IS NOT NULL
88+ -- THEN nextval('user_id_seq')
89+ -- END) Q2(b);
90+ --
91+ -- We use random() here as the dummy value (and not some constant) because
92+ -- Postgres will again optimize if it sees that a value is constant
93+ -- (and thus only call nextval() once), but because random() is marked as
94+ -- VOLATILE, this inhibits Postgres from doing that optimisation.
95+ --
96+ -- Why not just reference the a column from the previous query directly
97+ -- instead of adding a dummy value? Basically, even if we extract out all
98+ -- the bindings introduced in a PrimQuery, we can't always be sure which
99+ -- ones refer to constant values, so if we end up laterally referencing a
100+ -- constant value, then all of this would be for nothing.
101+ --
102+ -- Why not just add the call to the previous subselect directly, like so:
103+ --
104+ -- SELECT
105+ -- a, b
106+ -- FROM
107+ -- (SELECT
108+ -- nextval('user_id_seq') AS eval,
109+ -- *
110+ -- FROM
111+ -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
112+ -- LATERAL (SELECT eval) Q2(b);
113+ --
114+ -- That would work in this case. But consider the following Rel8 code:
115+ --
116+ -- do
117+ -- x <- values [lit 'a', lit 'b', lit 'c']
118+ -- y <- values [lit 'd', lit 'e', lit 'f']
119+ -- z <- evaluate $ nextval "user_id_seq"
120+ -- pure (x, y, z)
121+ --
122+ -- How many calls to nextval should there be? Our Haskell intuition says
123+ -- nine. But that's not what you would get if you used the above
124+ -- technique. The problem is, which VALUES query should the nextval be
125+ -- added to? You can choose one or the other to get three calls to
126+ -- nextval, but you still need to make a superfluous LATERAL references to
127+ -- the other if you want nine calls. So for the above Rel8 code we generate
128+ -- the following SQL:
129+ --
130+ -- SELECT
131+ -- a, b, c
132+ -- FROM
133+ -- (SELECT
134+ -- random() AS dummy,
135+ -- *
136+ -- FROM
137+ -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
138+ -- (SELECT
139+ -- random() AS dummy,
140+ -- *
141+ -- FROM
142+ -- (VALUES ('d'), ('e'), ('f')) Q2(b)) Q2,
143+ -- LATERAL (SELECT
144+ -- CASE
145+ -- WHEN Q1.dummy IS NOT NULL AND Q2.dummy IS NOT NULL
146+ -- THEN nextval('user_id_seq')
147+ -- END) Q3(c);
148+ --
149+ -- This gives nine calls to nextval() as we would expect.
150+ [Opaleye.PrimExpr] -> Opaleye.Select (Any, a)
151+ )
152+
153+
154+instance Functor Query where
155+ fmap f (Query a) = Query (fmap (fmap (fmap f)) a)
156+
157+
158+instance Apply Query where
159+ (<.>) = (<*>)
160+
161+
162+instance Applicative Query where
163+ pure = fromOpaleye . pure
164+ liftA2 = liftM2
36165
37166
38167instance Bind Query where
39168 (>>-) = (>>=)
40169
41170
171+instance Monad Query where
172+ Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, query, tag) ->
173+ let
174+ Opaleye.QueryArr qa = q dummies
175+ ((m, a), query', tag') = qa ((), query, tag)
176+ Query q' = f a
177+ (dummies', lquery, tag'') =
178+ ( dummy : dummies
179+ , Opaleye.Rebind True bindings query'
180+ , Opaleye.next tag'
181+ )
182+ where
183+ (dummy, bindings) = Opaleye.run $ name random
184+ where
185+ random = Opaleye.FunExpr "random" []
186+ name = Opaleye.extractAttr "dummy" tag'
187+ Opaleye.QueryArr qa' = Opaleye.lateral $ \_ -> q' dummies'
188+ ((m'@(Any needsDummies), b), rquery, tag''') = qa' ((), Opaleye.Unit, tag'')
189+ lquery'
190+ | needsDummies = lquery
191+ | otherwise = query'
192+ query'''' = Opaleye.times lquery' rquery
193+ m'' = m <> m'
194+ in
195+ ((m'', b), query'''', tag''')
196+
197+
42198-- | '<|>:' = 'unionAll'.
43199instance AltTable Query where
44200 (<|>:) = unionAll