-- |
-- Module      : Database.Relational.Set
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module defines set operations on monadic Relation operations.
module Database.Relational.Set (
  -- * Direct style join
  JoinRestriction,
  inner', left', right', full',
  inner, left, right, full,
  on',

  -- * Relation append
  union, except, intersect,
  unionAll, exceptAll, intersectAll,

  union', except', intersect',
  unionAll', exceptAll', intersectAll',
  ) where

import Data.Functor.ProductIsomorphic ((|$|), (|*|))

import Database.Relational.Internal.ContextType (Flat)
import Database.Relational.SqlSyntax
  (Duplication (Distinct, All), SubQuery, Predicate, Record, )
import qualified Database.Relational.SqlSyntax as Syntax

import Database.Relational.Monad.BaseType
  (Relation, unsafeTypeRelation, untypeRelation, )
import Database.Relational.Monad.Class (MonadQuery (query', queryMaybe'), on)
import Database.Relational.Monad.Simple (QuerySimple)
import Database.Relational.Projectable (PlaceHolders)
import Database.Relational.Relation (relation', relation, query, queryMaybe, )


-- | Restriction predicate function type for direct style join operator,
--   used on predicates of direct join style as follows.
--
-- @
--   do xy <- query $
--            relX `inner` relY `on'` [ \x y -> ... ] -- this lambda form has JoinRestriction type
--      ...
-- @
type JoinRestriction a b = Record Flat a -> Record Flat b -> Predicate Flat

-- | Basic direct join operation with place-holder parameters.
join' :: (qa -> QuerySimple (PlaceHolders pa, Record Flat a))
      -> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
      -> qa
      -> qb
      -> [JoinRestriction a b]
      -> Relation (pa, pb) (a, b)
join' :: forall qa pa a qb pb b.
(qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' qa -> QuerySimple (PlaceHolders pa, Record Flat a)
qL qb -> QuerySimple (PlaceHolders pb, Record Flat b)
qR qa
r0 qb
r1 [JoinRestriction a b]
rs = forall p r. SimpleQuery p r -> Relation p r
relation' forall a b. (a -> b) -> a -> b
$ do
  (PlaceHolders pa
ph0, Record Flat a
pj0) <- qa -> QuerySimple (PlaceHolders pa, Record Flat a)
qL qa
r0
  (PlaceHolders pb
ph1, Record Flat b
pj1) <- qb -> QuerySimple (PlaceHolders pb, Record Flat b)
qR qb
r1
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ forall (m :: * -> *). MonadQuery m => Predicate Flat -> m ()
on forall a b. (a -> b) -> a -> b
$ JoinRestriction a b
f Record Flat a
pj0 Record Flat b
pj1 | JoinRestriction a b
f <- [JoinRestriction a b]
rs ]
  forall (m :: * -> *) a. Monad m => a -> m a
return ((,) forall (f :: * -> *) a b.
(ProductIsoFunctor f, ProductConstructor (a -> b)) =>
(a -> b) -> f a -> f b
|$| PlaceHolders pa
ph0 forall (f :: * -> *) a b.
ProductIsoApplicative f =>
f (a -> b) -> f a -> f b
|*| PlaceHolders pb
ph1, (,) forall (f :: * -> *) a b.
(ProductIsoFunctor f, ProductConstructor (a -> b)) =>
(a -> b) -> f a -> f b
|$| Record Flat a
pj0 forall (f :: * -> *) a b.
ProductIsoApplicative f =>
f (a -> b) -> f a -> f b
|*| Record Flat b
pj1)

-- | Direct inner join with place-holder parameters.
inner' :: Relation pa a            -- ^ Left query to join
       -> Relation pb b            -- ^ Right query to join
       -> [JoinRestriction a b]    -- ^ Join restrictions
       -> Relation (pa, pb) (a, b) -- ^ Result joined relation
inner' :: forall pa a pb b.
Relation pa a
-> Relation pb b
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
inner' =  forall qa pa a qb pb b.
(qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'

-- | Direct left outer join with place-holder parameters.
left' :: Relation pa a                  -- ^ Left query to join
      -> Relation pb b                  -- ^ Right query to join
      -> [JoinRestriction a (Maybe b)]  -- ^ Join restrictions
      -> Relation (pa, pb) (a, Maybe b) -- ^ Result joined relation
left' :: forall pa a pb b.
Relation pa a
-> Relation pb b
-> [JoinRestriction a (Maybe b)]
-> Relation (pa, pb) (a, Maybe b)
left'  =  forall qa pa a qb pb b.
(qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'

-- | Direct right outer join with place-holder parameters.
right' :: Relation pa a                 -- ^ Left query to join
       -> Relation pb b                 -- ^ Right query to join
       -> [JoinRestriction (Maybe a) b] -- ^ Join restrictions
       -> Relation (pa, pb)(Maybe a, b) -- ^ Result joined relation
right' :: forall pa a pb b.
Relation pa a
-> Relation pb b
-> [JoinRestriction (Maybe a) b]
-> Relation (pa, pb) (Maybe a, b)
right' =  forall qa pa a qb pb b.
(qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'

-- | Direct full outer join with place-holder parameters.
full' :: Relation pa a                         -- ^ Left query to join
      -> Relation pb b                         -- ^ Right query to join
      -> [JoinRestriction (Maybe a) (Maybe b)] -- ^ Join restrictions
      -> Relation (pa, pb) (Maybe a, Maybe b)  -- ^ Result joined relation
full' :: forall pa a pb b.
Relation pa a
-> Relation pb b
-> [JoinRestriction (Maybe a) (Maybe b)]
-> Relation (pa, pb) (Maybe a, Maybe b)
full'  =  forall qa pa a qb pb b.
(qa -> QuerySimple (PlaceHolders pa, Record Flat a))
-> (qb -> QuerySimple (PlaceHolders pb, Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation (pa, pb) (a, b)
join' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe' forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'

-- | Basic direct join operation.
join_ :: (qa -> QuerySimple (Record Flat a))
      -> (qb -> QuerySimple (Record Flat b))
      -> qa
      -> qb
      -> [JoinRestriction a b]
      -> Relation () (a, b)
join_ :: forall qa a qb b.
(qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ qa -> QuerySimple (Record Flat a)
qL qb -> QuerySimple (Record Flat b)
qR qa
r0 qb
r1 [JoinRestriction a b]
rs = forall r. QuerySimple (Record Flat r) -> Relation () r
relation forall a b. (a -> b) -> a -> b
$ do
  Record Flat a
pj0 <- qa -> QuerySimple (Record Flat a)
qL qa
r0
  Record Flat b
pj1 <- qb -> QuerySimple (Record Flat b)
qR qb
r1
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ forall (m :: * -> *). MonadQuery m => Predicate Flat -> m ()
on forall a b. (a -> b) -> a -> b
$ JoinRestriction a b
f Record Flat a
pj0 Record Flat b
pj1 | JoinRestriction a b
f <- [JoinRestriction a b]
rs ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b.
(ProductIsoFunctor f, ProductConstructor (a -> b)) =>
(a -> b) -> f a -> f b
|$| Record Flat a
pj0 forall (f :: * -> *) a b.
ProductIsoApplicative f =>
f (a -> b) -> f a -> f b
|*| Record Flat b
pj1

-- | Direct inner join.
inner :: Relation () a         -- ^ Left query to join
      -> Relation () b         -- ^ Right query to join
      -> [JoinRestriction a b] -- ^ Join restrictions
      -> Relation () (a, b)    -- ^ Result joined relation
inner :: forall a b.
Relation () a
-> Relation () b -> [JoinRestriction a b] -> Relation () (a, b)
inner =  forall qa a qb b.
(qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query

-- | Direct left outer join.
left :: Relation () a                 -- ^ Left query to join
     -> Relation () b                 -- ^ Right query to join
     -> [JoinRestriction a (Maybe b)] -- ^ Join restrictions
     -> Relation () (a, Maybe b)      -- ^ Result joined relation
left :: forall a b.
Relation () a
-> Relation () b
-> [JoinRestriction a (Maybe b)]
-> Relation () (a, Maybe b)
left  =  forall qa a qb b.
(qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat (Maybe r))
queryMaybe

-- | Direct right outer join.
right :: Relation () a                 -- ^ Left query to join
      -> Relation () b                 -- ^ Right query to join
      -> [JoinRestriction (Maybe a) b] -- ^ Join restrictions
      -> Relation () (Maybe a, b)      -- ^ Result joined relation
right :: forall a b.
Relation () a
-> Relation () b
-> [JoinRestriction (Maybe a) b]
-> Relation () (Maybe a, b)
right =  forall qa a qb b.
(qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat (Maybe r))
queryMaybe forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query

-- | Direct full outer join.
full :: Relation () a                         -- ^ Left query to join
     -> Relation () b                         -- ^ Right query to join
     -> [JoinRestriction (Maybe a) (Maybe b)] -- ^ Join restrictions
     -> Relation () (Maybe a, Maybe b)        -- ^ Result joined relation
full :: forall a b.
Relation () a
-> Relation () b
-> [JoinRestriction (Maybe a) (Maybe b)]
-> Relation () (Maybe a, Maybe b)
full  =  forall qa a qb b.
(qa -> QuerySimple (Record Flat a))
-> (qb -> QuerySimple (Record Flat b))
-> qa
-> qb
-> [JoinRestriction a b]
-> Relation () (a, b)
join_ forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat (Maybe r))
queryMaybe forall (m :: * -> *) r.
(MonadQualify ConfigureQuery m, MonadQuery m) =>
Relation () r -> m (Record Flat (Maybe r))
queryMaybe

-- | Apply restriction for direct join style.
on' :: ([JoinRestriction a b] -> Relation pc (a, b))
    -> [JoinRestriction a b]
    -> Relation pc (a, b)
on' :: forall a b pc.
([JoinRestriction a b] -> Relation pc (a, b))
-> [JoinRestriction a b] -> Relation pc (a, b)
on' =  forall a b. (a -> b) -> a -> b
($)

infixl 8 `inner'`, `left'`, `right'`, `full'`, `inner`, `left`, `right`, `full`, `on'`

unsafeLiftAppend :: (SubQuery -> SubQuery -> SubQuery)
           -> Relation p a
           -> Relation q a
           -> Relation r a
unsafeLiftAppend :: forall p a q r.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation r a
unsafeLiftAppend SubQuery -> SubQuery -> SubQuery
op Relation p a
a0 Relation q a
a1 = forall p r. ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation forall a b. (a -> b) -> a -> b
$ do
  SubQuery
s0 <- forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation Relation p a
a0
  SubQuery
s1 <- forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation Relation q a
a1
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SubQuery
s0 SubQuery -> SubQuery -> SubQuery
`op` SubQuery
s1

liftAppend :: (SubQuery -> SubQuery -> SubQuery)
           -> Relation () a
           -> Relation () a
           -> Relation () a
liftAppend :: forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend = forall p a q r.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation r a
unsafeLiftAppend

-- | Union of two relations.
union     :: Relation () a -> Relation () a -> Relation () a
union :: forall a. Relation () a -> Relation () a -> Relation () a
union     =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.union Duplication
Distinct

-- | Union of two relations. Not distinct.
unionAll  :: Relation () a -> Relation () a -> Relation () a
unionAll :: forall a. Relation () a -> Relation () a -> Relation () a
unionAll  =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.union Duplication
All

-- | Subtraction of two relations.
except    :: Relation () a -> Relation () a -> Relation () a
except :: forall a. Relation () a -> Relation () a -> Relation () a
except    =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.except Duplication
Distinct

-- | Subtraction of two relations. Not distinct.
exceptAll :: Relation () a -> Relation () a -> Relation () a
exceptAll :: forall a. Relation () a -> Relation () a -> Relation () a
exceptAll =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.except Duplication
All

-- | Intersection of two relations.
intersect :: Relation () a -> Relation () a -> Relation () a
intersect :: forall a. Relation () a -> Relation () a -> Relation () a
intersect =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.intersect Duplication
Distinct

-- | Intersection of two relations. Not distinct.
intersectAll :: Relation () a -> Relation () a -> Relation () a
intersectAll :: forall a. Relation () a -> Relation () a -> Relation () a
intersectAll =  forall a.
(SubQuery -> SubQuery -> SubQuery)
-> Relation () a -> Relation () a -> Relation () a
liftAppend forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.intersect Duplication
All

liftAppend' :: (SubQuery -> SubQuery -> SubQuery)
            -> Relation p a
            -> Relation q a
            -> Relation (p, q) a
liftAppend' :: forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' = forall p a q r.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation r a
unsafeLiftAppend

-- | Union of two relations with place-holder parameters.
union'     :: Relation p a -> Relation q a -> Relation (p, q) a
union' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
union'     =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.union Duplication
Distinct

-- | Union of two relations with place-holder parameters. Not distinct.
unionAll' :: Relation p a -> Relation q a -> Relation (p, q) a
unionAll' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
unionAll'  =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.union Duplication
All

-- | Subtraction of two relations with place-holder parameters.
except'    :: Relation p a -> Relation q a -> Relation (p, q) a
except' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
except'    =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.except Duplication
Distinct

-- | Subtraction of two relations with place-holder parameters. Not distinct.
exceptAll' :: Relation p a -> Relation q a -> Relation (p, q) a
exceptAll' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
exceptAll' =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.except Duplication
All

-- | Intersection of two relations with place-holder parameters.
intersect' :: Relation p a -> Relation q a -> Relation (p, q) a
intersect' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
intersect' =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.intersect Duplication
Distinct

-- | Intersection of two relations with place-holder parameters. Not distinct.
intersectAll' :: Relation p a -> Relation q a -> Relation (p, q) a
intersectAll' :: forall p a q. Relation p a -> Relation q a -> Relation (p, q) a
intersectAll' =  forall p a q.
(SubQuery -> SubQuery -> SubQuery)
-> Relation p a -> Relation q a -> Relation (p, q) a
liftAppend' forall a b. (a -> b) -> a -> b
$ Duplication -> SubQuery -> SubQuery -> SubQuery
Syntax.intersect Duplication
All

infixl 7 `union`, `except`, `unionAll`, `exceptAll`
infixl 8 `intersect`, `intersectAll`
infixl 7 `union'`, `except'`, `unionAll'`, `exceptAll'`
infixl 8 `intersect'`, `intersectAll'`