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