module Database.Relational.Query.Internal.Product (
growProduct, restrictProduct,
) where
import Prelude hiding (and, product)
import Control.Applicative (pure)
import Data.Monoid ((<>), mempty)
import Database.Relational.Query.Context (Flat)
import Database.Relational.Query.Internal.Sub
(NodeAttr (..), ProductTree (..), Node (..), Projection, Qualified, SubQuery,
ProductTreeBuilder, ProductBuilder)
growRight :: Maybe ProductBuilder
-> (NodeAttr, ProductTreeBuilder)
-> ProductBuilder
growRight = d where
d Nothing (naR, q) = Node naR q
d (Just l) (naR, q) = Node Just' $ Join l (Node naR q) mempty
growProduct :: Maybe ProductBuilder
-> (NodeAttr, Qualified SubQuery)
-> ProductBuilder
growProduct = match where
match t (na, q) = growRight t (na, Leaf q)
restrictProduct' :: ProductTreeBuilder
-> Projection Flat (Maybe Bool)
-> ProductTreeBuilder
restrictProduct' = d where
d (Join lp rp rs) rs' = Join lp rp (rs <> pure rs')
d leaf'@(Leaf _) _ = leaf'
restrictProduct :: ProductBuilder
-> Projection Flat (Maybe Bool)
-> ProductBuilder
restrictProduct (Node a t) e = Node a (restrictProduct' t e)