-- |
-- Module      : Database.Relational.SqlSyntax.Join
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines product structure to compose SQL join.
module Database.Relational.SqlSyntax.Join (
  -- * Interfaces to manipulate ProductTree type
  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)


-- | Push new tree into product right term.
growRight :: Maybe (Node (DList (Predicate Flat)))            -- ^ Current tree
          -> (NodeAttr, ProductTree (DList (Predicate Flat))) -- ^ New tree to push into right
          -> Node (DList (Predicate Flat))                    -- ^ Result node
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))
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) = NodeAttr -> ProductTree rs -> Node rs
forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
naR ProductTree rs
q
  d (Just Node rs
l) (NodeAttr
naR, ProductTree rs
q) = NodeAttr -> ProductTree rs -> Node rs
forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
Just' (ProductTree rs -> Node rs) -> ProductTree rs -> Node rs
forall a b. (a -> b) -> a -> b
$ Node rs -> Node rs -> rs -> ProductTree rs
forall rs. Node rs -> Node rs -> rs -> ProductTree rs
Join Node rs
l (NodeAttr -> ProductTree rs -> Node rs
forall rs. NodeAttr -> ProductTree rs -> Node rs
Node NodeAttr
naR ProductTree rs
q) rs
forall a. Monoid a => a
mempty

-- | Push new leaf node into product right term.
growProduct :: Maybe (Node (DList (Predicate Flat)))  -- ^ Current tree
            -> (NodeAttr, (Bool, Qualified SubQuery)) -- ^ New leaf to push into right
            -> Node (DList (Predicate Flat))          -- ^ Result node
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, (Bool, Qualified SubQuery) -> ProductTree (DList (Predicate Flat))
forall rs. (Bool, Qualified SubQuery) -> ProductTree rs
Leaf (Bool, Qualified SubQuery)
q)

-- | Add restriction into top product of product tree.
restrictProduct' :: ProductTree (DList (Predicate Flat)) -- ^ Product to restrict
                 -> Predicate Flat                       -- ^ Restriction to add
                 -> ProductTree (DList (Predicate Flat)) -- ^ Result product
restrictProduct' :: ProductTree (DList (Predicate Flat))
-> Predicate Flat -> ProductTree (DList (Predicate Flat))
restrictProduct' =  ProductTree (DList (Predicate Flat))
-> Predicate Flat -> ProductTree (DList (Predicate Flat))
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' = Node (f a) -> Node (f a) -> f a -> ProductTree (f a)
forall rs. Node rs -> Node rs -> rs -> ProductTree rs
Join Node (f a)
lp Node (f a)
rp (f a
rs f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> a -> f 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' -- or error on compile

-- | Add restriction into top product of product tree node.
restrictProduct :: Node (DList (Predicate Flat)) -- ^ Target node which has product to restrict
                -> Predicate Flat                -- ^ Restriction to add
                -> Node (DList (Predicate Flat)) -- ^ Result node
restrictProduct :: Node (DList (Predicate Flat))
-> Predicate Flat -> Node (DList (Predicate Flat))
restrictProduct (Node NodeAttr
a ProductTree (DList (Predicate Flat))
t) Predicate Flat
e = NodeAttr
-> ProductTree (DList (Predicate Flat))
-> Node (DList (Predicate Flat))
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)