{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- |
-- Module      : Database.Relational.Monad.Unique
-- Copyright   : 2014-2017 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
-- This module contains definitions about unique query type
-- to support scalar queries.
module Database.Relational.Monad.Unique
       ( QueryUnique, unsafeUniqueSubQuery,
         toSubQuery,
       ) where

import Control.Applicative (Applicative)

import Database.Relational.Internal.ContextType (Flat)
import Database.Relational.SqlSyntax
  (Duplication, Record, JoinProduct, NodeAttr,
   SubQuery, Predicate, Qualified, )

import qualified Database.Relational.Record as Record
import Database.Relational.Projectable (PlaceHolders)
import Database.Relational.Monad.Class (MonadQualify, MonadQuery)
import Database.Relational.Monad.Trans.Join (unsafeSubQueryWithAttr)
import Database.Relational.Monad.Trans.Restricting (restrictings)
import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig)
import Database.Relational.Monad.Type (QueryCore, extractCore)
import Database.Relational.SqlSyntax (flatSubQuery)


-- | Unique query monad type.
newtype QueryUnique a = QueryUnique (QueryCore a)
                      deriving (MonadQualify ConfigureQuery, Monad QueryUnique
Functor QueryUnique
MonadQualify ConfigureQuery QueryUnique
Functor QueryUnique
-> Monad QueryUnique
-> MonadQualify ConfigureQuery QueryUnique
-> (Duplication -> QueryUnique ())
-> (Predicate Flat -> QueryUnique ())
-> (forall p r.
    Relation p r -> QueryUnique (PlaceHolders p, Record Flat r))
-> (forall p r.
    Relation p r
    -> QueryUnique (PlaceHolders p, Record Flat (Maybe r)))
-> MonadQuery QueryUnique
Predicate Flat -> QueryUnique ()
Duplication -> QueryUnique ()
Relation p r -> QueryUnique (PlaceHolders p, Record Flat r)
Relation p r -> QueryUnique (PlaceHolders p, Record Flat (Maybe r))
forall p r.
Relation p r -> QueryUnique (PlaceHolders p, Record Flat r)
forall p r.
Relation p r -> QueryUnique (PlaceHolders p, Record Flat (Maybe r))
forall (m :: * -> *).
Functor m
-> Monad m
-> MonadQualify ConfigureQuery m
-> (Duplication -> m ())
-> (Predicate Flat -> m ())
-> (forall p r. Relation p r -> m (PlaceHolders p, Record Flat r))
-> (forall p r.
    Relation p r -> m (PlaceHolders p, Record Flat (Maybe r)))
-> MonadQuery m
queryMaybe' :: Relation p r -> QueryUnique (PlaceHolders p, Record Flat (Maybe r))
$cqueryMaybe' :: forall p r.
Relation p r -> QueryUnique (PlaceHolders p, Record Flat (Maybe r))
query' :: Relation p r -> QueryUnique (PlaceHolders p, Record Flat r)
$cquery' :: forall p r.
Relation p r -> QueryUnique (PlaceHolders p, Record Flat r)
restrictJoin :: Predicate Flat -> QueryUnique ()
$crestrictJoin :: Predicate Flat -> QueryUnique ()
setDuplication :: Duplication -> QueryUnique ()
$csetDuplication :: Duplication -> QueryUnique ()
$cp3MonadQuery :: MonadQualify ConfigureQuery QueryUnique
$cp2MonadQuery :: Monad QueryUnique
$cp1MonadQuery :: Functor QueryUnique
MonadQuery, Applicative QueryUnique
a -> QueryUnique a
Applicative QueryUnique
-> (forall a b.
    QueryUnique a -> (a -> QueryUnique b) -> QueryUnique b)
-> (forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b)
-> (forall a. a -> QueryUnique a)
-> Monad QueryUnique
QueryUnique a -> (a -> QueryUnique b) -> QueryUnique b
QueryUnique a -> QueryUnique b -> QueryUnique b
forall a. a -> QueryUnique a
forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b
forall a b. QueryUnique a -> (a -> QueryUnique b) -> QueryUnique b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> QueryUnique a
$creturn :: forall a. a -> QueryUnique a
>> :: QueryUnique a -> QueryUnique b -> QueryUnique b
$c>> :: forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b
>>= :: QueryUnique a -> (a -> QueryUnique b) -> QueryUnique b
$c>>= :: forall a b. QueryUnique a -> (a -> QueryUnique b) -> QueryUnique b
$cp1Monad :: Applicative QueryUnique
Monad, Functor QueryUnique
a -> QueryUnique a
Functor QueryUnique
-> (forall a. a -> QueryUnique a)
-> (forall a b.
    QueryUnique (a -> b) -> QueryUnique a -> QueryUnique b)
-> (forall a b c.
    (a -> b -> c) -> QueryUnique a -> QueryUnique b -> QueryUnique c)
-> (forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b)
-> (forall a b. QueryUnique a -> QueryUnique b -> QueryUnique a)
-> Applicative QueryUnique
QueryUnique a -> QueryUnique b -> QueryUnique b
QueryUnique a -> QueryUnique b -> QueryUnique a
QueryUnique (a -> b) -> QueryUnique a -> QueryUnique b
(a -> b -> c) -> QueryUnique a -> QueryUnique b -> QueryUnique c
forall a. a -> QueryUnique a
forall a b. QueryUnique a -> QueryUnique b -> QueryUnique a
forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b
forall a b. QueryUnique (a -> b) -> QueryUnique a -> QueryUnique b
forall a b c.
(a -> b -> c) -> QueryUnique a -> QueryUnique b -> QueryUnique c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: QueryUnique a -> QueryUnique b -> QueryUnique a
$c<* :: forall a b. QueryUnique a -> QueryUnique b -> QueryUnique a
*> :: QueryUnique a -> QueryUnique b -> QueryUnique b
$c*> :: forall a b. QueryUnique a -> QueryUnique b -> QueryUnique b
liftA2 :: (a -> b -> c) -> QueryUnique a -> QueryUnique b -> QueryUnique c
$cliftA2 :: forall a b c.
(a -> b -> c) -> QueryUnique a -> QueryUnique b -> QueryUnique c
<*> :: QueryUnique (a -> b) -> QueryUnique a -> QueryUnique b
$c<*> :: forall a b. QueryUnique (a -> b) -> QueryUnique a -> QueryUnique b
pure :: a -> QueryUnique a
$cpure :: forall a. a -> QueryUnique a
$cp1Applicative :: Functor QueryUnique
Applicative, a -> QueryUnique b -> QueryUnique a
(a -> b) -> QueryUnique a -> QueryUnique b
(forall a b. (a -> b) -> QueryUnique a -> QueryUnique b)
-> (forall a b. a -> QueryUnique b -> QueryUnique a)
-> Functor QueryUnique
forall a b. a -> QueryUnique b -> QueryUnique a
forall a b. (a -> b) -> QueryUnique a -> QueryUnique b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QueryUnique b -> QueryUnique a
$c<$ :: forall a b. a -> QueryUnique b -> QueryUnique a
fmap :: (a -> b) -> QueryUnique a -> QueryUnique b
$cfmap :: forall a b. (a -> b) -> QueryUnique a -> QueryUnique b
Functor)

-- | Unsafely join sub-query with this unique query.
unsafeUniqueSubQuery :: NodeAttr                 -- ^ Attribute maybe or just
                     -> Qualified SubQuery       -- ^ 'SubQuery' to join
                     -> QueryUnique (Record c r) -- ^ Result joined context and record of 'SubQuery' result.
unsafeUniqueSubQuery :: NodeAttr -> Qualified SubQuery -> QueryUnique (Record c r)
unsafeUniqueSubQuery NodeAttr
a  = QueryCore (Record c r) -> QueryUnique (Record c r)
forall a. QueryCore a -> QueryUnique a
QueryUnique (QueryCore (Record c r) -> QueryUnique (Record c r))
-> (Qualified SubQuery -> QueryCore (Record c r))
-> Qualified SubQuery
-> QueryUnique (Record c r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryJoin ConfigureQuery (Record c r) -> QueryCore (Record c r)
forall (m :: * -> *) a c. Monad m => m a -> Restrictings c m a
restrictings (QueryJoin ConfigureQuery (Record c r) -> QueryCore (Record c r))
-> (Qualified SubQuery -> QueryJoin ConfigureQuery (Record c r))
-> Qualified SubQuery
-> QueryCore (Record c r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeAttr
-> Qualified SubQuery -> QueryJoin ConfigureQuery (Record c r)
forall (q :: * -> *) c r.
MonadQualify ConfigureQuery q =>
NodeAttr -> Qualified SubQuery -> QueryJoin q (Record c r)
unsafeSubQueryWithAttr NodeAttr
a

extract :: QueryUnique a
        -> ConfigureQuery (((a, [Predicate Flat]), JoinProduct), Duplication)
extract :: QueryUnique a
-> ConfigureQuery
     (((a, [Predicate Flat]), JoinProduct), Duplication)
extract (QueryUnique QueryCore a
c) = QueryCore a
-> ConfigureQuery
     (((a, [Predicate Flat]), JoinProduct), Duplication)
forall a.
QueryCore a
-> ConfigureQuery
     (((a, [Predicate Flat]), JoinProduct), Duplication)
extractCore QueryCore a
c

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