{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Database.Relational.Relation
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module integrate monadic operations to compose complex queries
-- with re-usable Relation type.
module Database.Relational.Relation (
  -- * Relation type
  table, derivedRelation, tableOf,
  relation, relation',
  aggregateRelation, aggregateRelation',

  UniqueRelation,
  unsafeUnique, unUnique,

  uniqueRelation', aggregatedUnique,

  -- * Query using relation
  query, queryMaybe, queryList, queryList', queryScalar, queryScalar',
  uniqueQuery', uniqueQueryMaybe',
  ) where

import Control.Applicative ((<$>))

import Database.Relational.Internal.ContextType (Flat, Aggregated)
import Database.Relational.SqlSyntax (NodeAttr(Just', Maybe), Record, )

import Database.Relational.Monad.BaseType
  (ConfigureQuery, qualifyQuery,
   Relation, unsafeTypeRelation, untypeRelation, relationWidth)
import Database.Relational.Monad.Class
  (MonadQualify (liftQualify), MonadQuery (query', queryMaybe'), )
import Database.Relational.Monad.Simple (QuerySimple, SimpleQuery)
import qualified Database.Relational.Monad.Simple as Simple
import Database.Relational.Monad.Aggregate (QueryAggregate, AggregatedQuery)
import qualified Database.Relational.Monad.Aggregate as Aggregate
import Database.Relational.Monad.Unique (QueryUnique, unsafeUniqueSubQuery)
import qualified Database.Relational.Monad.Unique as Unique
import Database.Relational.Table (Table, TableDerivable, derivedTable)
import qualified Database.Relational.Table as Table
import Database.Relational.Scalar (ScalarDegree)
import Database.Relational.Pi (Pi)
import Database.Relational.Record (RecordList)
import qualified Database.Relational.Record as Record
import Database.Relational.Projectable
  (PlaceHolders, unitPlaceHolder, unsafeAddPlaceHolders, unsafePlaceHolders, )


-- | Simple 'Relation' from 'Table'.
table :: Table r -> Relation () r
table :: forall r. Table r -> Relation () r
table = forall p r. ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. Table r -> SubQuery
Table.toSubQuery

-- | Inferred 'Relation'.
derivedRelation :: TableDerivable r => Relation () r
derivedRelation :: forall r. TableDerivable r => Relation () r
derivedRelation =  forall r. Table r -> Relation () r
table forall r. TableDerivable r => Table r
derivedTable

-- | Interface to derive 'Table' type object.
tableOf :: TableDerivable r => Relation () r -> Table r
tableOf :: forall r. TableDerivable r => Relation () r -> Table r
tableOf =  forall a b. a -> b -> a
const forall r. TableDerivable r => Table r
derivedTable

placeHoldersFromRelation :: Relation p r -> PlaceHolders p
placeHoldersFromRelation :: forall p r. Relation p r -> PlaceHolders p
placeHoldersFromRelation =  forall a b. a -> b -> a
const forall p. PlaceHolders p
unsafePlaceHolders

-- | Join sub-query. Query result is not 'Maybe'.
query :: (MonadQualify ConfigureQuery m, MonadQuery m)
      => Relation () r
      -> m (Record Flat r)
query :: forall (m :: * -> *) r.
(MonadQualify (Qualify (QueryConfig Identity)) m, MonadQuery m) =>
Relation () r -> m (Record Flat r)
query =  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query'

-- | Join sub-query. Query result is 'Maybe'.
--   The combinations of 'query' and 'queryMaybe' express
--   inner joins, left outer joins, right outer joins, and full outer joins.
--   Here is an example of a right outer join:
--
-- @
--   outerJoin = relation $ do
--     e <- queryMaybe employee
--     d <- query department
--     on $ e ?! E.deptId' .=. just (d ! D.deptId')
--     return $ (,) |$| e |*| d
-- @
queryMaybe :: (MonadQualify ConfigureQuery m, MonadQuery m)
           => Relation () r
           -> m (Record Flat (Maybe r))
queryMaybe :: forall (m :: * -> *) r.
(MonadQualify (Qualify (QueryConfig Identity)) m, MonadQuery m) =>
Relation () r -> m (Record Flat (Maybe r))
queryMaybe =  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat (Maybe r))
queryMaybe'

queryList0 :: MonadQualify ConfigureQuery m => Relation p r -> m (RecordList (Record c) r)
queryList0 :: forall (m :: * -> *) p r c.
MonadQualify (Qualify (QueryConfig Identity)) m =>
Relation p r -> m (RecordList (Record c) r)
queryList0 =  forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (p :: * -> *) t. SubQuery -> RecordList p t
Record.unsafeListFromSubQuery
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation

-- | List sub-query, for /IN/ and /EXIST/ with place-holder parameter 'p'.
queryList' :: MonadQualify ConfigureQuery m
           => Relation p r
           -> m (PlaceHolders p, RecordList (Record c) r)
queryList' :: forall (m :: * -> *) p r c.
MonadQualify (Qualify (QueryConfig Identity)) m =>
Relation p r -> m (PlaceHolders p, RecordList (Record c) r)
queryList' Relation p r
rel = do
  RecordList (Record c) r
ql <- forall (m :: * -> *) p r c.
MonadQualify (Qualify (QueryConfig Identity)) m =>
Relation p r -> m (RecordList (Record c) r)
queryList0 Relation p r
rel
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall p r. Relation p r -> PlaceHolders p
placeHoldersFromRelation Relation p r
rel, RecordList (Record c) r
ql)

-- | List sub-query, for /IN/ and /EXIST/.
queryList :: MonadQualify ConfigureQuery m
          => Relation () r
          -> m (RecordList (Record c) r)
queryList :: forall (m :: * -> *) r c.
MonadQualify (Qualify (QueryConfig Identity)) m =>
Relation () r -> m (RecordList (Record c) r)
queryList =  forall (m :: * -> *) p r c.
MonadQualify (Qualify (QueryConfig Identity)) m =>
Relation p r -> m (RecordList (Record c) r)
queryList0

addUnitPH :: Functor f => f t -> f (PlaceHolders (), t)
addUnitPH :: forall (f :: * -> *) t. Functor f => f t -> f (PlaceHolders (), t)
addUnitPH =  ((,) PlaceHolders ()
unitPlaceHolder forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

-- | Finalize 'QuerySimple' monad and generate 'Relation' with place-holder parameter 'p'.
relation' :: SimpleQuery p r -> Relation p r
relation' :: forall p r. SimpleQuery p r -> Relation p r
relation' =  forall p r. ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. SimpleQuery p r -> ConfigureQuery SubQuery
Simple.toSubQuery

-- | Finalize 'QuerySimple' monad and generate 'Relation'.
relation :: QuerySimple (Record Flat r) -> Relation () r
relation :: forall r. QuerySimple (Record Flat r) -> Relation () r
relation =  forall p r. SimpleQuery p r -> Relation p r
relation' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) t. Functor f => f t -> f (PlaceHolders (), t)
addUnitPH

-- | Finalize 'QueryAggregate' monad and generate 'Relation' with place-holder parameter 'p'.
aggregateRelation' :: AggregatedQuery p r -> Relation p r
aggregateRelation' :: forall p r. AggregatedQuery p r -> Relation p r
aggregateRelation' =  forall p r. ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. AggregatedQuery p r -> ConfigureQuery SubQuery
Aggregate.toSubQuery

-- | Finalize 'QueryAggregate' monad and generate 'Relation'.
aggregateRelation :: QueryAggregate (Record Aggregated r) -> Relation () r
aggregateRelation :: forall r. QueryAggregate (Record Aggregated r) -> Relation () r
aggregateRelation =  forall p r. AggregatedQuery p r -> Relation p r
aggregateRelation' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) t. Functor f => f t -> f (PlaceHolders (), t)
addUnitPH


-- | Unique relation type to compose scalar queries.
newtype UniqueRelation p c r =  Unique (Relation p r)

-- | Unsafely specify unique relation.
unsafeUnique :: Relation p r -> UniqueRelation p c r
unsafeUnique :: forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique =  forall p c r. Relation p r -> UniqueRelation p c r
Unique

-- | Discard unique attribute.
unUnique :: UniqueRelation p c r -> Relation p r
unUnique :: forall p c r. UniqueRelation p c r -> Relation p r
unUnique (Unique Relation p r
r) = Relation p r
r

-- | Basic monadic join operation using 'MonadQuery'.
uniqueQueryWithAttr :: NodeAttr
                    -> UniqueRelation p c r
                    -> QueryUnique (PlaceHolders p, Record c r)
uniqueQueryWithAttr :: forall p c r.
NodeAttr
-> UniqueRelation p c r -> QueryUnique (PlaceHolders p, Record c r)
uniqueQueryWithAttr NodeAttr
attr = forall (f :: * -> *) a p. Functor f => f a -> f (PlaceHolders p, a)
unsafeAddPlaceHolders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {p} {c} {r} {c'} {r}.
UniqueRelation p c r -> QueryUnique (Record c' r)
run where
  run :: UniqueRelation p c r -> QueryUnique (Record c' r)
run UniqueRelation p c r
rel = do
    Qualified SubQuery
q <- forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify forall a b. (a -> b) -> a -> b
$ do
      SubQuery
sq <- forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation (forall p c r. UniqueRelation p c r -> Relation p r
unUnique UniqueRelation p c r
rel)
      forall a. a -> ConfigureQuery (Qualified a)
qualifyQuery SubQuery
sq
    forall c r c'. Record c r -> Record c' r
Record.unsafeChangeContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c r.
NodeAttr -> Qualified SubQuery -> QueryUnique (Record c r)
unsafeUniqueSubQuery NodeAttr
attr Qualified SubQuery
q

-- | Join unique sub-query with place-holder parameter 'p'.
uniqueQuery' :: UniqueRelation p c r
             -> QueryUnique (PlaceHolders p, Record c r)
uniqueQuery' :: forall p c r.
UniqueRelation p c r -> QueryUnique (PlaceHolders p, Record c r)
uniqueQuery' = forall p c r.
NodeAttr
-> UniqueRelation p c r -> QueryUnique (PlaceHolders p, Record c r)
uniqueQueryWithAttr NodeAttr
Just'

-- | Join unique sub-query with place-holder parameter 'p'. Query result is 'Maybe'.
uniqueQueryMaybe' :: UniqueRelation p c r
                  -> QueryUnique (PlaceHolders p, Record c (Maybe r))
uniqueQueryMaybe' :: forall p c r.
UniqueRelation p c r
-> QueryUnique (PlaceHolders p, Record c (Maybe r))
uniqueQueryMaybe' UniqueRelation p c r
pr =  do
  (PlaceHolders p
ph, Record c r
pj) <- forall p c r.
NodeAttr
-> UniqueRelation p c r -> QueryUnique (PlaceHolders p, Record c r)
uniqueQueryWithAttr NodeAttr
Maybe UniqueRelation p c r
pr
  forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders p
ph, forall c r. Record c r -> Record c (Maybe r)
Record.just Record c r
pj)

-- | Finalize 'QueryUnique' monad and generate 'UniqueRelation'.
uniqueRelation' :: QueryUnique (PlaceHolders p, Record c r) -> UniqueRelation p c r
uniqueRelation' :: forall p c r.
QueryUnique (PlaceHolders p, Record c r) -> UniqueRelation p c r
uniqueRelation' =  forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. ConfigureQuery SubQuery -> Relation p r
unsafeTypeRelation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p c r.
QueryUnique (PlaceHolders p, Record c r) -> ConfigureQuery SubQuery
Unique.toSubQuery

-- | Aggregated 'UniqueRelation'.
aggregatedUnique :: Relation ph r
                 -> Pi r a
                 -> (Record Flat a -> Record Aggregated b)
                 -> UniqueRelation ph Flat b
aggregatedUnique :: forall ph r a b.
Relation ph r
-> Pi r a
-> (Record Flat a -> Record Aggregated b)
-> UniqueRelation ph Flat b
aggregatedUnique Relation ph r
rel Pi r a
k Record Flat a -> Record Aggregated b
ag = forall p r c. Relation p r -> UniqueRelation p c r
unsafeUnique forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p r. AggregatedQuery p r -> Relation p r
aggregateRelation' forall a b. (a -> b) -> a -> b
$ do
  (PlaceHolders ph
ph, Record Flat r
a) <- forall (m :: * -> *) p r.
MonadQuery m =>
Relation p r -> m (PlaceHolders p, Record Flat r)
query' Relation ph r
rel
  forall (m :: * -> *) a. Monad m => a -> m a
return (PlaceHolders ph
ph, Record Flat a -> Record Aggregated b
ag forall a b. (a -> b) -> a -> b
$ forall a c b.
PersistableRecordWidth a -> Record c a -> Pi a b -> Record c b
Record.wpi (forall p r. Relation p r -> PersistableRecordWidth r
relationWidth Relation ph r
rel) Record Flat r
a Pi r a
k)

-- | Scalar sub-query with place-holder parameter 'p'.
queryScalar' :: (MonadQualify ConfigureQuery m, ScalarDegree r)
             => UniqueRelation p c r
             -> m (PlaceHolders p, Record c (Maybe r))
queryScalar' :: forall (m :: * -> *) r p c.
(MonadQualify (Qualify (QueryConfig Identity)) m,
 ScalarDegree r) =>
UniqueRelation p c r -> m (PlaceHolders p, Record c (Maybe r))
queryScalar' UniqueRelation p c r
ur =
  forall (f :: * -> *) a p. Functor f => f a -> f (PlaceHolders p, a)
unsafeAddPlaceHolders forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (q :: * -> *) (m :: * -> *) a.
MonadQualify q m =>
q a -> m a
liftQualify forall a b. (a -> b) -> a -> b
$
  forall c t. SubQuery -> Record c t
Record.unsafeFromScalarSubQuery forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p r. Relation p r -> ConfigureQuery SubQuery
untypeRelation (forall p c r. UniqueRelation p c r -> Relation p r
unUnique UniqueRelation p c r
ur)

-- | Scalar sub-query.
queryScalar :: (MonadQualify ConfigureQuery m, ScalarDegree r)
            => UniqueRelation () c r
            -> m (Record c (Maybe r))
queryScalar :: forall (m :: * -> *) r c.
(MonadQualify (Qualify (QueryConfig Identity)) m,
 ScalarDegree r) =>
UniqueRelation () c r -> m (Record c (Maybe r))
queryScalar =  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r p c.
(MonadQualify (Qualify (QueryConfig Identity)) m,
 ScalarDegree r) =>
UniqueRelation p c r -> m (PlaceHolders p, Record c (Maybe r))
queryScalar'