{-# LANGUAGE LambdaCase #-}
module Opaleye.Internal.Optimize where
import Prelude hiding (product)
import qualified Opaleye.Internal.PrimQuery as PQ
import Opaleye.Internal.Helpers ((.:))
import qualified Data.List.NonEmpty as NEL
import Control.Applicative (liftA2)
import Control.Arrow (first)
optimize :: PQ.PrimQuery' a -> PQ.PrimQuery' a
optimize :: forall a. PrimQuery' a -> PrimQuery' a
optimize = forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
PQ.foldPrimQuery (forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
noSingletonProduct
forall a q p.
PrimQueryFoldP a (PrimQuery' a) q
-> PrimQueryFoldP a p (PrimQuery' a) -> PrimQueryFoldP a p q
`PQ.composePrimQueryFold` forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
mergeProduct
forall a q p.
PrimQueryFoldP a (PrimQuery' a) q
-> PrimQueryFoldP a p (PrimQuery' a) -> PrimQueryFoldP a p q
`PQ.composePrimQueryFold` forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
removeUnit)
removeUnit :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
removeUnit :: forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
removeUnit = forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
PQ.primQueryFoldDefault { product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.product = forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product }
where product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product NonEmpty (Lateral, PrimQuery' a)
pqs = forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.Product NonEmpty (Lateral, PrimQuery' a)
pqs'
where pqs' :: NonEmpty (Lateral, PrimQuery' a)
pqs' = case forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty (forall a. (a -> Bool) -> NonEmpty a -> [a]
NEL.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrimQuery' a -> Bool
PQ.isUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (Lateral, PrimQuery' a)
pqs) of
Maybe (NonEmpty (Lateral, PrimQuery' a))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. PrimQuery' a
PQ.Unit)
Just NonEmpty (Lateral, PrimQuery' a)
xs -> NonEmpty (Lateral, PrimQuery' a)
xs
mergeProduct :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
mergeProduct :: forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
mergeProduct = forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
PQ.primQueryFoldDefault { product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.product = forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product }
where product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product NonEmpty (Lateral, PrimQuery' a)
pqs [PrimExpr]
pes = forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.Product NonEmpty (Lateral, PrimQuery' a)
pqs' ([PrimExpr]
pes forall a. [a] -> [a] -> [a]
++ [PrimExpr]
pes')
where pqs' :: NonEmpty (Lateral, PrimQuery' a)
pqs' = NonEmpty (Lateral, PrimQuery' a)
pqs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}.
(Lateral, PrimQuery' a) -> NonEmpty (Lateral, PrimQuery' a)
queries
queries :: (Lateral, PrimQuery' a) -> NonEmpty (Lateral, PrimQuery' a)
queries (Lateral
lat, PQ.Product NonEmpty (Lateral, PrimQuery' a)
qs [PrimExpr]
_) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Lateral
lat forall a. Semigroup a => a -> a -> a
<>)) NonEmpty (Lateral, PrimQuery' a)
qs
queries (Lateral, PrimQuery' a)
q = forall (m :: * -> *) a. Monad m => a -> m a
return (Lateral, PrimQuery' a)
q
pes' :: [PrimExpr]
pes' = forall a. NonEmpty a -> [a]
NEL.toList NonEmpty (Lateral, PrimQuery' a)
pqs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {a}. (a, PrimQuery' a) -> [PrimExpr]
conds
conds :: (a, PrimQuery' a) -> [PrimExpr]
conds (a
_lat, PQ.Product NonEmpty (Lateral, PrimQuery' a)
_ [PrimExpr]
cs) = [PrimExpr]
cs
conds (a, PrimQuery' a)
_ = []
noSingletonProduct :: PQ.PrimQueryFoldP a (PQ.PrimQuery' a) (PQ.PrimQuery' a)
noSingletonProduct :: forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
noSingletonProduct = forall a. PrimQueryFoldP a (PrimQuery' a) (PrimQuery' a)
PQ.primQueryFoldDefault { product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.product = forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product }
where product :: NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
product NonEmpty (Lateral, PrimQuery' a)
pqs [PrimExpr]
conds = case (forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NEL.uncons NonEmpty (Lateral, PrimQuery' a)
pqs, [PrimExpr]
conds) of
(((Lateral
PQ.NonLateral, PrimQuery' a
x), Maybe (NonEmpty (Lateral, PrimQuery' a))
Nothing), []) -> PrimQuery' a
x
(((Lateral, PrimQuery' a),
Maybe (NonEmpty (Lateral, PrimQuery' a))),
[PrimExpr])
_ -> forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.Product NonEmpty (Lateral, PrimQuery' a)
pqs [PrimExpr]
conds
removeEmpty :: PQ.PrimQuery' a -> Maybe (PQ.PrimQuery' b)
removeEmpty :: forall a b. PrimQuery' a -> Maybe (PrimQuery' b)
removeEmpty = forall a p. PrimQueryFold' a p -> PrimQuery' a -> p
PQ.foldPrimQuery PQ.PrimQueryFold {
unit :: Maybe (PrimQuery' b)
PQ.unit = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. PrimQuery' a
PQ.Unit
, empty :: a -> Maybe (PrimQuery' b)
PQ.empty = forall a b. a -> b -> a
const forall a. Maybe a
Nothing
, baseTable :: TableIdentifier -> Bindings PrimExpr -> Maybe (PrimQuery' b)
PQ.baseTable = forall (m :: * -> *) a. Monad m => a -> m a
return forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: forall a. TableIdentifier -> Bindings PrimExpr -> PrimQuery' a
PQ.BaseTable
, product :: NonEmpty (Lateral, Maybe (PrimQuery' b))
-> [PrimExpr] -> Maybe (PrimQuery' b)
PQ.product = let sequenceOf :: ((a -> a) -> t) -> t
sequenceOf (a -> a) -> t
l = forall {a}. a -> a
traverseOf (a -> a) -> t
l forall {a}. a -> a
id
traverseOf :: a -> a
traverseOf = forall {a}. a -> a
id
_2 :: (a -> Maybe b) -> (Lateral, a) -> Maybe (Lateral, b)
_2 = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
in
\NonEmpty (Lateral, Maybe (PrimQuery' b))
x [PrimExpr]
y -> forall {a}.
NonEmpty (Lateral, PrimQuery' a) -> [PrimExpr] -> PrimQuery' a
PQ.Product forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a} {t}. ((a -> a) -> t) -> t
sequenceOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverseforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall {a} {b}.
(a -> Maybe b) -> (Lateral, a) -> Maybe (Lateral, b)
_2) NonEmpty (Lateral, Maybe (PrimQuery' b))
x
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [PrimExpr]
y
, aggregate :: Bindings (Aggregate' Symbol)
-> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.aggregate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Bindings (Aggregate' Symbol) -> PrimQuery' a -> PrimQuery' a
PQ.Aggregate
, window :: Bindings (WndwOp, Partition)
-> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.window = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Bindings (WndwOp, Partition) -> PrimQuery' a -> PrimQuery' a
PQ.Window
, distinctOnOrderBy :: Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.distinctOnOrderBy = \Maybe (NonEmpty PrimExpr)
mDistinctOns -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Maybe (NonEmpty PrimExpr)
-> [OrderExpr] -> PrimQuery' a -> PrimQuery' a
PQ.DistinctOnOrderBy Maybe (NonEmpty PrimExpr)
mDistinctOns
, limit :: LimitOp -> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.limit = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LimitOp -> PrimQuery' a -> PrimQuery' a
PQ.Limit
, join :: JoinType
-> PrimExpr
-> (Lateral, Maybe (PrimQuery' b))
-> (Lateral, Maybe (PrimQuery' b))
-> Maybe (PrimQuery' b)
PQ.join = \JoinType
jt PrimExpr
pe (Lateral, Maybe (PrimQuery' b))
pq1 (Lateral, Maybe (PrimQuery' b))
pq2 -> forall a.
JoinType
-> PrimExpr
-> (Lateral, PrimQuery' a)
-> (Lateral, PrimQuery' a)
-> PrimQuery' a
PQ.Join JoinType
jt PrimExpr
pe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Lateral, Maybe (PrimQuery' b))
pq1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Lateral, Maybe (PrimQuery' b))
pq2
, semijoin :: SemijoinType
-> Maybe (PrimQuery' b)
-> Maybe (PrimQuery' b)
-> Maybe (PrimQuery' b)
PQ.semijoin = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
SemijoinType -> PrimQuery' a -> PrimQuery' a -> PrimQuery' a
PQ.Semijoin
, exists :: Symbol -> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.exists = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Symbol -> PrimQuery' a -> PrimQuery' a
PQ.Exists
, values :: [Symbol] -> NonEmpty [PrimExpr] -> Maybe (PrimQuery' b)
PQ.values = forall (m :: * -> *) a. Monad m => a -> m a
return forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: forall a. [Symbol] -> NonEmpty [PrimExpr] -> PrimQuery' a
PQ.Values
, binary :: BinOp
-> (Maybe (PrimQuery' b), Maybe (PrimQuery' b))
-> Maybe (PrimQuery' b)
PQ.binary = \case
BinOp
PQ.Except -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) BinOp
PQ.Except
BinOp
PQ.Union -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just BinOp
PQ.Union
BinOp
PQ.Intersect -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) BinOp
PQ.Intersect
BinOp
PQ.ExceptAll -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary forall a. a -> Maybe a
Just (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) BinOp
PQ.ExceptAll
BinOp
PQ.UnionAll -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary forall a. a -> Maybe a
Just forall a. a -> Maybe a
Just BinOp
PQ.UnionAll
BinOp
PQ.IntersectAll -> forall {a}.
(PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) BinOp
PQ.IntersectAll
, label :: String -> Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.label = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> PrimQuery' a -> PrimQuery' a
PQ.Label
, relExpr :: PrimExpr -> [Symbol] -> Maybe (PrimQuery' b)
PQ.relExpr = forall (m :: * -> *) a. Monad m => a -> m a
return forall r z a b. (r -> z) -> (a -> b -> r) -> a -> b -> z
.: forall a. PrimExpr -> [Symbol] -> PrimQuery' a
PQ.RelExpr
, rebind :: Bool
-> Bindings PrimExpr
-> Maybe (PrimQuery' b)
-> Maybe (PrimQuery' b)
PQ.rebind = \Bool
b -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> Bindings PrimExpr -> PrimQuery' a -> PrimQuery' a
PQ.Rebind Bool
b
, forUpdate :: Maybe (PrimQuery' b) -> Maybe (PrimQuery' b)
PQ.forUpdate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. PrimQuery' a -> PrimQuery' a
PQ.ForUpdate
, with :: Recursive
-> Maybe Materialized
-> Symbol
-> [Symbol]
-> Maybe (PrimQuery' b)
-> Maybe (PrimQuery' b)
-> Maybe (PrimQuery' b)
PQ.with = \Recursive
recursive Maybe Materialized
materialized Symbol
name [Symbol]
cols -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a.
Recursive
-> Maybe Materialized
-> Symbol
-> [Symbol]
-> PrimQuery' a
-> PrimQuery' a
-> PrimQuery' a
PQ.With Recursive
recursive Maybe Materialized
materialized Symbol
name [Symbol]
cols)
}
where
binary :: (PrimQuery' a -> Maybe (PrimQuery' a))
-> (PrimQuery' a -> Maybe (PrimQuery' a))
-> BinOp
-> (Maybe (PrimQuery' a), Maybe (PrimQuery' a))
-> Maybe (PrimQuery' a)
binary PrimQuery' a -> Maybe (PrimQuery' a)
n1 PrimQuery' a -> Maybe (PrimQuery' a)
n2 BinOp
jj = \case
(Maybe (PrimQuery' a)
Nothing, Maybe (PrimQuery' a)
Nothing) -> forall a. Maybe a
Nothing
(Maybe (PrimQuery' a)
Nothing, Just PrimQuery' a
pq2) -> PrimQuery' a -> Maybe (PrimQuery' a)
n2 PrimQuery' a
pq2
(Just PrimQuery' a
pq1, Maybe (PrimQuery' a)
Nothing) -> PrimQuery' a -> Maybe (PrimQuery' a)
n1 PrimQuery' a
pq1
(Just PrimQuery' a
pq1, Just PrimQuery' a
pq2) -> forall a. a -> Maybe a
Just (forall a. BinOp -> (PrimQuery' a, PrimQuery' a) -> PrimQuery' a
PQ.Binary BinOp
jj (PrimQuery' a
pq1, PrimQuery' a
pq2))