module Database.Relational.SqlSyntax.Join (
growProduct, restrictProduct,
) where
import Prelude hiding (and, product)
import Control.Applicative (pure)
import Data.Monoid ((<>), mempty)
import Data.DList (DList)
import Database.Relational.Internal.ContextType (Flat)
import Database.Relational.SqlSyntax.Types
(NodeAttr (..), ProductTree (..), Node (..), Qualified, SubQuery,
Predicate)
growRight :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, ProductTree (DList (Predicate Flat)))
-> Node (DList (Predicate Flat))
growRight :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, ProductTree (DList (Predicate Flat)))
-> Node (DList (Predicate Flat))
growRight = forall {rs}.
Monoid rs =>
Maybe (Node rs) -> (NodeAttr, ProductTree rs) -> Node rs
d where
d :: Maybe (Node rs) -> (NodeAttr, ProductTree rs) -> Node rs
d Maybe (Node rs)
Nothing (NodeAttr
naR, ProductTree rs
q) = forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
naR ProductTree rs
q
d (Just Node rs
l) (NodeAttr
naR, ProductTree rs
q) = forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
Just' forall a b. (a -> b) -> a -> b
$ forall rs. Node rs -> Node rs -> rs -> ProductTree rs
Join Node rs
l (forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
naR ProductTree rs
q) forall a. Monoid a => a
mempty
growProduct :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, (Bool, Qualified SubQuery))
-> Node (DList (Predicate Flat))
growProduct :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, (Bool, Qualified SubQuery))
-> Node (DList (Predicate Flat))
growProduct = Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, (Bool, Qualified SubQuery))
-> Node (DList (Predicate Flat))
match where
match :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, (Bool, Qualified SubQuery))
-> Node (DList (Predicate Flat))
match Maybe (Node (DList (Predicate Flat)))
t (NodeAttr
na, (Bool, Qualified SubQuery)
q) = Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, ProductTree (DList (Predicate Flat)))
-> Node (DList (Predicate Flat))
growRight Maybe (Node (DList (Predicate Flat)))
t (NodeAttr
na, forall rs. (Bool, Qualified SubQuery) -> ProductTree rs
Leaf (Bool, Qualified SubQuery)
q)
restrictProduct' :: ProductTree (DList (Predicate Flat))
-> Predicate Flat
-> ProductTree (DList (Predicate Flat))
restrictProduct' :: ProductTree (DList (Predicate Flat))
-> Predicate Flat -> ProductTree (DList (Predicate Flat))
restrictProduct' = forall {f :: * -> *} {a}.
(Semigroup (f a), Applicative f) =>
ProductTree (f a) -> a -> ProductTree (f a)
d where
d :: ProductTree (f a) -> a -> ProductTree (f a)
d (Join Node (f a)
lp Node (f a)
rp f a
rs) a
rs' = forall rs. Node rs -> Node rs -> rs -> ProductTree rs
Join Node (f a)
lp Node (f a)
rp (f a
rs forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
rs')
d leaf' :: ProductTree (f a)
leaf'@(Leaf (Bool, Qualified SubQuery)
_) a
_ = ProductTree (f a)
leaf'
restrictProduct :: Node (DList (Predicate Flat))
-> Predicate Flat
-> Node (DList (Predicate Flat))
restrictProduct :: Node (DList (Predicate Flat))
-> Predicate Flat -> Node (DList (Predicate Flat))
restrictProduct (Node NodeAttr
a ProductTree (DList (Predicate Flat))
t) Predicate Flat
e = forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
a (ProductTree (DList (Predicate Flat))
-> Predicate Flat -> ProductTree (DList (Predicate Flat))
restrictProduct' ProductTree (DList (Predicate Flat))
t Predicate Flat
e)