git.iko.soy/rel8
on ef28940 help sign in
rel8/src/Rel8/Query.hs
204 lines 6.7 kB history raw
1{-# language StandaloneKindSignatures #-}
3module Rel8.Query
4 ( Query( Query )
5 )
6where
8-- base
9import Control.Applicative ( liftA2 )
10import Control.Monad ( liftM2 )
11import Data.Kind ( Type )
12import Data.Monoid ( Any( Any ) )
13import Prelude
15-- opaleye
16import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
17import qualified Opaleye.Internal.PackMap as Opaleye
18import qualified Opaleye.Internal.PrimQuery as Opaleye
19import qualified Opaleye.Internal.QueryArr as Opaleye
20import qualified Opaleye.Internal.Tag as Opaleye
22-- rel8
23import Rel8.Query.Set ( unionAll )
24import Rel8.Query.Opaleye ( fromOpaleye )
25import Rel8.Query.Values ( values )
26import Rel8.Table.Alternative
27 ( AltTable, (<|>:)
28 , AlternativeTable, emptyTable
29 )
31-- semigroupoids
32import Data.Functor.Apply ( Apply, (<.>) )
33import Data.Functor.Bind ( Bind, (>>-) )
36-- | The @Query@ monad allows you to compose a @SELECT@ query. This monad has
37-- semantics similar to the list (@[]@) monad.
38type Query :: Type -> Type
39newtype 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 )
154instance Functor Query where
155 fmap f (Query a) = Query (fmap (fmap (fmap f)) a)
158instance Apply Query where
159 (<.>) = (<*>)
162instance Applicative Query where
163 pure = fromOpaleye . pure
164 liftA2 = liftM2
167instance Bind Query where
168 (>>-) = (>>=)
171instance Monad Query where
172 Query q >>= f = Query $ \dummies -> Opaleye.QueryArr $ \(_, tag) ->
173 let
174 Opaleye.QueryArr qa = q dummies
175 ((m, a), query, tag') = qa ((), tag)
176 Query q' = f a
177 (dummies', query', tag'') =
178 ( dummy : dummies
179 , \lateral -> Opaleye.Rebind True bindings . query lateral
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), query'', tag''') = qa' ((), tag'')
189 query'''
190 | needsDummies = \lateral -> query'' lateral . query' lateral
191 | otherwise = \lateral -> query'' lateral . query lateral
192 m'' = m <> m'
193 in
194 ((m'', b), query''', tag''')
197-- | '<|>:' = 'unionAll'.
198instance AltTable Query where
199 (<|>:) = unionAll
202-- | 'emptyTable' = 'values' @[]@.
203instance AlternativeTable Query where
204 emptyTable = values []