git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Query.hs
223 lines 7.2 kB history raw
1{-# language FlexibleContexts #-}
2{-# language StandaloneKindSignatures #-}
3{-# language UndecidableInstances #-}
5module Rel8.Query
6 ( Query( Query )
7 )
8where
10-- base
11import Control.Applicative ( liftA2 )
12import Control.Monad ( liftM2 )
13import Data.Kind ( Type )
14import Data.Monoid ( Any( Any ) )
15import Prelude
17-- opaleye
18import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
19import qualified Opaleye.Internal.PackMap as Opaleye
20import qualified Opaleye.Internal.PrimQuery as Opaleye hiding (lateral)
21import qualified Opaleye.Internal.QueryArr as Opaleye
22import qualified Opaleye.Internal.Tag as Opaleye
24-- rel8
25import Rel8.Expr ( Expr )
26import Rel8.Query.Set ( unionAll )
27import Rel8.Query.Opaleye ( fromOpaleye )
28import Rel8.Query.Values ( values )
29import Rel8.Table ( Table, fromColumns, toColumns )
30import Rel8.Table.Alternative
31 ( AltTable, (<|>:)
32 , AlternativeTable, emptyTable
33 )
34import Rel8.Table.Projection ( Projectable, apply, project )
36-- semigroupoids
37import Data.Functor.Apply ( Apply, (<.>) )
38import Data.Functor.Bind ( Bind, (>>-) )
41-- | The @Query@ monad allows you to compose a @SELECT@ query. This monad has
42-- semantics similar to the list (@[]@) monad.
43type Query :: Type -> Type
44newtype Query a =
45 Query (
46 -- This is based on Opaleye's Select monad, but with two addtions. We
47 -- maintain a stack of PrimExprs from parent previous subselects. In
48 -- practice, these are always the results of dummy calls to random().
49 --
50 -- We also return a Bool that indicates to the parent subselect whether
51 -- or not that stack of PrimExprs were used at any point. If they weren't,
52 -- then the call to random() is never added to the query.
53 --
54 -- This is all needed to implement evaluate. Consider the following code:
55 --
56 -- do
57 -- x <- values [lit 'a', lit 'b', lit 'c']
58 -- y <- evaluate $ nextval "user_id_seq"
59 -- pure (x, y)
60 --
61 -- If we just used Opaleye's Select monad directly, the SQL would come out
62 -- like this:
63 --
64 -- SELECT
65 -- a, b
66 -- FROM
67 -- (VALUES ('a'), ('b'), ('c')) Q1(a),
68 -- LATERAL (SELECT nextval('user_id_seq')) Q2(b);
69 --
70 -- From the Haskell code, you would intuitively expect to get back the
71 -- results of three different calls to nextval(), but from Postgres' point
72 -- of view, because the Q2 subquery doesn't reference anything from the Q1
73 -- query, it thinks it only needs to call nextval() once. This is actually
74 -- exactly the same problem you get with the deprecated ListT IO monad from
75 -- the transformers package — *> behaves differently to >>=, so
76 -- using ApplicativeDo can change the results of a program. ApplicativeDo
77 -- is exactly the optimisation Postgres does on a "LATERAL" query that
78 -- doesn't make any references to previous subselects.
79 --
80 -- Rel8's solution is generate the following SQL instead:
81 --
82 -- SELECT
83 -- a, b
84 -- FROM
85 -- (SELECT
86 -- random() AS dummy,
87 -- *
88 -- FROM
89 -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
90 -- LATERAL (SELECT
91 -- CASE
92 -- WHEN dummy IS NOT NULL
93 -- THEN nextval('user_id_seq')
94 -- END) Q2(b);
95 --
96 -- We use random() here as the dummy value (and not some constant) because
97 -- Postgres will again optimize if it sees that a value is constant
98 -- (and thus only call nextval() once), but because random() is marked as
99 -- VOLATILE, this inhibits Postgres from doing that optimisation.
100 --
101 -- Why not just reference the a column from the previous query directly
102 -- instead of adding a dummy value? Basically, even if we extract out all
103 -- the bindings introduced in a PrimQuery, we can't always be sure which
104 -- ones refer to constant values, so if we end up laterally referencing a
105 -- constant value, then all of this would be for nothing.
106 --
107 -- Why not just add the call to the previous subselect directly, like so:
108 --
109 -- SELECT
110 -- a, b
111 -- FROM
112 -- (SELECT
113 -- nextval('user_id_seq') AS eval,
114 -- *
115 -- FROM
116 -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
117 -- LATERAL (SELECT eval) Q2(b);
118 --
119 -- That would work in this case. But consider the following Rel8 code:
120 --
121 -- do
122 -- x <- values [lit 'a', lit 'b', lit 'c']
123 -- y <- values [lit 'd', lit 'e', lit 'f']
124 -- z <- evaluate $ nextval "user_id_seq"
125 -- pure (x, y, z)
126 --
127 -- How many calls to nextval should there be? Our Haskell intuition says
128 -- nine. But that's not what you would get if you used the above
129 -- technique. The problem is, which VALUES query should the nextval be
130 -- added to? You can choose one or the other to get three calls to
131 -- nextval, but you still need to make a superfluous LATERAL references to
132 -- the other if you want nine calls. So for the above Rel8 code we generate
133 -- the following SQL:
134 --
135 -- SELECT
136 -- a, b, c
137 -- FROM
138 -- (SELECT
139 -- random() AS dummy,
140 -- *
141 -- FROM
142 -- (VALUES ('a'), ('b'), ('c')) Q1(a)) Q1,
143 -- (SELECT
144 -- random() AS dummy,
145 -- *
146 -- FROM
147 -- (VALUES ('d'), ('e'), ('f')) Q2(b)) Q2,
148 -- LATERAL (SELECT
149 -- CASE
150 -- WHEN Q1.dummy IS NOT NULL AND Q2.dummy IS NOT NULL
151 -- THEN nextval('user_id_seq')
152 -- END) Q3(c);
153 --
154 -- This gives nine calls to nextval() as we would expect.
155 [Opaleye.PrimExpr] -> Opaleye.Select (Any, a)
156 )
159instance Projectable Query where
160 project f = fmap (fromColumns . apply f . toColumns)
163instance Functor Query where
164 fmap f (Query a) = Query (fmap (fmap (fmap f)) a)
167instance Apply Query where
168 (<.>) = (<*>)
171instance Applicative Query where
172 pure = fromOpaleye . pure
173 liftA2 = liftM2
176instance Bind Query where
177 (>>-) = (>>=)
180instance Monad Query where
181 Query q >>= f = Query $ \dummies -> Opaleye.stateQueryArr $ \_ tag ->
182 let
183 qa = q dummies
184 ((m, a), query, tag') = Opaleye.runStateQueryArr qa () tag
185 Query q' = f a
186 (dummies', query', tag'') =
187 ( dummy : dummies
188 , query <> Opaleye.aRebind bindings
189 , Opaleye.next tag'
190 )
191 where
192 (dummy, bindings) = Opaleye.run $ name random
193 where
194 random = Opaleye.FunExpr "random" []
195 name = Opaleye.extractAttr "dummy" tag'
196 qa' = Opaleye.lateral $ \_ -> q' dummies'
197 ((m'@(Any needsDummies), b), query'', tag''') = Opaleye.runStateQueryArr qa' () tag''
198 query'''
199 | needsDummies = query' <> query''
200 | otherwise = query <> query''
201 m'' = m <> m'
202 in
203 ((m'', b), query''', tag''')
206-- | '<|>:' = 'unionAll'.
207instance AltTable Query where
208 (<|>:) = unionAll
211-- | 'emptyTable' = 'values' @[]@.
212instance AlternativeTable Query where
213 emptyTable = values []
216-- | '<>' = 'unionAll'.
217instance Table Expr a => Semigroup (Query a) where
218 (<>) = (<|>:)
221-- | 'mempty' = @'values' []@.
222instance Table Expr a => Monoid (Query a) where
223 mempty = emptyTable