relational-query 0.8.3.4 → 0.8.3.5

raw patch · 46 files changed

+922/−469 lines, 46 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• relational-query.cabal +7/−2
• src/Database/Relational/Query.hs +3/−1
• src/Database/Relational/Query/Arrow.hs +2/−2
• src/Database/Relational/Query/Component.hs +105/−176
• src/Database/Relational/Query/Constraint.hs +5/−5
• src/Database/Relational/Query/Context.hs +6/−30
• src/Database/Relational/Query/Derives.hs +2/−1
• src/Database/Relational/Query/Effect.hs +5/−5
• src/Database/Relational/Query/Internal/BaseSQL.hs +77/−0
• src/Database/Relational/Query/Internal/Config.hs +74/−0
• src/Database/Relational/Query/Internal/ContextType.hs +39/−0
• src/Database/Relational/Query/Internal/GroupingSQL.hs +122/−0
• src/Database/Relational/Query/Internal/Product.hs +2/−2
• src/Database/Relational/Query/Internal/SQL.hs +30/−1
• src/Database/Relational/Query/Internal/Sub.hs +68/−26
• src/Database/Relational/Query/Internal/UntypedTable.hs +44/−0
• src/Database/Relational/Query/Monad/Aggregate.hs +11/−7
• src/Database/Relational/Query/Monad/Assign.hs +6/−3
• src/Database/Relational/Query/Monad/BaseType.hs +3/−2
• src/Database/Relational/Query/Monad/Class.hs +4/−2
• src/Database/Relational/Query/Monad/Register.hs +5/−3
• src/Database/Relational/Query/Monad/Restrict.hs +3/−2
• src/Database/Relational/Query/Monad/Simple.hs +4/−3
• src/Database/Relational/Query/Monad/Trans/Aggregating.hs +4/−4
• src/Database/Relational/Query/Monad/Trans/Assigning.hs +5/−5
• src/Database/Relational/Query/Monad/Trans/Config.hs +2/−2
• src/Database/Relational/Query/Monad/Trans/Join.hs +5/−5
• src/Database/Relational/Query/Monad/Trans/JoinState.hs +5/−3
• src/Database/Relational/Query/Monad/Trans/Ordering.hs +6/−6
• src/Database/Relational/Query/Monad/Trans/Qualify.hs +11/−13
• src/Database/Relational/Query/Monad/Trans/Restricting.hs +1/−2
• src/Database/Relational/Query/Monad/Type.hs +3/−2
• src/Database/Relational/Query/Monad/Unique.hs +4/−5
• src/Database/Relational/Query/Pi.hs +2/−1
• src/Database/Relational/Query/Projectable.hs +2/−3
• src/Database/Relational/Query/Projection.hs +16/−12
• src/Database/Relational/Query/Pure.hs +2/−1
• src/Database/Relational/Query/Relation.hs +12/−7
• src/Database/Relational/Query/SQL.hs +5/−4
• src/Database/Relational/Query/Scalar.hs +2/−1
• src/Database/Relational/Query/Sub.hs +89/−96
• src/Database/Relational/Query/Table.hs +15/−20
• src/Database/Relational/Query/Type.hs +3/−2
• test/sqlsEq.hs +50/−1
• test/sqlsEqArrow.hs +47/−1

@@ -1,5 +1,9 @@ <!-- -*- Markdown -*- --> +## 0.8.3.5++- Deprecate some exported interfaces which are internal definitions.+ ## 0.8.3.4  - Update this changelog

@@ -1,5 +1,5 @@ name:                relational-query-version:             0.8.3.4+version:             0.8.3.5 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can@@ -14,7 +14,7 @@ license-file:        LICENSE author:              Kei Hibino maintainer:          ex8k.hibino@gmail.com-copyright:           Copyright (c) 2013-2016 Kei Hibino+copyright:           Copyright (c) 2013-2017 Kei Hibino category:            Database build-type:          Simple cabal-version:       >=1.10@@ -65,7 +65,12 @@                        Database.Relational.Query.TH    other-modules:+                       Database.Relational.Query.Internal.Config+                       Database.Relational.Query.Internal.ContextType                        Database.Relational.Query.Internal.SQL+                       Database.Relational.Query.Internal.BaseSQL+                       Database.Relational.Query.Internal.GroupingSQL+                       Database.Relational.Query.Internal.UntypedTable                        Database.Relational.Query.Internal.Product                        Database.Relational.Query.Internal.Sub                        Database.Relational.Query.Monad.Trans.JoinState

@@ -51,7 +51,9 @@    Primary, Unique, NotNull) import Database.Relational.Query.Context import Database.Relational.Query.Component-  (NameConfig (..), SchemaNameMode (..), Config (..), defaultConfig, ProductUnitSupport (..), IdentifierQuotation (..), Order (..))+  (NameConfig (..), SchemaNameMode (..), ProductUnitSupport (..), IdentifierQuotation (..),+   Config (..), defaultConfig,+   AggregateKey, Order (..)) import Database.Relational.Query.Sub (SubQuery, unitSQL, queryWidth) import Database.Relational.Query.Projection (Projection, list) import Database.Relational.Query.Projectable

@@ -3,7 +3,7 @@  -- | -- Module      : Database.Relational.Query.Arrow--- Copyright   : 2015 Kei Hibino+-- Copyright   : 2015-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -65,6 +65,7 @@ import Control.Arrow (Arrow, Kleisli (..))  import Database.Record+ import Database.Relational.Query hiding   (all', distinct,    query, queryMaybe, query', queryMaybe',@@ -78,7 +79,6 @@    QuerySimple, QueryAggregate, QueryUnique, Window) import qualified Database.Relational.Query as Monadic import Database.Relational.Query.Projection (ListProjection)-import Database.Relational.Query.Component (AggregateKey) import qualified Database.Relational.Query.Monad.Trans.Aggregating as Monadic import qualified Database.Relational.Query.Monad.Trans.Ordering as Monadic import qualified Database.Relational.Query.Monad.Trans.Assigning as Monadic

@@ -1,10 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}  -- | -- Module      : Database.Relational.Query.Component--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -14,285 +13,215 @@ -- This module provides untyped components for query. module Database.Relational.Query.Component        ( -- * Type for column SQL string++         -- deprecated interfaces          ColumnSQL, columnSQL, columnSQL', showsColumnSQL,           -- * Configuration type for query-         NameConfig (..),-         SchemaNameMode (..),-         Config ( productUnitSupport-                , chunksInsertSize-                , schemaNameMode-                , normalizedTableName-                , verboseAsCompilerWarning-                , nameConfig-                , identifierQuotation),-         defaultConfig,-         ProductUnitSupport (..), Duplication (..), IdentifierQuotation (..),+         module Database.Relational.Query.Internal.Config,           -- * Duplication attribute-         showsDuplication,+         -- deprecated interfaces - import Duplication from internal module+         Duplication (..), showsDuplication,           -- * Types for aggregation-         AggregateColumnRef,+         AggregateKey, +         -- deprecated interfaces+         AggregateColumnRef,          AggregateBitKey, AggregateSet, AggregateElem,-          aggregateColumnRef, aggregateEmpty,          aggregatePowerKey, aggregateGroupingSet,          aggregateRollup, aggregateCube, aggregateSets,-          composeGroupBy, composePartitionBy,--         AggregateKey, aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey,+         aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey,           -- * Types for ordering-         Order (..), OrderColumn, OrderingTerm, OrderingTerms,-         composeOrderBy,+         Order (..), +         -- deprecated interfaces+         OrderColumn, OrderingTerm, composeOrderBy,++         -- deprecated interfaces+         OrderingTerms,+          -- * Types for assignments-         AssignColumn, AssignTerm, Assignment, Assignments, composeSets, composeValues,+         -- deprecated interfaces+         AssignColumn, AssignTerm, Assignment, composeSets, composeValues, +         -- deprecated interfaces+         Assignments,+          -- * Compose window clause          composeOver,        ) where -import Data.Monoid (Monoid (..), (<>))--import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL, rowConsStringSQL)-import Language.SQL.Keyword (Keyword(..), (|*|), (.=.))+import Data.Monoid ((<>)) +import Language.SQL.Keyword (Keyword(..)) import qualified Language.SQL.Keyword as SQL-import Language.Haskell.TH.Name.CamelCase (VarName, varCamelcaseName)-import qualified Database.Record.TH as RecordTH +import Database.Relational.Query.Internal.Config+  (NameConfig (..),+   ProductUnitSupport (..), SchemaNameMode (..), IdentifierQuotation (..),+   Config (..), defaultConfig,)+import Database.Relational.Query.Internal.SQL (StringSQL)+import qualified Database.Relational.Query.Internal.SQL as Internal+import Database.Relational.Query.Internal.BaseSQL+  (Duplication (..), Order (..),)+import qualified Database.Relational.Query.Internal.BaseSQL as BaseSQL+import Database.Relational.Query.Internal.GroupingSQL (AggregateKey)+import qualified Database.Relational.Query.Internal.GroupingSQL as GroupingSQL --- | Simple wrap type-newtype ColumnSQL' a = ColumnSQL a -instance Functor ColumnSQL' where-  fmap f (ColumnSQL c) = ColumnSQL $ f c-+{-# DEPRECATED+  ColumnSQL,+  columnSQL, columnSQL', showsColumnSQL+  "prepare to drop public interface. internally use Database.Relational.Query.Internal.SQL.*" #-} -- | Column SQL string type-type ColumnSQL = ColumnSQL' StringSQL+type ColumnSQL = Internal.ColumnSQL  -- | 'ColumnSQL' from string columnSQL :: String -> ColumnSQL-columnSQL =  columnSQL' . stringSQL+columnSQL = Internal.columnSQL  -- | 'ColumnSQL' from 'StringSQL' columnSQL' :: StringSQL -> ColumnSQL-columnSQL' =  ColumnSQL---- | String from ColumnSQL-stringFromColumnSQL :: ColumnSQL -> String-stringFromColumnSQL =  showStringSQL . showsColumnSQL+columnSQL' = Internal.columnSQL'  -- | StringSQL from ColumnSQL showsColumnSQL :: ColumnSQL -> StringSQL-showsColumnSQL (ColumnSQL c) = c+showsColumnSQL = Internal.showsColumnSQL -instance Show ColumnSQL where-  show = stringFromColumnSQL --- | 'NameConfig' type to customize names of expanded templates.-data NameConfig =-  NameConfig-  { recordConfig       ::  RecordTH.NameConfig-  , relationVarName    ::  String -> String -> VarName-  }+{-# DEPRECATED+    showsDuplication+    "prepare to drop public interface. internally use Database.Relational.Query.Internal.BaseSQL.showsDuplication" #-}+-- | Compose duplication attribute string.+showsDuplication :: Duplication -> StringSQL+showsDuplication = BaseSQL.showsDuplication -instance Show NameConfig where-  show = const "<NameConfig>" --- | Schema name qualify mode in SQL string.-data SchemaNameMode-  = SchemaQualified     -- ^ Schema qualified table name in SQL string-  | SchemaNotQualified  -- ^ Not qualified table name in SQL string-  deriving (Eq, Show)---- | Configuration type.-data Config =-  Config-  { productUnitSupport        ::  !ProductUnitSupport-  , chunksInsertSize          ::  !Int-  , schemaNameMode            ::  !SchemaNameMode-  , normalizedTableName       ::  !Bool-  , verboseAsCompilerWarning  ::  !Bool-  , nameConfig                ::  !NameConfig-  , identifierQuotation       ::  !IdentifierQuotation-  } deriving Show---- | Default configuration.-defaultConfig :: Config-defaultConfig =-  Config { productUnitSupport        =  PUSupported-         , chunksInsertSize          =  256-         , schemaNameMode            =  SchemaQualified-         , normalizedTableName       =  True-         , verboseAsCompilerWarning  =  False-         , nameConfig                =  NameConfig { recordConfig     =  RecordTH.defaultNameConfig-                                                   , relationVarName  =  const varCamelcaseName-                                                   }-         , identifierQuotation       =  NoQuotation-         }---- | Unit of product is supported or not.-data ProductUnitSupport = PUSupported | PUNotSupported  deriving Show---- | Configuration for quotation of identifiers of SQL.-data IdentifierQuotation = NoQuotation | Quotation Char deriving Show+{-# DEPRECATED+  AggregateColumnRef,+  AggregateBitKey, AggregateSet, AggregateElem, --- | Result record duplication attribute-data Duplication = All | Distinct  deriving Show+  aggregateColumnRef, aggregateEmpty,+  aggregatePowerKey, aggregateGroupingSet,+  aggregateRollup, aggregateCube, aggregateSets, --- | Compose duplication attribute string.-showsDuplication :: Duplication -> StringSQL-showsDuplication =  dup  where-  dup All      = ALL-  dup Distinct = DISTINCT+  composeGroupBy, composePartitionBy, +  aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey +  "prepare to drop public interface. internally use Database.Relational.Query.Internal.GroupingSQL.*" #-} -- | Type for group-by term-type AggregateColumnRef = ColumnSQL+type AggregateColumnRef = GroupingSQL.AggregateColumnRef  -- | Type for group key.-newtype AggregateBitKey = AggregateBitKey [AggregateColumnRef] deriving Show+type AggregateBitKey = GroupingSQL.AggregateBitKey  -- | Type for grouping set-newtype AggregateSet = AggregateSet [AggregateElem] deriving Show+type AggregateSet = GroupingSQL.AggregateSet  -- | Type for group-by tree-data AggregateElem = ColumnRef AggregateColumnRef-                   | Rollup [AggregateBitKey]-                   | Cube   [AggregateBitKey]-                   | GroupingSets [AggregateSet]-                   deriving Show+type AggregateElem = GroupingSQL.AggregateElem  -- | Single term aggregation element. aggregateColumnRef :: AggregateColumnRef -> AggregateElem-aggregateColumnRef =  ColumnRef+aggregateColumnRef = GroupingSQL.aggregateColumnRef  -- | Key of aggregation power set. aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey-aggregatePowerKey =  AggregateBitKey+aggregatePowerKey = GroupingSQL.aggregatePowerKey  -- | Single grouping set. aggregateGroupingSet :: [AggregateElem] -> AggregateSet-aggregateGroupingSet =  AggregateSet+aggregateGroupingSet = GroupingSQL.aggregateGroupingSet  -- | Rollup aggregation element. aggregateRollup :: [AggregateBitKey] -> AggregateElem-aggregateRollup =  Rollup+aggregateRollup = GroupingSQL.aggregateRollup  -- | Cube aggregation element. aggregateCube :: [AggregateBitKey] -> AggregateElem-aggregateCube =  Cube+aggregateCube = GroupingSQL.aggregateCube  -- | Grouping sets aggregation. aggregateSets :: [AggregateSet] -> AggregateElem-aggregateSets =  GroupingSets+aggregateSets = GroupingSQL.aggregateSets  -- | Empty aggregation. aggregateEmpty :: [AggregateElem]-aggregateEmpty =  []--showsAggregateColumnRef :: AggregateColumnRef -> StringSQL-showsAggregateColumnRef =  showsColumnSQL--commaed :: [StringSQL] -> StringSQL-commaed =  SQL.fold (|*|)--pComma :: (a -> StringSQL) -> [a] -> StringSQL-pComma qshow =  SQL.paren . commaed . map qshow--showsAggregateBitKey :: AggregateBitKey -> StringSQL-showsAggregateBitKey (AggregateBitKey ts) = pComma showsAggregateColumnRef ts+aggregateEmpty = GroupingSQL.aggregateEmpty  -- | Compose GROUP BY clause from AggregateElem list. composeGroupBy :: [AggregateElem] -> StringSQL-composeGroupBy =  d where-  d []       = mempty-  d es@(_:_) = GROUP <> BY <> rec es-  keyList op ss = op <> pComma showsAggregateBitKey ss-  rec = commaed . map showsE-  showsGs (AggregateSet s) = SQL.paren $ rec s-  showsE (ColumnRef t)     = showsAggregateColumnRef t-  showsE (Rollup ss)       = keyList ROLLUP ss-  showsE (Cube   ss)       = keyList CUBE   ss-  showsE (GroupingSets ss) = GROUPING <> SETS <> pComma showsGs ss+composeGroupBy = GroupingSQL.composeGroupBy  -- | Compose PARTITION BY clause from AggregateColumnRef list. composePartitionBy :: [AggregateColumnRef] -> StringSQL-composePartitionBy =  d where-  d []       = mempty-  d ts@(_:_) = PARTITION <> BY <> commaed (map showsAggregateColumnRef ts)---- | Typeful aggregate element.-newtype AggregateKey a = AggregateKey (a, AggregateElem)+composePartitionBy = GroupingSQL.composePartitionBy  -- | Extract typed projection from 'AggregateKey'. aggregateKeyProjection :: AggregateKey a -> a-aggregateKeyProjection (AggregateKey (p, _c)) = p+aggregateKeyProjection = GroupingSQL.aggregateKeyProjection  -- | Extract untyped term from 'AggregateKey'. aggregateKeyElement :: AggregateKey a -> AggregateElem-aggregateKeyElement (AggregateKey (_p, c)) = c+aggregateKeyElement = GroupingSQL.aggregateKeyElement  -- | Unsafely bind typed-projection and untyped-term into 'AggregateKey'. unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a-unsafeAggregateKey = AggregateKey+unsafeAggregateKey = GroupingSQL.unsafeAggregateKey  --- | Order direction. Ascendant or Descendant.-data Order = Asc | Desc  deriving Show+{-# DEPRECATED OrderingTerms "use [OrderingTerm]." #-}+-- | Type for order-by terms+type OrderingTerms = [OrderingTerm] +{-# DEPRECATED+   OrderColumn, OrderingTerm,+   composeOrderBy+   "prepare to drop public interface. internally use Database.Relational.Query.Internal.BaseSQL.*" #-} -- | Type for order-by column-type OrderColumn = ColumnSQL+type OrderColumn = BaseSQL.OrderColumn  -- | Type for order-by term-type OrderingTerm = (Order, OrderColumn)---- | Type for order-by terms-type OrderingTerms = [OrderingTerm]+type OrderingTerm = BaseSQL.OrderingTerm  -- | Compose ORDER BY clause from OrderingTerms-composeOrderBy :: OrderingTerms -> StringSQL-composeOrderBy =  d where-  d []       = mempty-  d ts@(_:_) = ORDER <> BY <> commaed (map showsOt ts)-  showsOt (o, e) = showsColumnSQL e <> order o-  order Asc  = ASC-  order Desc = DESC+composeOrderBy :: [OrderingTerm] -> StringSQL+composeOrderBy = BaseSQL.composeOrderBy  --- | Column SQL String-type AssignColumn = ColumnSQL+{-# DEPRECATED Assignments "use [Assignment]." #-}+-- | Assignment pair list.+type Assignments = [Assignment] --- | Value SQL String-type AssignTerm   = ColumnSQL+{-# DEPRECATED+   AssignColumn, AssignTerm, Assignment,+   composeSets, composeValues+   "prepare to drop public interface. internally use Database.Relational.Query.Internal.BaseSQL.*" #-}+-- | Column SQL String of assignment+type AssignColumn = BaseSQL.AssignColumn --- | Assignment pair-type Assignment = (AssignColumn, AssignTerm)+-- | Value SQL String of assignment+type AssignTerm   = BaseSQL.AssignTerm --- | Assignment pair list.-type Assignments = [Assignment]+-- | Assignment pair+type Assignment = BaseSQL.Assignment --- | Compose SET clause from 'Assignments'.-composeSets :: Assignments -> StringSQL-composeSets as = assigns  where-  assignList = foldr (\ (col, term) r ->-                       (showsColumnSQL col .=. showsColumnSQL term) : r)-               [] as-  assigns | null assignList = error "Update assignment list is null!"-          | otherwise       = SET <> commaed assignList+-- | Compose SET clause from ['Assignment'].+composeSets :: [Assignment] -> StringSQL+composeSets = BaseSQL.composeSets --- | Compose VALUES clause from 'Assignments'.-composeValues :: Assignments -> StringSQL-composeValues as = rowConsStringSQL [ showsColumnSQL c | c <- cs ] <> VALUES <>-                   rowConsStringSQL [ showsColumnSQL c | c <- vs ]  where-  (cs, vs) = unzip as+-- | Compose VALUES clause from ['Assignment'].+composeValues :: [Assignment] -> StringSQL+composeValues = BaseSQL.composeValues  +{-# DEPRECATED composeOver "prepare to drop public interface." #-} -- | Compose /OVER (PARTITION BY ... )/ clause. composeOver :: [AggregateColumnRef] -> OrderingTerms -> StringSQL composeOver pts ots =

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Constraint--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -33,14 +33,14 @@   ) where  -import Database.Relational.Query.Pi (Pi)-import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi+import Database.Record (PersistableRecordWidth, PersistableWidth (persistableWidth)) import Database.Record.KeyConstraint   (KeyConstraint, unsafeSpecifyKeyConstraint,    Primary, Unique, NotNull)- import qualified Database.Record.KeyConstraint as C-import Database.Record (PersistableRecordWidth, PersistableWidth (persistableWidth))++import Database.Relational.Query.Pi (Pi)+import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi   -- | Constraint Key proof object. Constraint type 'c', record type 'r' and columns type 'ct'.

@@ -1,39 +1,15 @@-{-# LANGUAGE EmptyDataDecls #-}- -- | -- Module      : Database.Relational.Query.Context--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com -- Stability   : experimental -- Portability : unknown ----- This module defines query context tag types.-module Database.Relational.Query.Context (-  Flat, Aggregated, Exists, OverWindow,--  Set, SetList, Power,-  ) where---- | Type tag for flat (not-aggregated) query-data Flat---- | Type tag for aggregated query-data Aggregated---- | Type tag for exists predicate-data Exists---- | Type tag for window function building-data OverWindow----- | Type tag for normal aggregatings set-data Set---- | Type tag for aggregatings GROUPING SETS-data SetList+-- This module re-export query context tag types.+module Database.Relational.Query.Context+       ( module Database.Relational.Query.Internal.ContextType+       ) where --- | Type tag for aggregatings power set-data Power+import Database.Relational.Query.Internal.ContextType

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Derives--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -30,6 +30,7 @@  import Database.Record (PersistableWidth, ToSql (recordToSql)) import Database.Record.ToSql (unsafeUpdateValuesWithIndexes)+ import Database.Relational.Query.Table (Table, TableDerivable) import Database.Relational.Query.Pi.Unsafe (Pi, unsafeExpandIndexes) import Database.Relational.Query.Projection (Projection)

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Effect--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -29,18 +29,20 @@  import Data.Monoid ((<>)) +import Language.SQL.Keyword (Keyword(..)) import Database.Record (PersistableWidth) +import Database.Relational.Query.Internal.Config (Config, defaultConfig) import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL)+import Database.Relational.Query.Internal.BaseSQL (composeSets, composeValues)+ import Database.Relational.Query.Pi (id') import Database.Relational.Query.Table (Table, TableDerivable, derivedTable) import qualified Database.Relational.Query.Table as Table-import Database.Relational.Query.Component (Config, defaultConfig, composeSets, composeValues) import Database.Relational.Query.Sub (composeWhere) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Projectable   (PlaceHolders, placeholder, unitPlaceHolder, unsafeAddPlaceHolders, (><), rightId)- import Database.Relational.Query.Monad.Trans.Assigning (assignings, (<-#)) import Database.Relational.Query.Monad.Restrict (RestrictedStatement) import qualified Database.Relational.Query.Monad.Restrict as Restrict@@ -48,8 +50,6 @@ import qualified Database.Relational.Query.Monad.Assign as Assign import Database.Relational.Query.Monad.Register (Register) import qualified Database.Relational.Query.Monad.Register as Register--import Language.SQL.Keyword (Keyword(..))   -- | Restriction type with place-holder parameter 'p' and projection record type 'r'.

@@ -0,0 +1,77 @@+-- |+-- Module      : Database.Relational.Query.Internal.BaseSQL+-- Copyright   : 2013-2017 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides base structure of SQL syntax tree.+module Database.Relational.Query.Internal.BaseSQL (+  Duplication (..), showsDuplication,+  Order (..), OrderColumn, OrderingTerm, composeOrderBy,+  AssignColumn, AssignTerm, Assignment, composeSets, composeValues,+  ) where++import Data.Monoid (Monoid (..), (<>))++import Language.SQL.Keyword (Keyword(..), (|*|), (.=.))+import qualified Language.SQL.Keyword as SQL++import Database.Relational.Query.Internal.SQL+  (StringSQL, rowConsStringSQL, ColumnSQL, showsColumnSQL)+++-- | Result record duplication attribute+data Duplication = All | Distinct  deriving Show++-- | Compose duplication attribute string.+showsDuplication :: Duplication -> StringSQL+showsDuplication =  dup  where+  dup All      = ALL+  dup Distinct = DISTINCT+++-- | Order direction. Ascendant or Descendant.+data Order = Asc | Desc  deriving Show++-- | Type for order-by column+type OrderColumn = ColumnSQL++-- | Type for order-by term+type OrderingTerm = (Order, OrderColumn)++-- | Compose ORDER BY clause from OrderingTerms+composeOrderBy :: [OrderingTerm] -> StringSQL+composeOrderBy =  d where+  d []       = mempty+  d ts@(_:_) = ORDER <> BY <> SQL.fold (|*|) (map showsOt ts)+  showsOt (o, e) = showsColumnSQL e <> order o+  order Asc  = ASC+  order Desc = DESC+++-- | Column SQL String of assignment+type AssignColumn = ColumnSQL++-- | Value SQL String of assignment+type AssignTerm   = ColumnSQL++-- | Assignment pair+type Assignment = (AssignColumn, AssignTerm)++-- | Compose SET clause from ['Assignment'].+composeSets :: [Assignment] -> StringSQL+composeSets as = assigns  where+  assignList = foldr (\ (col, term) r ->+                       (showsColumnSQL col .=. showsColumnSQL term) : r)+               [] as+  assigns | null assignList = error "Update assignment list is null!"+          | otherwise       = SET <> SQL.fold (|*|) assignList++-- | Compose VALUES clause from ['Assignment'].+composeValues :: [Assignment] -> StringSQL+composeValues as = rowConsStringSQL [ showsColumnSQL c | c <- cs ] <> VALUES <>+                   rowConsStringSQL [ showsColumnSQL c | c <- vs ]  where+  (cs, vs) = unzip as

@@ -0,0 +1,74 @@+-- |+-- Module      : Database.Relational.Query.Internal.Config+-- Copyright   : 2017 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines configuration datatype used in query products.+module Database.Relational.Query.Internal.Config (+  NameConfig (..),+  ProductUnitSupport (..), SchemaNameMode (..), IdentifierQuotation (..),+  Config ( productUnitSupport+         , chunksInsertSize+         , schemaNameMode+         , normalizedTableName+         , verboseAsCompilerWarning+         , identifierQuotation+         , nameConfig),+  defaultConfig,+  ) where++import Language.Haskell.TH.Name.CamelCase (VarName, varCamelcaseName)+import qualified Database.Record.TH as RecordTH+++-- | 'NameConfig' type to customize names of expanded templates.+data NameConfig =+  NameConfig+  { recordConfig       ::  RecordTH.NameConfig+  , relationVarName    ::  String -> String -> VarName+  }++instance Show NameConfig where+  show = const "<NameConfig>"++-- | Unit of product is supported or not.+data ProductUnitSupport = PUSupported | PUNotSupported  deriving Show++-- | Schema name qualify mode in SQL string.+data SchemaNameMode+  = SchemaQualified     -- ^ Schema qualified table name in SQL string+  | SchemaNotQualified  -- ^ Not qualified table name in SQL string+  deriving (Eq, Show)++-- | Configuration for quotation of identifiers of SQL.+data IdentifierQuotation = NoQuotation | Quotation Char deriving Show++-- | Configuration type.+data Config =+  Config+  { productUnitSupport        ::  !ProductUnitSupport+  , chunksInsertSize          ::  !Int+  , schemaNameMode            ::  !SchemaNameMode+  , normalizedTableName       ::  !Bool+  , verboseAsCompilerWarning  ::  !Bool+  , identifierQuotation       ::  !IdentifierQuotation+  , nameConfig                ::  !NameConfig+  } deriving Show++-- | Default configuration.+defaultConfig :: Config+defaultConfig =+  Config { productUnitSupport        =  PUSupported+         , chunksInsertSize          =  256+         , schemaNameMode            =  SchemaQualified+         , normalizedTableName       =  True+         , verboseAsCompilerWarning  =  False+         , identifierQuotation       =  NoQuotation+         , nameConfig                =  NameConfig { recordConfig     =  RecordTH.defaultNameConfig+                                                   , relationVarName  =  const varCamelcaseName+                                                   }+         }

@@ -0,0 +1,39 @@+{-# LANGUAGE EmptyDataDecls #-}++-- |+-- Module      : Database.Relational.Query.Internal.ContextType+-- Copyright   : 2013-2017 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines query context tag types.+module Database.Relational.Query.Internal.ContextType (+  Flat, Aggregated, Exists, OverWindow,++  Set, SetList, Power,+  ) where++-- | Type tag for flat (not-aggregated) query+data Flat++-- | Type tag for aggregated query+data Aggregated++-- | Type tag for exists predicate+data Exists++-- | Type tag for window function building+data OverWindow+++-- | Type tag for normal aggregatings set+data Set++-- | Type tag for aggregatings GROUPING SETS+data SetList++-- | Type tag for aggregatings power set+data Power

@@ -0,0 +1,122 @@+-- |+-- Module      : Database.Relational.Query.Internal.GroupingSQL+-- Copyright   : 2013-2017 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module provides grouping-sets structure of SQL syntax tree.+module Database.Relational.Query.Internal.GroupingSQL (+  AggregateColumnRef,+  AggregateBitKey (..), AggregateSet (..), AggregateElem (..),++  aggregateColumnRef, aggregateEmpty,+  aggregatePowerKey, aggregateGroupingSet,+  aggregateRollup, aggregateCube, aggregateSets,++  composeGroupBy, composePartitionBy,++  AggregateKey (..),++  aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey,+  ) where++import Data.Monoid (Monoid (..), (<>))++import Language.SQL.Keyword (Keyword(..), (|*|))+import qualified Language.SQL.Keyword as SQL++import Database.Relational.Query.Internal.SQL (StringSQL, ColumnSQL, showsColumnSQL)+++-- | Type for group-by term+type AggregateColumnRef = ColumnSQL++-- | Type for group key.+newtype AggregateBitKey = AggregateBitKey [AggregateColumnRef] deriving Show++-- | Type for grouping set+newtype AggregateSet = AggregateSet [AggregateElem] deriving Show++-- | Type for group-by tree+data AggregateElem = ColumnRef AggregateColumnRef+                   | Rollup [AggregateBitKey]+                   | Cube   [AggregateBitKey]+                   | GroupingSets [AggregateSet]+                   deriving Show++-- | Typeful aggregate element.+newtype AggregateKey a = AggregateKey (a, AggregateElem)++-- | Single term aggregation element.+aggregateColumnRef :: AggregateColumnRef -> AggregateElem+aggregateColumnRef =  ColumnRef++-- | Key of aggregation power set.+aggregatePowerKey :: [AggregateColumnRef] -> AggregateBitKey+aggregatePowerKey =  AggregateBitKey++-- | Single grouping set.+aggregateGroupingSet :: [AggregateElem] -> AggregateSet+aggregateGroupingSet =  AggregateSet++-- | Rollup aggregation element.+aggregateRollup :: [AggregateBitKey] -> AggregateElem+aggregateRollup =  Rollup++-- | Cube aggregation element.+aggregateCube :: [AggregateBitKey] -> AggregateElem+aggregateCube =  Cube++-- | Grouping sets aggregation.+aggregateSets :: [AggregateSet] -> AggregateElem+aggregateSets =  GroupingSets++-- | Empty aggregation.+aggregateEmpty :: [AggregateElem]+aggregateEmpty =  []++showsAggregateColumnRef :: AggregateColumnRef -> StringSQL+showsAggregateColumnRef =  showsColumnSQL++commaed :: [StringSQL] -> StringSQL+commaed =  SQL.fold (|*|)++pComma :: (a -> StringSQL) -> [a] -> StringSQL+pComma qshow =  SQL.paren . commaed . map qshow++showsAggregateBitKey :: AggregateBitKey -> StringSQL+showsAggregateBitKey (AggregateBitKey ts) = pComma showsAggregateColumnRef ts++-- | Compose GROUP BY clause from AggregateElem list.+composeGroupBy :: [AggregateElem] -> StringSQL+composeGroupBy =  d where+  d []       = mempty+  d es@(_:_) = GROUP <> BY <> rec es+  keyList op ss = op <> pComma showsAggregateBitKey ss+  rec = commaed . map showsE+  showsGs (AggregateSet s) = SQL.paren $ rec s+  showsE (ColumnRef t)     = showsAggregateColumnRef t+  showsE (Rollup ss)       = keyList ROLLUP ss+  showsE (Cube   ss)       = keyList CUBE   ss+  showsE (GroupingSets ss) = GROUPING <> SETS <> pComma showsGs ss++-- | Compose PARTITION BY clause from AggregateColumnRef list.+composePartitionBy :: [AggregateColumnRef] -> StringSQL+composePartitionBy =  d where+  d []       = mempty+  d ts@(_:_) = PARTITION <> BY <> commaed (map showsAggregateColumnRef ts)++-- | Extract typed projection from 'AggregateKey'.+aggregateKeyProjection :: AggregateKey a -> a+aggregateKeyProjection (AggregateKey (p, _c)) = p++-- | Extract untyped term from 'AggregateKey'.+aggregateKeyElement :: AggregateKey a -> AggregateElem+aggregateKeyElement (AggregateKey (_p, c)) = c++-- | Unsafely bind typed-projection and untyped-term into 'AggregateKey'.+unsafeAggregateKey :: (a, AggregateElem) -> AggregateKey a+unsafeAggregateKey = AggregateKey

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Internal.Product--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -17,7 +17,7 @@ import Control.Applicative (pure) import Data.Monoid ((<>), mempty) -import Database.Relational.Query.Context (Flat)+import Database.Relational.Query.Internal.ContextType (Flat) import Database.Relational.Query.Internal.Sub   (NodeAttr (..), ProductTree (..), Node (..), Projection, Qualified, SubQuery,    ProductTreeBuilder, ProductBuilder)

@@ -1,6 +1,8 @@+{-# LANGUAGE FlexibleInstances #-}+ -- | -- Module      : Database.Relational.Query.Internal.SQL--- Copyright   : 2014 Kei Hibino+-- Copyright   : 2014-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -14,6 +16,8 @@   rowStringSQL, rowPlaceHolderStringSQL,    rowConsStringSQL, listStringSQL,++  ColumnSQL, columnSQL, columnSQL', showsColumnSQL,   ) where  import Language.SQL.Keyword (Keyword, word, wordShow, fold, (|*|), paren)@@ -48,3 +52,28 @@ -- | List String of SQL. listStringSQL :: [StringSQL] -> StringSQL listStringSQL =  paren . fold (|*|)+++-- | Simple wrap type+newtype ColumnSQL' a = ColumnSQL a++instance Functor ColumnSQL' where+  fmap f (ColumnSQL c) = ColumnSQL $ f c++-- | Column SQL string type+type ColumnSQL = ColumnSQL' StringSQL++-- | 'ColumnSQL' from string+columnSQL :: String -> ColumnSQL+columnSQL =  columnSQL' . stringSQL++-- | 'ColumnSQL' from 'StringSQL'+columnSQL' :: StringSQL -> ColumnSQL+columnSQL' =  ColumnSQL++-- | StringSQL from ColumnSQL+showsColumnSQL :: ColumnSQL -> StringSQL+showsColumnSQL (ColumnSQL c) = c++instance Show ColumnSQL where+  show = showStringSQL . showsColumnSQL

@@ -1,8 +1,8 @@-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}  -- | -- Module      : Database.Relational.Query.Internal.Sub--- Copyright   : 2015-2016 Kei Hibino+-- Copyright   : 2015-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -11,29 +11,35 @@ -- -- This module defines sub-query structure used in query products. module Database.Relational.Query.Internal.Sub-       ( SubQuery (..), UntypedProjection, ProjectionUnit (..)-       , SetOp (..), BinOp (..), Qualifier (..), Qualified (..)+       ( SubQuery (..)+       , SetOp (..), BinOp (..), Qualifier (..)+       , Qualified (..), qualifier, unQualify, qualify           -- * Product tree type-       , NodeAttr (..), ProductTree (..), Node (..)+       , NodeAttr (..), ProductTree (..)+       , Node (..), nodeAttr, nodeTree        , JoinProduct, QueryProductTree        , ProductTreeBuilder, ProductBuilder -       , Projection, untypeProjection, typedProjection+       , UntypedProjection, untypedProjectionWidth, ProjectionUnit (..)+       , Projection, untypeProjection, typedProjection, projectionWidth+       , projectFromColumns, projectFromScalarSubQuery           -- * Query restriction        , QueryRestriction        )  where  import Prelude hiding (and, product)-import Data.Array (Array) import Data.DList (DList)+import Data.Foldable (Foldable)+import Data.Traversable (Traversable) -import Database.Relational.Query.Context (Flat, Aggregated)-import Database.Relational.Query.Component-  (ColumnSQL, Config, Duplication (..),-   AggregateElem, OrderingTerms)-import qualified Database.Relational.Query.Table as Table+import Database.Relational.Query.Internal.Config (Config)+import Database.Relational.Query.Internal.ContextType (Flat, Aggregated)+import Database.Relational.Query.Internal.SQL (ColumnSQL)+import Database.Relational.Query.Internal.BaseSQL (Duplication (..), OrderingTerm)+import Database.Relational.Query.Internal.GroupingSQL (AggregateElem)+import Database.Relational.Query.Internal.UntypedTable (Untyped)   -- | Set operators@@ -43,13 +49,13 @@ newtype BinOp = BinOp (SetOp, Duplication) deriving Show  -- | Sub-query type-data SubQuery = Table Table.Untyped+data SubQuery = Table Untyped               | Flat Config                 UntypedProjection Duplication JoinProduct (QueryRestriction Flat)-                OrderingTerms+                [OrderingTerm]               | Aggregated Config                 UntypedProjection Duplication JoinProduct (QueryRestriction Flat)-                [AggregateElem] (QueryRestriction Aggregated) OrderingTerms+                [AggregateElem] (QueryRestriction Aggregated) [OrderingTerm]               | Bin BinOp SubQuery SubQuery               deriving Show @@ -57,20 +63,21 @@ newtype Qualifier = Qualifier Int  deriving Show  -- | Qualified query.-data Qualified a = Qualified a Qualifier  deriving Show+data Qualified a =+  Qualified Qualifier a+  deriving (Show, Functor, Foldable, Traversable) --- | 'Functor' instance of 'Qualified'-instance Functor Qualified where-  fmap f (Qualified a i) = Qualified (f a) i+-- | Get qualifier+qualifier :: Qualified a -> Qualifier+qualifier (Qualified q _) = q --- | Projection structure unit-data ProjectionUnit = Columns (Array Int ColumnSQL)-                    | Normalized (Qualified Int)-                    | Scalar SubQuery-                    deriving Show+-- | Unqualify.+unQualify :: Qualified a -> a+unQualify (Qualified _ a) = a --- | Untyped projection. Forgot record type.-type UntypedProjection = [ProjectionUnit]+-- | Add qualifier+qualify :: Qualifier -> a -> Qualified a+qualify = Qualified   -- | node attribute for product.@@ -89,6 +96,14 @@ -- | Product node. node attribute and product tree. data Node rs = Node !NodeAttr !(ProductTree rs)  deriving (Show, Functor) +-- | Get node attribute.+nodeAttr :: Node rs -> NodeAttr+nodeAttr (Node a _) = a  where++-- | Get tree from node.+nodeTree :: Node rs -> ProductTree rs+nodeTree (Node _ t) = t+ -- | Product tree with join restriction. type QueryProductTree = ProductTree (QueryRestriction Flat) @@ -102,6 +117,20 @@ type JoinProduct = Maybe QueryProductTree  +-- | Projection structure unit with single column width+data ProjectionUnit+  = RawColumn ColumnSQL            -- ^ used in immediate value or unsafe operations+  | SubQueryRef (Qualified Int)    -- ^ normalized sub-query reference T<n> with Int index+  | Scalar SubQuery                -- ^ scalar sub-query+  deriving Show++-- | Untyped projection. Forgot record type.+type UntypedProjection = [ProjectionUnit]++-- | Width of 'UntypedProjection'.+untypedProjectionWidth :: UntypedProjection -> Int+untypedProjectionWidth = length+ -- | Phantom typed projection. Projected into Haskell record type 't'. newtype Projection c t =   Projection@@ -110,6 +139,19 @@ -- | Unsafely type projection value. typedProjection :: UntypedProjection -> Projection c t typedProjection =  Projection++-- | Width of 'Projection'.+projectionWidth :: Projection c r -> Int+projectionWidth = length . untypeProjection++-- | Unsafely generate 'Projection' from SQL string list.+projectFromColumns :: [ColumnSQL]    -- ^ SQL string list specifies columns+                   -> Projection c r -- ^ Result 'Projection'+projectFromColumns =  typedProjection . map RawColumn++-- | Unsafely generate 'Projection' from scalar sub-query.+projectFromScalarSubQuery :: SubQuery -> Projection c t+projectFromScalarSubQuery = typedProjection . (:[]) . Scalar   -- | Type for restriction of query.

@@ -0,0 +1,44 @@+-- |+-- Module      : Database.Relational.Query.Internal.UntypedTable+-- Copyright   : 2013-2017 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines no-phantom table type which has table metadatas.+module Database.Relational.Query.Internal.UntypedTable (+  Untyped (Untyped), name', width', columns', (!),+  ) where++import Data.Array (Array, elems)+import qualified Data.Array as Array++import Database.Relational.Query.Internal.SQL (ColumnSQL)+++-- | Untyped typed table type+data Untyped = Untyped String Int (Array Int ColumnSQL)  deriving Show++-- | Name string of table in SQL+name' :: Untyped -> String+name'       (Untyped n _ _) = n++-- | Width of table+width' :: Untyped -> Int+width'      (Untyped _ w _) = w++-- | Column name strings in SQL+columnArray :: Untyped -> Array Int ColumnSQL+columnArray (Untyped _ _ c) = c++-- | Column name strings in SQL+columns' :: Untyped -> [ColumnSQL]+columns' =  elems . columnArray++-- | Column name string in SQL specified by index+(!) :: Untyped+    -> Int       -- ^ Column index+    -> ColumnSQL -- ^ Column name String in SQL+t ! i = columnArray t Array.! i

@@ -6,7 +6,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Aggregate--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -29,15 +29,19 @@ import Data.Functor.Identity (Identity (runIdentity)) import Data.Monoid ((<>)) +import Language.SQL.Keyword (Keyword(..))+import qualified Language.SQL.Keyword as SQL++import Database.Relational.Query.Internal.SQL (showsColumnSQL)+import Database.Relational.Query.Internal.BaseSQL (Duplication, OrderingTerm, composeOrderBy)+import Database.Relational.Query.Internal.GroupingSQL (AggregateColumnRef, AggregateElem, composePartitionBy)+ import Database.Relational.Query.Context (Flat, Aggregated, OverWindow) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection-import Database.Relational.Query.Component-  (AggregateColumnRef, Duplication, OrderingTerms, AggregateElem, composeOver, showsColumnSQL) import Database.Relational.Query.Sub (SubQuery, QueryRestriction, JoinProduct, aggregatedSubQuery) import qualified Database.Relational.Query.Sub as SubQuery import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable)- import Database.Relational.Query.Monad.Class (MonadRestrict(..)) import Database.Relational.Query.Monad.Trans.Restricting   (Restrictings, restrictings, extractRestrict)@@ -63,7 +67,7 @@   restrict = restrictings . restrict  extract :: AggregatedQuery p r-        -> ConfigureQuery (((((((PlaceHolders p, Projection Aggregated r), OrderingTerms),+        -> ConfigureQuery (((((((PlaceHolders p, Projection Aggregated r), [OrderingTerm]),                                QueryRestriction Aggregated),                               [AggregateElem]),                              QueryRestriction Flat),@@ -83,7 +87,7 @@   c <- askConfig   return $ aggregatedSubQuery c (Projection.untype pj) da pd rs ag grs ot -extractWindow :: Window c a -> ((a, OrderingTerms), [AggregateColumnRef])+extractWindow :: Window c a -> ((a, [OrderingTerm]), [AggregateColumnRef]) extractWindow =  runIdentity . extractAggregateTerms . extractOrderingTerms  -- | Operator to make window function result projection using built 'Window' monad.@@ -93,7 +97,7 @@      -> Projection c a wp `over` win =   Projection.unsafeFromSqlTerms-  [ showsColumnSQL c <> composeOver pt ot+  [ showsColumnSQL c <> OVER <> SQL.paren (composePartitionBy pt <> composeOrderBy ot)   | c <- Projection.columns wp   ]  where (((), ot), pt) = extractWindow win 

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Assign--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -19,8 +19,10 @@   extract,   ) where +import Database.Relational.Query.Internal.BaseSQL (Assignment)+import Database.Relational.Query.Internal.Config (Config)+ import Database.Relational.Query.Sub (QueryRestriction)-import Database.Relational.Query.Component (Config, Assignments) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Table (Table) import Database.Relational.Query.Projection (Projection)@@ -28,6 +30,7 @@ import qualified Database.Relational.Query.Monad.Restrict as Restrict import Database.Relational.Query.Monad.Trans.Assigning (Assignings, extractAssignments) + -- | Target update monad type used from update statement and merge statement. type Assign r = Assignings r Restrict @@ -42,5 +45,5 @@ -- updateStatement =  assignings . restrictings . Identity  -- | Run 'Assign'.-extract :: Assign r a -> Config -> ((a, Table r -> Assignments), QueryRestriction Flat)+extract :: Assign r a -> Config -> ((a, Table r -> [Assignment]), QueryRestriction Flat) extract =  Restrict.extract . extractAssignments

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.BaseType--- Copyright   : 2015 Kei Hibino+-- Copyright   : 2015-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -25,8 +25,9 @@ import Data.Functor.Identity (Identity, runIdentity) import Control.Applicative ((<$>)) -import Database.Relational.Query.Component (Config, defaultConfig)+import Database.Relational.Query.Internal.Config (Config, defaultConfig) import Database.Relational.Query.Internal.SQL (StringSQL, showStringSQL)+ import Database.Relational.Query.Sub (Qualified, SubQuery, showSQL) import qualified Database.Relational.Query.Monad.Trans.Qualify as Qualify import Database.Relational.Query.Monad.Trans.Qualify (Qualify, qualify, evalQualifyPrime)

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Class--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -21,8 +21,10 @@          on, wheres, having,        ) where +import Database.Relational.Query.Internal.BaseSQL (Duplication (..))+import Database.Relational.Query.Internal.GroupingSQL (AggregateKey)+ import Database.Relational.Query.Context (Flat, Aggregated)-import Database.Relational.Query.Component (Duplication (..), AggregateKey) import Database.Relational.Query.Projection (Projection) import Database.Relational.Query.Projectable (PlaceHolders) import Database.Relational.Query.Monad.BaseType (ConfigureQuery, Relation)

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.Register--- Copyright   : 2015 Kei Hibino+-- Copyright   : 2015-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,7 +15,9 @@   extract,   ) where -import Database.Relational.Query.Component (Config, Assignments)+import Database.Relational.Query.Internal.BaseSQL (Assignment)+import Database.Relational.Query.Internal.Config (Config)+ import Database.Relational.Query.Table (Table) import Database.Relational.Query.Monad.BaseType (ConfigureQuery, configureQuery) import Database.Relational.Query.Monad.Trans.Assigning (Assignings, extractAssignments)@@ -25,5 +27,5 @@ type Register r = Assignings r ConfigureQuery  -- | Run 'InsertStatement'.-extract :: Assignings r ConfigureQuery a -> Config -> (a, Table r -> Assignments)+extract :: Assignings r ConfigureQuery a -> Config -> (a, Table r -> [Assignment]) extract = configureQuery . extractAssignments

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Restrict--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -20,8 +20,9 @@   extract   ) where +import Database.Relational.Query.Internal.Config (Config)+ import Database.Relational.Query.Sub (QueryRestriction)-import Database.Relational.Query.Component (Config) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection) import Database.Relational.Query.Monad.Trans.Restricting

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Simple--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -26,6 +26,8 @@ import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection +import Database.Relational.Query.Internal.BaseSQL (Duplication, OrderingTerm)+ import Database.Relational.Query.Monad.Trans.Join (join') import Database.Relational.Query.Monad.Trans.Restricting (restrictings) import Database.Relational.Query.Monad.Trans.Ordering@@ -34,7 +36,6 @@ import Database.Relational.Query.Monad.Type (QueryCore, extractCore, OrderedQuery) import Database.Relational.Query.Projectable (PlaceHolders) -import Database.Relational.Query.Component (Duplication, OrderingTerms) import Database.Relational.Query.Sub (SubQuery, QueryRestriction, JoinProduct, flatSubQuery) import qualified Database.Relational.Query.Sub as SubQuery @@ -50,7 +51,7 @@ simple =  orderings . restrictings . join'  extract :: SimpleQuery p r-        -> ConfigureQuery (((((PlaceHolders p, Projection Flat r), OrderingTerms), QueryRestriction Flat),+        -> ConfigureQuery (((((PlaceHolders p, Projection Flat r), [OrderingTerm]), QueryRestriction Flat),                            JoinProduct), Duplication) extract =  extractCore . extractOrderingTerms 

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Aggregating--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -36,14 +36,14 @@  import Data.Functor.Identity (Identity (runIdentity)) -import Database.Relational.Query.Context (Flat, Aggregated, Set, Power, SetList)-import Database.Relational.Query.Component+import Database.Relational.Query.Internal.GroupingSQL   (AggregateColumnRef, AggregateElem, aggregateColumnRef, AggregateSet, aggregateGroupingSet,    AggregateBitKey, aggregatePowerKey, aggregateRollup, aggregateCube, aggregateSets,    AggregateKey, aggregateKeyProjection, aggregateKeyElement, unsafeAggregateKey)++import Database.Relational.Query.Context (Flat, Aggregated, Set, Power, SetList) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection- import Database.Relational.Query.Monad.Class   (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..)) 

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Assigning--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -24,7 +24,6 @@   extractAssignments   ) where -import Database.Relational.Query.Context (Flat) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Writer (WriterT, runWriterT, tell) import Control.Applicative (Applicative, pure, (<$>))@@ -32,12 +31,13 @@ import Data.Monoid (mconcat) import Data.DList (DList, toList) -import Database.Relational.Query.Component (Assignment, Assignments)+import Database.Relational.Query.Internal.BaseSQL (Assignment)++import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Pi (Pi) import Database.Relational.Query.Table (Table) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection- import Database.Relational.Query.Monad.Class (MonadQualify (..), MonadRestrict(..))  @@ -81,5 +81,5 @@ -- | Run 'Assignings' to get 'Assignments' extractAssignments :: (Monad m, Functor m)                    => Assignings r m a-                   -> m (a, Table r -> Assignments)+                   -> m (a, Table r -> [Assignment]) extractAssignments (Assignings ac) = second (toList .) <$> runWriterT ac

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Config--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -20,7 +20,7 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT, ask) import Control.Applicative (Applicative) -import Database.Relational.Query.Component (Config)+import Database.Relational.Query.Internal.Config (Config)   -- | 'ReaderT' type to require query generate configuration.

@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Join--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -33,15 +33,15 @@ import Data.Maybe (fromMaybe) import Data.Monoid (Last (Last, getLast)) +import Database.Relational.Query.Internal.BaseSQL (Duplication (All))+import Database.Relational.Query.Internal.Product (restrictProduct, growProduct)++import Database.Relational.Query.Sub (NodeAttr (Just', Maybe), SubQuery, Qualified, JoinProduct, Projection) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Monad.Trans.JoinState   (JoinContext, primeJoinContext, updateProduct, joinProduct)-import Database.Relational.Query.Internal.Sub (NodeAttr (Just', Maybe), SubQuery, Qualified, JoinProduct, Projection)-import Database.Relational.Query.Internal.Product (restrictProduct, growProduct) import qualified Database.Relational.Query.Projection as Projection-import Database.Relational.Query.Component (Duplication (All)) import Database.Relational.Query.Projectable (PlaceHolders, unsafeAddPlaceHolders)- import Database.Relational.Query.Monad.BaseType (ConfigureQuery, qualifyQuery, Relation, untypeRelation) import Database.Relational.Query.Monad.Class (MonadQualify (..), MonadQuery (..)) 

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.Trans.JoinState--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -9,6 +9,8 @@ -- -- This module provides state definition for -- "Database.Relational.Query.Monad.Trans.Join".+--+-- This is not public interface. module Database.Relational.Query.Monad.Trans.JoinState (   -- * Join context   JoinContext, primeJoinContext, updateProduct, joinProduct@@ -17,8 +19,8 @@ import Prelude hiding (product) import Data.DList (toList) -import qualified Database.Relational.Query.Sub as Product-import Database.Relational.Query.Sub (ProductBuilder, JoinProduct)+import Database.Relational.Query.Internal.Sub (ProductBuilder, JoinProduct)+import qualified Database.Relational.Query.Internal.Sub as Product   -- | JoinContext type for QueryJoin.

@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Ordering--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -16,7 +16,7 @@ -- from query into query with ordering. module Database.Relational.Query.Monad.Trans.Ordering (   -- * Transformer into query with ordering-  Orderings, orderings, OrderingTerms,+  Orderings, orderings,    -- * API of query with ordering   orderBy, asc, desc,@@ -31,11 +31,11 @@ import Control.Arrow (second) import Data.DList (DList, toList) -import Database.Relational.Query.Component-  (Order(Asc, Desc), OrderColumn, OrderingTerm, OrderingTerms)+import Database.Relational.Query.Internal.BaseSQL+  (Order(Asc, Desc), OrderColumn, OrderingTerm)+ import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection- import Database.Relational.Query.Monad.Class   (MonadQualify (..), MonadRestrict(..), MonadQuery(..), MonadAggregate(..), MonadPartition(..)) @@ -110,5 +110,5 @@ desc =  updateOrderBys Desc  -- | Run 'Orderings' to get 'OrderingTerms'-extractOrderingTerms :: (Monad m, Functor m) => Orderings c m a -> m (a, OrderingTerms)+extractOrderingTerms :: (Monad m, Functor m) => Orderings c m a -> m (a, [OrderingTerm]) extractOrderingTerms (Orderings oc) = second toList <$> runWriterT oc

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Qualify--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -10,6 +10,8 @@ -- Portability : unknown -- -- This module defines monad transformer which qualify uniquely SQL table forms.+--+-- This is not public interface. module Database.Relational.Query.Monad.Trans.Qualify (   -- * Qualify monad   Qualify, qualify,@@ -19,17 +21,14 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State (StateT, runStateT, get, modify) import Control.Applicative (Applicative)-import Control.Monad (liftM)+import Control.Monad (liftM, ap) -import Database.Relational.Query.Sub (Qualified)-import qualified Database.Relational.Query.Sub as SubQuery+import qualified Database.Relational.Query.Internal.Sub as Internal  -type AliasId = Int- -- | Monad type to qualify SQL table forms. newtype Qualify m a =-  Qualify (StateT AliasId m a)+  Qualify (StateT Int m a)   deriving (Monad, Functor, Applicative)  -- | Run qualify monad with initial state to get only result.@@ -37,9 +36,9 @@ evalQualifyPrime (Qualify s) = fst `liftM` runStateT s 0 {- primary alias id -}  -- | Generated new qualifier on internal state.-newAlias :: Monad m => Qualify m AliasId+newAlias :: Monad m => Qualify m Internal.Qualifier newAlias =  Qualify $ do-  ai <- get+  ai <- Internal.Qualifier `liftM` get   modify (+ 1)   return ai @@ -49,8 +48,7 @@  -- | Get qualifyed table form query. qualifyQuery :: Monad m-             => query                       -- ^ Query to qualify-             -> Qualify m (Qualified query) -- ^ Result with updated state+             => query                                -- ^ Query to qualify+             -> Qualify m (Internal.Qualified query) -- ^ Result with updated state qualifyQuery query =-  do n <- newAlias-     return . SubQuery.qualify query $ SubQuery.Qualifier n+  Internal.qualify `liftM` newAlias `ap` return query

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Restricting--- Copyright   : 2014-2016 Kei Hibino+-- Copyright   : 2014-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -27,7 +27,6 @@ import Data.DList (DList, toList)  import Database.Relational.Query.Sub (QueryRestriction, Projection)- import Database.Relational.Query.Monad.Class   (MonadQualify (..), MonadRestrict(..), MonadQuery (..), MonadAggregate(..)) 

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.Type--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -14,7 +14,8 @@          OrderedQuery,        ) where -import Database.Relational.Query.Component (Duplication)+import Database.Relational.Query.Internal.BaseSQL (Duplication)+ import Database.Relational.Query.Sub (JoinProduct, QueryRestriction) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection)

@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Unique--- Copyright   : 2014-2016 Kei Hibino+-- Copyright   : 2014-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -21,18 +21,17 @@  import Control.Applicative (Applicative) +import Database.Relational.Query.Internal.BaseSQL (Duplication)+ import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection-+import Database.Relational.Query.Projectable (PlaceHolders) import Database.Relational.Query.Monad.Class (MonadQualify, MonadQuery) import Database.Relational.Query.Monad.Trans.Join (unsafeSubQueryWithAttr) import Database.Relational.Query.Monad.Trans.Restricting (restrictings) import Database.Relational.Query.Monad.BaseType (ConfigureQuery, askConfig) import Database.Relational.Query.Monad.Type (QueryCore, extractCore)-import Database.Relational.Query.Projectable (PlaceHolders)--import Database.Relational.Query.Component (Duplication) import Database.Relational.Query.Sub   (SubQuery, QueryRestriction, Qualified, JoinProduct, NodeAttr, flatSubQuery) 

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Pi--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -23,6 +23,7 @@  import Database.Relational.Query.Pi.Unsafe   (Pi, pfmap, pap, (<.>), (<?.>), (<?.?>), definePi)+  -- | Identity projection path. id' :: PersistableWidth a => Pi a a

@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Projectable--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -78,13 +78,12 @@    HasColumnConstraint, NotNull)  import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL)-import Database.Relational.Query.Context (Flat, Aggregated, Exists, OverWindow) +import Database.Relational.Query.Context (Flat, Aggregated, Exists, OverWindow) import Database.Relational.Query.Pure   (ShowConstantTermsSQL, showConstantTermsSQL', ProductConstructor (..)) import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi as Pi- import Database.Relational.Query.Projection   (Projection, ListProjection) import qualified Database.Relational.Query.Projection as Projection

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Projection--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -47,20 +47,24 @@ import Database.Record (HasColumnConstraint, NotNull, NotNullColumnConstraint) import qualified Database.Record.KeyConstraint as KeyConstraint -import Database.Relational.Query.Internal.SQL (StringSQL, listStringSQL)+import Database.Relational.Query.Internal.SQL+  (StringSQL, listStringSQL,+   ColumnSQL, showsColumnSQL, columnSQL', ) import Database.Relational.Query.Internal.Sub-  (SubQuery, UntypedProjection, Projection, untypeProjection, typedProjection, Qualified)+  (SubQuery, Qualified, UntypedProjection,+   Projection, untypeProjection, typedProjection, projectionWidth)+import qualified Database.Relational.Query.Internal.Sub as Internal+ import Database.Relational.Query.Context (Aggregated, Flat)-import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, columnSQL') import Database.Relational.Query.Table (Table) import qualified Database.Relational.Query.Table as Table import Database.Relational.Query.Pure (ProductConstructor (..)) import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi import Database.Relational.Query.Sub-  (widthOfUntypedProjection, projectionColumns,-   untypedProjectionFromJoinedSubQuery, untypedProjectionFromScalarSubQuery,-   unsafeProjectionStringSql, unsafeProjectFromColumns)+  (projectionColumns,+   untypedProjectionFromJoinedSubQuery,+   unsafeProjectionStringSql) import qualified Database.Relational.Query.Sub as SubQuery  @@ -75,7 +79,7 @@  -- | Width of 'Projection'. width :: Projection c r -> Int-width =  widthOfUntypedProjection . untypeProjection+width = projectionWidth  -- | Unsafely get untyped projection. untype :: Projection c r -> UntypedProjection@@ -88,22 +92,22 @@  -- | Unsafely generate 'Projection' from scalar sub-query. unsafeFromScalarSubQuery :: SubQuery -> Projection c t-unsafeFromScalarSubQuery =  typedProjection . untypedProjectionFromScalarSubQuery+unsafeFromScalarSubQuery = Internal.projectFromScalarSubQuery  -- | Unsafely generate unqualified 'Projection' from 'Table'. unsafeFromTable :: Table r                 -> Projection c r-unsafeFromTable =  unsafeProjectFromColumns . Table.columns+unsafeFromTable = Internal.projectFromColumns . Table.columns  -- | Unsafely generate 'Projection' from SQL expression strings. unsafeFromSqlTerms :: [StringSQL] -> Projection c t-unsafeFromSqlTerms =  unsafeProjectFromColumns . map columnSQL'+unsafeFromSqlTerms = Internal.projectFromColumns . map columnSQL'   -- | Unsafely trace projection path. unsafeProject :: Projection c a' -> Pi a b -> Projection c b' unsafeProject p pi' =-  unsafeProjectFromColumns+  Internal.projectFromColumns   . (`UnsafePi.pi` pi')   . columns $ p 

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Pure--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -37,6 +37,7 @@   (PersistableWidth, persistableWidth, PersistableRecordWidth) import Database.Record.Persistable   (runPersistableRecordWidth)+ import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL)  

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Relation--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -42,6 +42,8 @@  import Control.Applicative ((<$>)) +import Database.Relational.Query.Internal.BaseSQL (Duplication (Distinct, All))+ import Database.Relational.Query.Context (Flat, Aggregated) import Database.Relational.Query.Monad.BaseType   (ConfigureQuery, qualifyQuery,@@ -54,13 +56,9 @@ import qualified Database.Relational.Query.Monad.Aggregate as Aggregate import Database.Relational.Query.Monad.Unique (QueryUnique, unsafeUniqueSubQuery) import qualified Database.Relational.Query.Monad.Unique as Unique--import Database.Relational.Query.Component (Duplication (Distinct, All)) import Database.Relational.Query.Table (Table, TableDerivable, derivedTable)-import Database.Relational.Query.Internal.Sub (NodeAttr(Just', Maybe))-import Database.Relational.Query.Sub (SubQuery)+import Database.Relational.Query.Sub (SubQuery, NodeAttr(Just', Maybe)) import qualified Database.Relational.Query.Sub as SubQuery- import Database.Relational.Query.Scalar (ScalarDegree) import Database.Relational.Query.Pi (Pi) import Database.Relational.Query.Projection@@ -148,7 +146,14 @@ aggregateRelation =  aggregateRelation' . addUnitPH  --- | Restriction function type for direct style join operator.+-- | 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 = Projection Flat a -> Projection Flat b -> Projection Flat (Maybe Bool)  -- | Basic direct join operation with place-holder parameters.

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.SQL--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -31,13 +31,14 @@  import Language.SQL.Keyword (Keyword(..), (.=.), (|*|)) import qualified Language.SQL.Keyword as SQL- import Database.Record.ToSql (untypedUpdateValuesIndex) -import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL, rowConsStringSQL)+import Database.Relational.Query.Internal.SQL+  (StringSQL, stringSQL, showStringSQL, rowConsStringSQL,+   ColumnSQL, showsColumnSQL, showsColumnSQL, )+ import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi-import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, showsColumnSQL) import Database.Relational.Query.Table (Table, name, columns) import qualified Database.Relational.Query.Projection as Projection 

@@ -3,7 +3,7 @@  -- | -- Module      : Database.Relational.Query.Scalar--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -17,6 +17,7 @@   ) where  import Language.Haskell.TH (Q, TypeQ, Dec)+ import Database.Record (PersistableWidth)  

@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Sub--- Copyright   : 2013-2016 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -18,22 +18,29 @@    -- * Qualified Sub-query   Qualifier (Qualifier),-  Qualified, qualifier, unQualify, qualify,+  Qualified,   queryWidth, +  -- deprecated interfaces+  qualifier, unQualify, qualify,+   -- * Sub-query columns   column,    -- * Projection   Projection, ProjectionUnit, UntypedProjection, -  untypedProjectionFromColumns, untypedProjectionFromJoinedSubQuery, untypedProjectionFromScalarSubQuery,-  widthOfUntypedProjection, columnsOfUntypedProjection,+  untypedProjectionFromJoinedSubQuery, -  projectionColumns, unsafeProjectionStringSql, unsafeProjectFromColumns,+  projectionColumns, unsafeProjectionStringSql, +  -- deprecated interfaces+  untypedProjectionFromColumns, untypedProjectionFromScalarSubQuery,+  unsafeProjectFromColumns,+  widthOfUntypedProjection, columnsOfUntypedProjection,+   -- * Product of sub-queries-  JoinProduct, NodeAttr,+  JoinProduct, NodeAttr (..),   nodeTree,   ProductBuilder, @@ -42,32 +49,39 @@   composeWhere, composeHaving   ) where -import Data.Array (listArray)-import qualified Data.Array as Array+import Control.Applicative ((<$>)) import Data.Monoid (mempty, (<>), mconcat)+import Data.Traversable (traverse) +import Language.SQL.Keyword (Keyword(..), (|*|))+import qualified Language.SQL.Keyword as SQL++import Database.Relational.Query.Internal.Config+  (Config (productUnitSupport), ProductUnitSupport (PUSupported, PUNotSupported)) import qualified Database.Relational.Query.Context as Context-import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, rowStringSQL, showStringSQL)+import Database.Relational.Query.Internal.SQL+  (StringSQL, stringSQL, rowStringSQL, showStringSQL,+   ColumnSQL, columnSQL', showsColumnSQL, )+import Database.Relational.Query.Internal.BaseSQL+  (Duplication (..), showsDuplication, OrderingTerm, composeOrderBy, )+import Database.Relational.Query.Internal.GroupingSQL+  (AggregateElem, composeGroupBy, ) import Database.Relational.Query.Internal.Sub-  (SubQuery (..), Projection, untypeProjection, typedProjection,+  (SubQuery (..), Projection,    UntypedProjection, ProjectionUnit (..),    JoinProduct, QueryProductTree, ProductBuilder,-   NodeAttr (Just', Maybe), ProductTree (Leaf, Join), Node (Node),+   NodeAttr (Just', Maybe), ProductTree (Leaf, Join), Node,    SetOp (..), BinOp (..), Qualifier (..), Qualified (..),    QueryRestriction)-import Database.Relational.Query.Component-  (ColumnSQL, columnSQL', showsColumnSQL,-   Config (productUnitSupport), ProductUnitSupport (PUSupported, PUNotSupported),-   Duplication (..), showsDuplication,-   AggregateElem, composeGroupBy, OrderingTerms, composeOrderBy)-import Database.Relational.Query.Table (Table, (!))+import qualified Database.Relational.Query.Internal.Sub as Internal+import Database.Relational.Query.Internal.UntypedTable ((!))+import qualified Database.Relational.Query.Internal.UntypedTable as UntypedTable++import Database.Relational.Query.Table (Table) import qualified Database.Relational.Query.Table as Table import Database.Relational.Query.Pure (showConstantTermsSQL') -import Language.SQL.Keyword (Keyword(..), (|*|))-import qualified Language.SQL.Keyword as SQL - showsSetOp' :: SetOp -> StringSQL showsSetOp' =  d  where   d Union     = UNION@@ -90,7 +104,7 @@              -> Duplication              -> JoinProduct              -> QueryRestriction Context.Flat-             -> OrderingTerms+             -> [OrderingTerm]              -> SubQuery flatSubQuery = Flat @@ -102,7 +116,7 @@                    -> QueryRestriction Context.Flat                    -> [AggregateElem]                    -> QueryRestriction Context.Aggregated-                   -> OrderingTerms+                   -> [OrderingTerm]                    -> SubQuery aggregatedSubQuery = Aggregated @@ -124,23 +138,23 @@ -- | Width of 'SubQuery'. width :: SubQuery -> Int width =  d  where-  d (Table u)                     = Table.width' u+  d (Table u)                     = UntypedTable.width' u   d (Bin _ l _)                   = width l-  d (Flat _ up _ _ _ _)           = widthOfUntypedProjection up-  d (Aggregated _ up _ _ _ _ _ _) = widthOfUntypedProjection up+  d (Flat _ up _ _ _ _)           = Internal.untypedProjectionWidth up+  d (Aggregated _ up _ _ _ _ _ _) = Internal.untypedProjectionWidth up  -- | SQL to query table.-fromTableToSQL :: Table.Untyped -> StringSQL+fromTableToSQL :: UntypedTable.Untyped -> StringSQL fromTableToSQL t =-  SELECT <> SQL.fold (|*|) [showsColumnSQL c | c <- Table.columns' t] <>-  FROM <> stringSQL (Table.name' t)+  SELECT <> SQL.fold (|*|) [showsColumnSQL c | c <- UntypedTable.columns' t] <>+  FROM <> stringSQL (UntypedTable.name' t)  -- | Generate normalized column SQL from table.-fromTableToNormalizedSQL :: Table.Untyped -> StringSQL+fromTableToNormalizedSQL :: UntypedTable.Untyped -> StringSQL fromTableToNormalizedSQL t = SELECT <> SQL.fold (|*|) columns' <>-                             FROM <> stringSQL (Table.name' t)  where+                             FROM <> stringSQL (UntypedTable.name' t)  where   columns' = zipWith asColumnN-             (Table.columns' t)+             (UntypedTable.columns' t)              [(0 :: Int)..]  -- | Normalized column SQL@@ -159,14 +173,14 @@ selectPrefixSQL up da = SELECT <> showsDuplication da <>                         SQL.fold (|*|) columns'  where   columns' = zipWith asColumnN-             (columnsOfUntypedProjection up)+             (map columnOfProjectionUnit up)              [(0 :: Int)..]  -- | SQL string for nested-query and toplevel-SQL. toSQLs :: SubQuery        -> (StringSQL, StringSQL) -- ^ sub-query SQL and top-level SQL toSQLs =  d  where-  d (Table u)               = (stringSQL $ Table.name' u, fromTableToSQL u)+  d (Table u)               = (stringSQL $ UntypedTable.name' u, fromTableToSQL u)   d (Bin (BinOp (op, da)) l r) = (SQL.paren q, q)  where     q = mconcat [normalizedSQL l, showsSetOp op da, normalizedSQL r]   d (Flat cf up da pd rs od)   = (SQL.paren q, q)  where@@ -191,17 +205,20 @@ toSQL :: SubQuery -> String toSQL =  showStringSQL . showSQL +{-# DEPRECATED qualifier "prepare to drop public interface. use Database.Relational.Query.Internal.Sub.qualifier." #-} -- | Get qualifier qualifier :: Qualified a -> Qualifier-qualifier (Qualified _ i) = i+qualifier = Internal.qualifier +{-# DEPRECATED unQualify "prepare to drop public interface. use Database.Relational.Query.Internal.Sub.unQualify." #-} -- | Unqualify. unQualify :: Qualified a -> a-unQualify (Qualified a _) = a+unQualify = Internal.unQualify +{-# DEPRECATED qualify "prepare to drop public interface. use Database.Relational.Query.Internal.Sub.qualify." #-} -- | Add qualifier qualify :: a -> Qualifier -> Qualified a-qualify =  Qualified+qualify a q = Internal.qualify q a  columnN :: Int -> StringSQL columnN i = stringSQL $ 'f' : show i@@ -215,123 +232,99 @@  -- | Binary operator to qualify. (<.>) :: Qualifier -> ColumnSQL -> ColumnSQL-i <.> n = fmap (showQualifier i SQL.<.>) n+i <.> n = (showQualifier i SQL.<.>) <$> n  -- | Qualified expression from qualifier and projection index. columnFromId :: Qualifier -> Int -> ColumnSQL columnFromId qi i = qi <.> columnSQL' (columnN i) --- | From 'Qualified' SQL string into 'String'.+-- | From 'Qualified' SQL string into qualified formed 'String'+--  like (SELECT ...) AS T<n> qualifiedSQLas :: Qualified StringSQL -> StringSQL-qualifiedSQLas q = unQualify q <> showQualifier (qualifier q)+qualifiedSQLas q = Internal.unQualify q <> showQualifier (Internal.qualifier q)  -- | Width of 'Qualified' 'SubQUery'. queryWidth :: Qualified SubQuery -> Int-queryWidth =  width . unQualify+queryWidth =  width . Internal.unQualify  -- | Get column SQL string of 'SubQuery'. column :: Qualified SubQuery -> Int -> ColumnSQL-column qs =  d (unQualify qs)  where-  q = qualifier qs+column qs =  d (Internal.unQualify qs)  where+  q = Internal.qualifier qs   d (Table u)           i           = q <.> (u ! i)   d (Bin {})            i           = q `columnFromId` i   d (Flat _ up _ _ _ _) i           = columnOfUntypedProjection up i   d (Aggregated _ up _ _ _ _ _ _) i = columnOfUntypedProjection up i --- | Get qualified SQL string, like (SELECT ...) AS T0-qualifiedForm :: Qualified SubQuery -> StringSQL-qualifiedForm =  qualifiedSQLas . fmap showUnitSQL --projectionUnitFromColumns :: [ColumnSQL] -> ProjectionUnit-projectionUnitFromColumns cs = Columns $ listArray (0, length cs - 1) cs--projectionUnitFromScalarSubQuery :: SubQuery -> ProjectionUnit-projectionUnitFromScalarSubQuery =  Scalar--unitUntypedProjection :: ProjectionUnit -> UntypedProjection-unitUntypedProjection =  (:[])-+{-# DEPRECATED untypedProjectionFromColumns "prepare to drop public interface. use (map RawColumn)." #-} -- | Make untyped projection from columns. untypedProjectionFromColumns :: [ColumnSQL] -> UntypedProjection-untypedProjectionFromColumns =  unitUntypedProjection . projectionUnitFromColumns+untypedProjectionFromColumns =  map RawColumn +{-# DEPRECATED untypedProjectionFromScalarSubQuery "prepare to drop public interface. use ( (:[]) . Scalar )." #-} -- | Make untyped projection from scalar sub-query. untypedProjectionFromScalarSubQuery :: SubQuery -> UntypedProjection-untypedProjectionFromScalarSubQuery =  unitUntypedProjection . projectionUnitFromScalarSubQuery+untypedProjectionFromScalarSubQuery = (:[]) . Scalar  -- | Make untyped projection from joined sub-query. untypedProjectionFromJoinedSubQuery :: Qualified SubQuery -> UntypedProjection-untypedProjectionFromJoinedSubQuery qs = d $ unQualify qs  where  --  unitUntypedProjection . Sub-  normalized = unitUntypedProjection . Normalized $ fmap width qs-  d (Table _)               =  untypedProjectionFromColumns . map (column qs)+untypedProjectionFromJoinedSubQuery qs = d $ Internal.unQualify qs  where+  normalized = SubQueryRef <$> traverse (\q -> [0 .. width q - 1]) qs+  d (Table _)               =  map RawColumn . map (column qs)                                $ take (queryWidth qs) [0..]   d (Bin {})                =  normalized   d (Flat {})               =  normalized   d (Aggregated {})         =  normalized --- | ProjectionUnit width.-widthOfProjectionUnit :: ProjectionUnit -> Int-widthOfProjectionUnit =  d  where-  d (Columns a)     = mx - mn + 1 where (mn, mx) = Array.bounds a-  d (Normalized qw) = unQualify qw-  d (Scalar _)      = 1---- | Get column of ProjectionUnit.-columnOfProjectionUnit :: ProjectionUnit -> Int -> ColumnSQL-columnOfProjectionUnit =  d  where-  d (Columns a) i | mn <= i && i <= mx = a Array.! i-                  | otherwise          = error $ "index out of bounds (unit): " ++ show i-    where (mn, mx) = Array.bounds a-  d (Normalized qw) i | i < w          = qualifier qw `columnFromId` i-                      | otherwise      = error $ "index out of bounds (normalized unit): " ++ show i-    where w = unQualify qw-  d (Scalar sub)    0                  = columnSQL' $ showUnitSQL sub-  d (Scalar _)      i                  = error $ "index out of bounds (scalar unit): " ++ show i+-- | Convert from ProjectionUnit into column.+columnOfProjectionUnit :: ProjectionUnit -> ColumnSQL+columnOfProjectionUnit = d  where+  d (RawColumn e)     = e+  d (SubQueryRef qi)  = Internal.qualifier qi `columnFromId` Internal.unQualify qi+  d (Scalar sub)      = columnSQL' $ showUnitSQL sub +{-# DEPRECATED widthOfUntypedProjection "prepare to drop public interface. use untypedProjectionWidth internally." #-} -- | Width of 'UntypedProjection'. widthOfUntypedProjection :: UntypedProjection -> Int-widthOfUntypedProjection =  sum . map widthOfProjectionUnit+widthOfUntypedProjection = Internal.untypedProjectionWidth  -- | Get column SQL string of 'UntypedProjection'. columnOfUntypedProjection :: UntypedProjection -- ^ Source 'Projection'                           -> Int               -- ^ Column index                           -> ColumnSQL         -- ^ Result SQL string-columnOfUntypedProjection up i' = rec up i' where-  rec []       _        = error $ "index out of bounds: " ++ show i'-  rec (u : us) i-    | i < widthOfProjectionUnit u = columnOfProjectionUnit u i-    | i < 0             = error $ "index out of bounds: " ++ show i-    | otherwise         = rec us (i - widthOfProjectionUnit u)+columnOfUntypedProjection up i+  | 0 <= i && i < Internal.untypedProjectionWidth up  =+    columnOfProjectionUnit $ up !! i+  | otherwise                                         =+    error $ "columnOfUntypedProjection: index out of bounds: " ++ show i +{-# DEPRECATED columnsOfUntypedProjection "prepare to drop unused interface." #-} -- | Get column SQL string list of projection. columnsOfUntypedProjection :: UntypedProjection -- ^ Source 'Projection'                            -> [ColumnSQL]       -- ^ Result SQL string list-columnsOfUntypedProjection p = map (columnOfUntypedProjection p) . take w $ [0 .. ]-  where w = widthOfUntypedProjection p+columnsOfUntypedProjection = map columnOfProjectionUnit  -- | Get column SQL string list of projection. projectionColumns :: Projection c r -- ^ Source 'Projection'                   -> [ColumnSQL]    -- ^ Result SQL string list-projectionColumns =  columnsOfUntypedProjection . untypeProjection+projectionColumns = map columnOfProjectionUnit . Internal.untypeProjection  -- | Unsafely get SQL term from 'Proejction'. unsafeProjectionStringSql :: Projection c r -> StringSQL unsafeProjectionStringSql =  rowStringSQL . map showsColumnSQL . projectionColumns +{-# DEPRECATED unsafeProjectFromColumns "prepare to drop unused interface. use Database.Relational.Query.Internal.Sub.projectFromColumns. " #-} -- | Unsafely generate 'Projection' from SQL string list. unsafeProjectFromColumns :: [ColumnSQL]    -- ^ SQL string list specifies columns                          -> Projection c r -- ^ Result 'Projection'-unsafeProjectFromColumns =  typedProjection . untypedProjectionFromColumns+unsafeProjectFromColumns = Internal.projectFromColumns  --- | Get node attribute.-nodeAttr :: Node rs -> NodeAttr-nodeAttr (Node a _) = a  where-+{-# DEPRECATED nodeTree "prepare to drop unused interface. use Database.Relational.Query.Internal.Sub.nodeTree. " #-} -- | Get tree from node. nodeTree :: Node rs -> ProductTree rs-nodeTree (Node _ t) = t+nodeTree = Internal.nodeTree  -- | Show product tree of query into SQL. StringSQL result. showsQueryProduct :: QueryProductTree -> StringSQL@@ -343,11 +336,11 @@   urec n = case nodeTree n of     p@(Leaf _)     -> rec p     p@(Join {})    -> SQL.paren (rec p)-  rec (Leaf q)               = qualifiedForm q+  rec (Leaf q)               = qualifiedSQLas $ fmap showUnitSQL q   rec (Join left' right' rs) =     mconcat     [urec left',-     joinType (nodeAttr left') (nodeAttr right'), JOIN,+     joinType (Internal.nodeAttr left') (Internal.nodeAttr right'), JOIN,      urec right',      ON, foldr1 SQL.and $ ps ++ concat [ showConstantTermsSQL' True | null ps ] ]     where ps = [ unsafeProjectionStringSql p | p <- rs ]

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Table--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -10,6 +10,7 @@ -- This module defines table type which has table metadatas. module Database.Relational.Query.Table (   -- * Untyped table type+  -- deprecated interfaces   Untyped, name', width', columns', (!),    -- * Phantom typed table type@@ -19,39 +20,33 @@   TableDerivable (..)   ) where -import Data.Array (Array, listArray, elems)-import qualified Data.Array as Array+import Data.Array (listArray)  import Database.Record (PersistableWidth) -import Database.Relational.Query.Component (ColumnSQL, columnSQL)+import qualified Database.Relational.Query.Internal.UntypedTable as Untyped+import Database.Relational.Query.Internal.SQL (ColumnSQL, columnSQL)  +{-# DEPRECATED Untyped, name', width', columns', (!) "prepare to drop public interface. internally use Database.Relational.Query.Internal.UntypedTable.*" #-} -- | Untyped typed table type-data Untyped = Untyped String Int (Array Int ColumnSQL)  deriving Show+type Untyped = Untyped.Untyped  -- | Name string of table in SQL name' :: Untyped -> String-name'       (Untyped n _ _) = n+name' = Untyped.name'  -- | Width of table width' :: Untyped -> Int-width'      (Untyped _ w _) = w---- | Column name strings in SQL-columnArray :: Untyped -> Array Int ColumnSQL-columnArray (Untyped _ _ c) = c+width' = Untyped.width'  -- | Column name strings in SQL columns' :: Untyped -> [ColumnSQL]-columns' =  elems . columnArray---- | Column name string in SQL specified by index-(!) :: Untyped-    -> Int       -- ^ Column index-    -> ColumnSQL -- ^ Column name String in SQL-t ! i = columnArray t Array.! i+columns' = Untyped.columns' +-- | Column name strings in SQL+(!) :: Untyped -> Int -> ColumnSQL+(!) = (Untyped.!)  -- | Phantom typed table type newtype Table r = Table Untyped@@ -78,7 +73,7 @@  -- | Column name string in SQL specified by index index :: Table r-      -> Int    -- ^ Column index+      -> Int       -- ^ Column index       -> ColumnSQL -- ^ Column name String in SQL index =  (!) . unType @@ -88,7 +83,7 @@  -- | Unsafely generate phantom typed table type. table :: String -> [String] -> Table r-table n f = Table $ Untyped n w fa  where+table n f = Table $ Untyped.Untyped n w fa  where   w  = length f   fa = listArray (0, w - 1) $ map columnSQL f 

@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Type--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2017 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -44,7 +44,9 @@  import Database.Record (PersistableWidth) +import Database.Relational.Query.Internal.Config (Config (chunksInsertSize), defaultConfig) import Database.Relational.Query.Internal.SQL (showStringSQL)+ import Database.Relational.Query.Monad.BaseType (Relation, sqlFromRelationWith) import Database.Relational.Query.Monad.Restrict (RestrictedStatement) import Database.Relational.Query.Monad.Assign (AssignStatement)@@ -54,7 +56,6 @@   (Restriction, restriction', UpdateTarget, updateTarget', liftTargetAllColumn', InsertTarget, insertTarget',    sqlWhereFromRestriction, sqlFromUpdateTarget, sqlFromInsertTarget) import Database.Relational.Query.Pi (Pi)-import Database.Relational.Query.Component (Config (chunksInsertSize), defaultConfig) import Database.Relational.Query.Table (Table, TableDerivable, derivedTable) import Database.Relational.Query.Projectable (PlaceHolders) import Database.Relational.Query.SQL

@@ -211,6 +211,55 @@ _p_j3s =  mapM_ print [show j3left, show j3right]  +-- Index of Nested Projections++nestedPiRec :: Relation () SetA+nestedPiRec = relation $ do+  ar <- query . relation $ do+    a <- query setA+    return $ value "Hello" >< a+  return $ ar ! snd'++nestedPiCol :: Relation () String+nestedPiCol = relation $ do+  ar <- query . relation $ do+    a <- query setA+    return $ a >< value "Hello"+  return $ ar ! snd'++nestedPi :: Relation () String+nestedPi = relation $ do+  ar <- query . relation $ do+    a <- query setA+    return $ (value "Hello" >< a) >< value "World"+  return $ ar ! snd'++nested :: [Test]+nested =+  [ eqProp "nested pi record" nestedPiRec+    "SELECT ALL T1.f1 AS f0, T1.f2 AS f1, T1.f3 AS f2 \+    \  FROM (SELECT ALL 'Hello' AS f0, \+    \                   T0.int_a0 AS f1, T0.str_a1 AS f2, T0.str_a2 AS f3 \+    \              FROM TEST.set_a T0) T1"++  , eqProp "nested pi column" nestedPiCol+    "SELECT ALL T1.f3 AS f0 \+    \      FROM (SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \                       'Hello' AS f3 \+    \                  FROM TEST.set_a T0) T1"++  , eqProp "nested pi both" nestedPi+    "SELECT ALL T1.f4 AS f0 \+    \      FROM (SELECT ALL 'Hello' AS f0, \+    \                       T0.int_a0 AS f1, T0.str_a1 AS f2, T0.str_a2 AS f3, \+    \                       'World' AS f4 \+    \                  FROM TEST.set_a T0) T1"+  ]++_p_nested :: IO ()+_p_nested =  mapM_ print [show nestedPiRec, show nestedPiCol, show nestedPi]++ -- Projection Operators  bin53 :: (Projection Flat Int32 -> Projection Flat Int32 -> Projection Flat r) -> Relation () r@@ -581,7 +630,7 @@  tests :: [Test] tests =-  concat [ tables, monadic, directJoins, join3s, bin, uni+  concat [ tables, monadic, directJoins, join3s, nested, bin, uni          , groups, orders, partitions, exps, effs, correlated]  main :: IO ()

@@ -129,6 +129,52 @@ _p_j3s :: IO () _p_j3s =  mapM_ print [show j3left, show j3right] +nestedPiRec :: Relation () SetA+nestedPiRec = relation $ proc () -> do+  ar <- (query . relation $ proc () -> do+            a <- query setA -< ()+            returnA -< value "Hello" >< a) -< ()+  returnA -< ar ! snd'++nestedPiCol :: Relation () String+nestedPiCol = relation $ proc () -> do+  ar <- (query . relation $ proc () -> do+            a <- query setA -< ()+            returnA -< a >< value "Hello") -< ()+  returnA -< ar ! snd'++nestedPi :: Relation () String+nestedPi = relation $ proc () -> do+  ar <- (query . relation $ proc () -> do+            a <- query setA -< ()+            returnA -< (value "Hello" >< a) >< value "World") -< ()+  returnA -< ar ! snd'++nested :: [Test]+nested =+  [ eqProp "nested pi record" nestedPiRec+    "SELECT ALL T1.f1 AS f0, T1.f2 AS f1, T1.f3 AS f2 \+    \  FROM (SELECT ALL 'Hello' AS f0, \+    \                   T0.int_a0 AS f1, T0.str_a1 AS f2, T0.str_a2 AS f3 \+    \              FROM TEST.set_a T0) T1"++  , eqProp "nested pi column" nestedPiCol+    "SELECT ALL T1.f3 AS f0 \+    \      FROM (SELECT ALL T0.int_a0 AS f0, T0.str_a1 AS f1, T0.str_a2 AS f2, \+    \                       'Hello' AS f3 \+    \                  FROM TEST.set_a T0) T1"++  , eqProp "nested pi both" nestedPi+    "SELECT ALL T1.f4 AS f0 \+    \      FROM (SELECT ALL 'Hello' AS f0, \+    \                       T0.int_a0 AS f1, T0.str_a1 AS f2, T0.str_a2 AS f3, \+    \                       'World' AS f4 \+    \                  FROM TEST.set_a T0) T1"+  ]++_p_nested :: IO ()+_p_nested =  mapM_ print [show nestedPiRec, show nestedPiCol, show nestedPi]+ justX :: Relation () (SetA, Maybe SetB) justX =  relation $ proc () -> do   a <- query setA -< ()@@ -357,7 +403,7 @@  tests :: [Test] tests =-  concat [ bin, tables, directJoins, join3s, maybes+  concat [ bin, tables, directJoins, join3s, nested, maybes          , groups, orders, partitions, exps, effs]  main :: IO ()