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 = d where
d Nothing (naR, q) = Node naR q
d (Just l) (naR, q) = Node Just' $ Join l (Node naR q) mempty
growProduct :: Maybe (Node (DList (Predicate Flat)))
-> (NodeAttr, (Bool, Qualified SubQuery))
-> Node (DList (Predicate Flat))
growProduct = match where
match t (na, q) = growRight t (na, Leaf q)
restrictProduct' :: ProductTree (DList (Predicate Flat))
-> Predicate Flat
-> ProductTree (DList (Predicate Flat))
restrictProduct' = d where
d (Join lp rp rs) rs' = Join lp rp (rs <> pure rs')
d leaf'@(Leaf _) _ = leaf'
restrictProduct :: Node (DList (Predicate Flat))
-> Predicate Flat
-> Node (DList (Predicate Flat))
restrictProduct (Node a t) e = Node a (restrictProduct' t e)