-
Notifications
You must be signed in to change notification settings - Fork 38
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Instead of trying to extract a binding from the previous subquery upo…
…n which to laterally depend, we instead explicitly add a call to `random()` if necessary. `random()`'s volatility will force Postgres' optimiser not to optimise away a reference to what it would otherwise believe to be a constant.
- Loading branch information
1 parent
a4d6df3
commit 23d91d0
Showing
4 changed files
with
77 additions
and
70 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,79 +1,62 @@ | ||
{-# language LambdaCase #-} | ||
{-# language TupleSections #-} | ||
|
||
module Rel8.Query.Opaleye | ||
( fromOpaleye | ||
, toOpaleye | ||
, mapOpaleye | ||
, zipOpaleyeWith | ||
, withSymbols | ||
) | ||
where | ||
|
||
-- base | ||
import Control.Applicative ( liftA2 ) | ||
import Data.Bifunctor ( first ) | ||
import Prelude | ||
|
||
-- opaleye | ||
import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye | ||
import qualified Opaleye.Internal.PrimQuery as Opaleye | ||
import qualified Opaleye.Internal.QueryArr as Opaleye | ||
|
||
-- rel8 | ||
import {-# SOURCE #-} Rel8.Query ( Query( Query ) ) | ||
|
||
|
||
fromOpaleye :: Opaleye.Select a -> Query a | ||
fromOpaleye = Query . const | ||
fromOpaleye = Query . pure . fmap pure | ||
|
||
|
||
toOpaleye :: Query a -> Opaleye.Select a | ||
toOpaleye (Query a) = a [] | ||
toOpaleye (Query a) = snd <$> a mempty | ||
|
||
|
||
mapOpaleye :: (Opaleye.Select a -> Opaleye.Select b) -> Query a -> Query b | ||
mapOpaleye f (Query a) = Query (fmap f a) | ||
mapOpaleye f (Query a) = Query (fmap (mapping f) a) | ||
|
||
|
||
zipOpaleyeWith :: () | ||
=> (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c) | ||
-> Query a -> Query b -> Query c | ||
zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 f a b | ||
|
||
|
||
withSymbols :: Opaleye.Select a -> Opaleye.Select ([Opaleye.Symbol], a) | ||
withSymbols = fmap (first extractSymbols) . withPrimQuery | ||
|
||
|
||
withPrimQuery :: Opaleye.Select a -> Opaleye.Select (Opaleye.PrimQuery, a) | ||
withPrimQuery (Opaleye.QueryArr q) = Opaleye.QueryArr $ \(_, query, tag) -> | ||
case q ((), query, tag) of | ||
(a, query', tag') -> ((query', a), query', tag') | ||
|
||
|
||
extractSymbols :: Opaleye.PrimQuery -> [Opaleye.Symbol] | ||
extractSymbols = \case | ||
Opaleye.Unit -> [] | ||
Opaleye.Empty _ -> [] | ||
Opaleye.BaseTable _ bindings -> map fst bindings | ||
Opaleye.Product as _ -> foldMap (foldMap extractSymbols) as | ||
Opaleye.Aggregate bindings _ -> map fst bindings | ||
Opaleye.DistinctOnOrderBy _ _ query -> extractSymbols query | ||
Opaleye.Limit _ query -> extractSymbols query | ||
Opaleye.Join _ _ bindings bindings' query query' -> | ||
map fst bindings <> | ||
map fst bindings' <> | ||
extractSymbols query <> | ||
extractSymbols query' | ||
Opaleye.Exists _ query _ -> extractSymbols query | ||
Opaleye.Values symbols _ -> symbols | ||
Opaleye.Binary _ (query, query') -> | ||
extractSymbols query <> | ||
extractSymbols query' | ||
Opaleye.Label _ query -> extractSymbols query | ||
Opaleye.RelExpr _ bindings -> map fst bindings | ||
Opaleye.Rebind False bindings _ -> map fst bindings | ||
Opaleye.Rebind True bindings query -> | ||
map fst bindings <> | ||
extractSymbols query | ||
Opaleye.ForUpdate query -> extractSymbols query | ||
zipOpaleyeWith f (Query a) (Query b) = Query $ liftA2 (zipping f) a b | ||
|
||
|
||
mapping :: () | ||
=> (Opaleye.Select a -> Opaleye.Select b) | ||
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b) | ||
mapping f q@(Opaleye.QueryArr qa) = Opaleye.QueryArr $ \(_, query, tag) -> | ||
let | ||
((m, _), _, _) = qa ((), query, tag) | ||
Opaleye.QueryArr qa' = (m,) <$> f (snd <$> q) | ||
in | ||
qa' ((), query, tag) | ||
|
||
|
||
zipping :: Semigroup m | ||
=> (Opaleye.Select a -> Opaleye.Select b -> Opaleye.Select c) | ||
-> Opaleye.Select (m, a) -> Opaleye.Select (m, b) -> Opaleye.Select (m, c) | ||
zipping f q@(Opaleye.QueryArr qa) q'@(Opaleye.QueryArr qa') = | ||
Opaleye.QueryArr $ \(_, query, tag) -> | ||
let | ||
((m, _), _, _) = qa ((), query, tag) | ||
((m', _), _, _) = qa' ((), query, tag) | ||
m'' = m <> m' | ||
Opaleye.QueryArr qa'' = (m'',) <$> f (snd <$> q) (snd <$> q') | ||
in | ||
qa'' ((), query, tag) |