relational-query: add configuration to control AS keyword of correlation in SELECT statements.

relational-query/src/Database/Relational/Internal/Config.hs

@@ -20,6 +20,7 @@ module Database.Relational.Internal.Config (
   chunksInsertSize,
   schemaNameMode,
   normalizedTableName,
+  addQueryTableAliasAS,
   addModifyTableAliasAS,
   enableWarning,
   verboseAsCompilerWarning,
@@ -89,6 +90,8 @@ data Config =
   -- ^ 'SchemaNameMode' configuration
   , normalizedTableName          ::  !Bool
   -- ^ If True, schema names become uppercase, and table names become lowercase.
+  , addQueryTableAliasAS         ::  !Bool
+  -- ^ If True, AS keyword is not skipped but added in table-alias of SELECT statement or correlate SELECT clause.
   , addModifyTableAliasAS        ::  !Bool
   -- ^ If True, AS keyword is not skipped but added in target-table-alias of UPDATE and DELETE statement.
   , enableWarning                ::  !Bool
@@ -115,6 +118,7 @@ data Config =
 --     , chunksInsertSize              =  256
 --     , schemaNameMode                =  'SchemaQualified'
 --     , normalizedTableName           =  True
+--     , addQueryTableAliasAS          =  False
 --     , addModifyTableAliasAS         =  False
 --     , enableWarning                 =  True
 --     , verboseAsCompilerWarning      =  False
@@ -135,6 +139,7 @@ defaultConfig =
          , chunksInsertSize              =  256
          , schemaNameMode                =  SchemaQualified
          , normalizedTableName           =  True
+         , addQueryTableAliasAS          =  False
          , addModifyTableAliasAS         =  False
          , enableWarning                 =  True
          , verboseAsCompilerWarning      =  False

relational-query/src/Database/Relational/Monad/Trans/Join.hs

@@ -34,15 +34,17 @@ import Data.Maybe (fromMaybe)
 import Data.Monoid (Last (Last, getLast))
 
 import Database.Relational.Internal.ContextType (Flat)
+import Database.Relational.Internal.Config (addQueryTableAliasAS)
 import Database.Relational.SqlSyntax
   (Duplication (All), NodeAttr (Just', Maybe), Predicate, Record,
    SubQuery, Qualified, JoinProduct, restrictProduct, growProduct, )
 
+import Database.Relational.Monad.Class (liftQualify)
 import Database.Relational.Monad.Trans.JoinState
   (JoinContext, primeJoinContext, updateProduct, joinProduct)
 import qualified Database.Relational.Record as Record
 import Database.Relational.Projectable (PlaceHolders, unsafeAddPlaceHolders)
-import Database.Relational.Monad.BaseType (ConfigureQuery, qualifyQuery, Relation, untypeRelation)
+import Database.Relational.Monad.BaseType (ConfigureQuery, askConfig, qualifyQuery, Relation, untypeRelation)
 import Database.Relational.Monad.Class (MonadQualify (..), MonadQuery (..))
 
 
@@ -81,12 +83,13 @@ instance MonadQuery (QueryJoin ConfigureQuery) where
     return (ph, Record.just pj)
 
 -- | Unsafely join sub-query with this query.
-unsafeSubQueryWithAttr :: Monad q
+unsafeSubQueryWithAttr :: MonadQualify ConfigureQuery q
                        => NodeAttr                 -- ^ Attribute maybe or just
                        -> Qualified SubQuery       -- ^ 'SubQuery' to join
                        -> QueryJoin q (Record c r) -- ^ Result joined context and record of 'SubQuery' result.
 unsafeSubQueryWithAttr attr qsub = do
-  updateContext (updateProduct (`growProduct` (attr, qsub)))
+  addAS <- addQueryTableAliasAS <$> liftQualify askConfig
+  updateContext (updateProduct (`growProduct` (attr, (addAS, qsub))))
   return $ Record.unsafeFromQualifiedSubQuery qsub
 
 -- | Basic monadic join operation using 'MonadQuery'.

relational-query/src/Database/Relational/SqlSyntax/Fold.hs

@@ -251,7 +251,7 @@ showsQueryProduct =  rec  where
   urec n = case Syntax.nodeTree n of
     p@(Leaf _)     -> rec p
     p@(Join {})    -> SQL.paren (rec p)
-  rec (Leaf q)               = corrSubQueryTerm False q
+  rec (Leaf q)               = uncurry corrSubQueryTerm q
   rec (Join left' right' rs) =
     mconcat
     [urec left',

relational-query/src/Database/Relational/SqlSyntax/Join.hs

@@ -33,9 +33,9 @@ growRight = d  where
   d (Just l) (naR, q) = Node Just' $ Join l (Node naR q) mempty
 
 -- | Push new leaf node into product right term.
-growProduct :: Maybe (Node (DList (Predicate Flat))) -- ^ Current tree
-            -> (NodeAttr, Qualified SubQuery)       -- ^ New leaf to push into right
-            -> Node (DList (Predicate Flat))         -- ^ Result node
+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 =  match  where
   match t (na, q) =  growRight t (na, Leaf q)
 

relational-query/src/Database/Relational/SqlSyntax/Types.hs

@@ -133,11 +133,9 @@ qualify = Qualified
 -- | node attribute for product.
 data NodeAttr = Just' | Maybe deriving Show
 
-type QS = Qualified SubQuery
-
 -- | Product tree type. Product tree is constructed by left node and right node.
 data ProductTree rs
-  = Leaf QS
+  = Leaf (Bool, Qualified SubQuery)
   | Join !(Node rs) !(Node rs) !rs
   deriving (Show, Functor)