{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- |
-- Module      : Database.Relational.Monad.Aggregate
-- Copyright   : 2013-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module contains definitions about aggregated query type.
module Database.Relational.Monad.Aggregate (
  -- * Aggregated Query
  QueryAggregate,
  AggregatedQuery,

  toSQL,

  toSubQuery,

  Window, over
  ) where

import Data.Functor.Identity (Identity (runIdentity))
import Data.Monoid ((<>))

import Language.SQL.Keyword (Keyword(..))
import qualified Language.SQL.Keyword as SQL

import Database.Relational.Internal.ContextType (Flat, Aggregated, OverWindow)
import Database.Relational.SqlSyntax
  (Duplication, Record, SubQuery, Predicate, JoinProduct,
   OrderingTerm, composeOrderBy, aggregatedSubQuery,
   AggregateColumnRef, AggregateElem, composePartitionBy, )
import qualified Database.Relational.SqlSyntax as Syntax

import qualified Database.Relational.Record as Record
import Database.Relational.Projectable (PlaceHolders, SqlContext)
import Database.Relational.Monad.Class (MonadRestrict(..))
import Database.Relational.Monad.Trans.Restricting
  (Restrictings, restrictings, extractRestrict)
import Database.Relational.Monad.Trans.Aggregating
  (extractAggregateTerms, AggregatingSetT, PartitioningSet)
import Database.Relational.Monad.Trans.Ordering
  (Orderings, extractOrderingTerms)
import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Monad.Type (QueryCore, extractCore, OrderedQuery)


-- | Aggregated query monad type.
type QueryAggregate     = Orderings Aggregated (Restrictings Aggregated (AggregatingSetT QueryCore))

-- | Aggregated query type. 'AggregatedQuery' p r == 'QueryAggregate' ('PlaceHolders' p, 'Record' 'Aggregated' r).
type AggregatedQuery p r = OrderedQuery Aggregated (Restrictings Aggregated (AggregatingSetT QueryCore)) p r

-- | Partition monad type for partition-by clause.
type Window           c = Orderings c (PartitioningSet c)

-- | Restricted 'MonadRestrict' instance.
instance MonadRestrict Flat q => MonadRestrict Flat (Restrictings Aggregated q) where
  restrict :: Predicate Flat -> Restrictings Aggregated q ()
restrict = q () -> Restrictings Aggregated q ()
forall (m :: * -> *) a c. Monad m => m a -> Restrictings c m a
restrictings (q () -> Restrictings Aggregated q ())
-> (Predicate Flat -> q ())
-> Predicate Flat
-> Restrictings Aggregated q ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate Flat -> q ()
forall c (m :: * -> *). MonadRestrict c m => Predicate c -> m ()
restrict

extract :: AggregatedQuery p r
        -> ConfigureQuery (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
                               [Predicate Aggregated]),
                              [AggregateElem]),
                             [Predicate Flat]),
                            JoinProduct), Duplication)
extract :: AggregatedQuery p r
-> ConfigureQuery
     (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]),
         [AggregateElem]),
        [Predicate Flat]),
       JoinProduct),
      Duplication)
extract =  QueryCore
  ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
    [Predicate Aggregated]),
   [AggregateElem])
-> ConfigureQuery
     (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]),
         [AggregateElem]),
        [Predicate Flat]),
       JoinProduct),
      Duplication)
forall a.
QueryCore a
-> ConfigureQuery
     (((a, [Predicate Flat]), JoinProduct), Duplication)
extractCore (QueryCore
   ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
     [Predicate Aggregated]),
    [AggregateElem])
 -> ConfigureQuery
      (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
           [Predicate Aggregated]),
          [AggregateElem]),
         [Predicate Flat]),
        JoinProduct),
       Duplication))
-> (AggregatedQuery p r
    -> QueryCore
         ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
           [Predicate Aggregated]),
          [AggregateElem]))
-> AggregatedQuery p r
-> ConfigureQuery
     (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]),
         [AggregateElem]),
        [Predicate Flat]),
       JoinProduct),
      Duplication)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregatings
  Set
  AggregateElem
  (Restrictings Flat (QueryJoin ConfigureQuery))
  (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
   [Predicate Aggregated])
-> QueryCore
     ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
       [Predicate Aggregated]),
      [AggregateElem])
forall (m :: * -> *) ac at a.
(Monad m, Functor m) =>
Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms (Aggregatings
   Set
   AggregateElem
   (Restrictings Flat (QueryJoin ConfigureQuery))
   (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
    [Predicate Aggregated])
 -> QueryCore
      ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
        [Predicate Aggregated]),
       [AggregateElem]))
-> (AggregatedQuery p r
    -> Aggregatings
         Set
         AggregateElem
         (Restrictings Flat (QueryJoin ConfigureQuery))
         (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]))
-> AggregatedQuery p r
-> QueryCore
     ((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
       [Predicate Aggregated]),
      [AggregateElem])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Restrictings
  Aggregated
  (Aggregatings
     Set AggregateElem (Restrictings Flat (QueryJoin ConfigureQuery)))
  ((PlaceHolders p, Record Aggregated r), [OrderingTerm])
-> Aggregatings
     Set
     AggregateElem
     (Restrictings Flat (QueryJoin ConfigureQuery))
     (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
      [Predicate Aggregated])
forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Restrictings c m a -> m (a, [Predicate c])
extractRestrict (Restrictings
   Aggregated
   (Aggregatings
      Set AggregateElem (Restrictings Flat (QueryJoin ConfigureQuery)))
   ((PlaceHolders p, Record Aggregated r), [OrderingTerm])
 -> Aggregatings
      Set
      AggregateElem
      (Restrictings Flat (QueryJoin ConfigureQuery))
      (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
       [Predicate Aggregated]))
-> (AggregatedQuery p r
    -> Restrictings
         Aggregated
         (Aggregatings
            Set AggregateElem (Restrictings Flat (QueryJoin ConfigureQuery)))
         ((PlaceHolders p, Record Aggregated r), [OrderingTerm]))
-> AggregatedQuery p r
-> Aggregatings
     Set
     AggregateElem
     (Restrictings Flat (QueryJoin ConfigureQuery))
     (((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
      [Predicate Aggregated])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregatedQuery p r
-> Restrictings
     Aggregated
     (Aggregatings
        Set AggregateElem (Restrictings Flat (QueryJoin ConfigureQuery)))
     ((PlaceHolders p, Record Aggregated r), [OrderingTerm])
forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms

-- | Run 'AggregatedQuery' to get SQL with 'ConfigureQuery' computation.
toSQL :: AggregatedQuery p r   -- ^ 'AggregatedQuery' to run
      -> ConfigureQuery String -- ^ Result SQL string with 'ConfigureQuery' computation
toSQL :: AggregatedQuery p r -> ConfigureQuery String
toSQL =  (SubQuery -> String)
-> Qualify (QueryConfig Identity) SubQuery -> ConfigureQuery String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SubQuery -> String
Syntax.toSQL (Qualify (QueryConfig Identity) SubQuery -> ConfigureQuery String)
-> (AggregatedQuery p r -> Qualify (QueryConfig Identity) SubQuery)
-> AggregatedQuery p r
-> ConfigureQuery String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregatedQuery p r -> Qualify (QueryConfig Identity) SubQuery
forall p r.
AggregatedQuery p r -> Qualify (QueryConfig Identity) SubQuery
toSubQuery

-- | Run 'AggregatedQuery' to get 'SubQuery' with 'ConfigureQuery' computation.
toSubQuery :: AggregatedQuery p r       -- ^ 'AggregatedQuery' to run
           -> ConfigureQuery SubQuery -- ^ Result 'SubQuery' with 'ConfigureQuery' computation
toSubQuery :: AggregatedQuery p r -> Qualify (QueryConfig Identity) SubQuery
toSubQuery AggregatedQuery p r
q = do
  (((((((PlaceHolders p
_ph, Record Aggregated r
pj), [OrderingTerm]
ot), [Predicate Aggregated]
grs), [AggregateElem]
ag), [Predicate Flat]
rs), JoinProduct
pd), Duplication
da) <- AggregatedQuery p r
-> ConfigureQuery
     (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]),
         [AggregateElem]),
        [Predicate Flat]),
       JoinProduct),
      Duplication)
forall p r.
AggregatedQuery p r
-> ConfigureQuery
     (((((((PlaceHolders p, Record Aggregated r), [OrderingTerm]),
          [Predicate Aggregated]),
         [AggregateElem]),
        [Predicate Flat]),
       JoinProduct),
      Duplication)
extract AggregatedQuery p r
q
  Config
c <- ConfigureQuery Config
askConfig
  SubQuery -> Qualify (QueryConfig Identity) SubQuery
forall (m :: * -> *) a. Monad m => a -> m a
return (SubQuery -> Qualify (QueryConfig Identity) SubQuery)
-> SubQuery -> Qualify (QueryConfig Identity) SubQuery
forall a b. (a -> b) -> a -> b
$ Config
-> Tuple
-> Duplication
-> JoinProduct
-> [Predicate Flat]
-> [AggregateElem]
-> [Predicate Aggregated]
-> [OrderingTerm]
-> SubQuery
aggregatedSubQuery Config
c (Record Aggregated r -> Tuple
forall c r. Record c r -> Tuple
Record.untype Record Aggregated r
pj) Duplication
da JoinProduct
pd [Predicate Flat]
rs [AggregateElem]
ag [Predicate Aggregated]
grs [OrderingTerm]
ot

extractWindow :: Window c a -> ((a, [OrderingTerm]), [AggregateColumnRef])
extractWindow :: Window c a -> ((a, [OrderingTerm]), Tuple)
extractWindow =  Identity ((a, [OrderingTerm]), Tuple)
-> ((a, [OrderingTerm]), Tuple)
forall a. Identity a -> a
runIdentity (Identity ((a, [OrderingTerm]), Tuple)
 -> ((a, [OrderingTerm]), Tuple))
-> (Window c a -> Identity ((a, [OrderingTerm]), Tuple))
-> Window c a
-> ((a, [OrderingTerm]), Tuple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregatings c AggregateColumnRef Identity (a, [OrderingTerm])
-> Identity ((a, [OrderingTerm]), Tuple)
forall (m :: * -> *) ac at a.
(Monad m, Functor m) =>
Aggregatings ac at m a -> m (a, [at])
extractAggregateTerms (Aggregatings c AggregateColumnRef Identity (a, [OrderingTerm])
 -> Identity ((a, [OrderingTerm]), Tuple))
-> (Window c a
    -> Aggregatings c AggregateColumnRef Identity (a, [OrderingTerm]))
-> Window c a
-> Identity ((a, [OrderingTerm]), Tuple)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window c a
-> Aggregatings c AggregateColumnRef Identity (a, [OrderingTerm])
forall (m :: * -> *) c a.
(Monad m, Functor m) =>
Orderings c m a -> m (a, [OrderingTerm])
extractOrderingTerms

-- | Operator to make record of window function result using built 'Window' monad.
over :: SqlContext c
     => Record OverWindow a
     -> Window c ()
     -> Record c a
Record OverWindow a
wp over :: Record OverWindow a -> Window c () -> Record c a
`over` Window c ()
win =
  [StringSQL] -> Record c a
forall c t. [StringSQL] -> Record c t
Record.unsafeFromSqlTerms
  [ StringSQL
c StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL
OVER StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> StringSQL -> StringSQL
SQL.paren (Tuple -> StringSQL
composePartitionBy Tuple
pt StringSQL -> StringSQL -> StringSQL
forall a. Semigroup a => a -> a -> a
<> [OrderingTerm] -> StringSQL
composeOrderBy [OrderingTerm]
ot)
  | StringSQL
c <- Record OverWindow a -> [StringSQL]
forall c r. Record c r -> [StringSQL]
Record.columns Record OverWindow a
wp
  ]  where (((), [OrderingTerm]
ot), Tuple
pt) = Window c () -> (((), [OrderingTerm]), Tuple)
forall c a. Window c a -> ((a, [OrderingTerm]), Tuple)
extractWindow Window c ()
win

infix 8 `over`