packages feed

relational-query 0.7.0.1 → 0.7.0.2

raw patch · 19 files changed

+151/−95 lines, 19 files

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ <!-- -*- Markdown -*- --> +## 0.7.0.2++- Prepare to drop Expr type and deprecate around it.+- Fix boolean projection operator types.+ ## 0.7.0.1  - Update this changelog.
relational-query.cabal view
@@ -1,5 +1,5 @@ name:                relational-query-version:             0.7.0.1+version:             0.7.0.2 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can@@ -63,6 +63,7 @@   other-modules:                        Database.Relational.Query.Internal.SQL                        Database.Relational.Query.Internal.Product+                       Database.Relational.Query.Internal.Sub                        Database.Relational.Query.Monad.Trans.JoinState                        Database.Relational.Query.Monad.Trans.Qualify
src/Database/Relational/Query/Component.hs view
@@ -24,9 +24,6 @@          -- * Duplication attribute          showsDuplication, -         -- * Query restriction-         QueryRestriction, composeWhere, composeHaving,-          -- * Types for aggregation          AggregateColumnRef, @@ -53,10 +50,6 @@  import Data.Monoid (Monoid (..), (<>)) -import qualified Database.Relational.Query.Context as Context-import Database.Relational.Query.Expr (Expr, exprAnd)-import Database.Relational.Query.Expr.Unsafe (unsafeStringSql)- import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL) import Language.SQL.Keyword (Keyword(..), (|*|), (.=.)) @@ -122,24 +115,6 @@ showsDuplication =  dup  where   dup All      = ALL   dup Distinct = DISTINCT----- | Type for restriction of query.-type QueryRestriction c = [Expr c Bool]---- | Compose SQL String from 'QueryRestriction'.-composeRestrict :: Keyword -> QueryRestriction c -> StringSQL-composeRestrict k = d  where-  d    []    =  mempty-  d e@(_:_)  =  k <> unsafeStringSql (foldr1 exprAnd e)---- | Compose WHERE clause from 'QueryRestriction'.-composeWhere :: QueryRestriction Context.Flat -> StringSQL-composeWhere =  composeRestrict WHERE---- | Compose HAVING clause from 'QueryRestriction'.-composeHaving :: QueryRestriction Context.Aggregated -> StringSQL-composeHaving =  composeRestrict HAVING   -- | Type for group-by term
src/Database/Relational/Query/Effect.hs view
@@ -32,7 +32,8 @@ import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Pi (id') import Database.Relational.Query.Table (Table, TableDerivable, derivedTable)-import Database.Relational.Query.Component (Config, defaultConfig, composeWhere, composeSets)+import Database.Relational.Query.Component (Config, defaultConfig, composeSets)+import Database.Relational.Query.Sub (composeWhere) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Projectable
src/Database/Relational/Query/Expr.hs view
@@ -11,7 +11,7 @@ -- -- This module defines phantom typed SQL expression object. -- Contains normal interfaces.-module Database.Relational.Query.Expr (+module Database.Relational.Query.Expr {-# DEPRECATED "Drop in next version." #-} (   -- * Typed SQL Expression   Expr,
src/Database/Relational/Query/Expr/Unsafe.hs view
@@ -9,7 +9,7 @@ -- -- This module defines phantom typed SQL expression object. -- Contains internal structure and unsafe interfaces.-module Database.Relational.Query.Expr.Unsafe (+module Database.Relational.Query.Expr.Unsafe {-# DEPRECATED "Drop in next version." #-} (   -- * Typed SQL Expression   Expr(Expr), unsafeStringSql, showExpr   ) where
+ src/Database/Relational/Query/Internal/Sub.hs view
@@ -0,0 +1,85 @@+-- |+-- Module      : Database.Relational.Query.Internal.Sub+-- Copyright   : 2015 Kei Hibino+-- License     : BSD3+--+-- Maintainer  : ex8k.hibino@gmail.com+-- Stability   : experimental+-- Portability : unknown+--+-- This module defines sub-query structure used in query products.+module Database.Relational.Query.Internal.Sub+       ( SubQuery (..), UntypedProjection, ProjectionUnit (..)+       , JoinProduct, QueryProduct, QueryProductNode+       , SetOp (..), BinOp (..), Qualifier (..), Qualified (..)++       , Projection, untypeProjection, typedProjection++         -- * Query restriction+       , QueryRestriction+       )  where++import Data.Array (Array)++import qualified Database.Relational.Query.Context as Context+import Database.Relational.Query.Expr (Expr)+import Database.Relational.Query.Internal.Product+  (ProductTree, Node)+import Database.Relational.Query.Component+  (ColumnSQL, Config, Duplication (..),+   AggregateElem, OrderingTerms)+import qualified Database.Relational.Query.Table as Table+++data SetOp = Union | Except | Intersect  deriving Show++newtype BinOp = BinOp (SetOp, Duplication) deriving Show++-- | Sub-query type+data SubQuery = Table Table.Untyped+              | Flat Config+                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)+                OrderingTerms+              | Aggregated Config+                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)+                [AggregateElem] (QueryRestriction Context.Aggregated) OrderingTerms+              | Bin BinOp SubQuery SubQuery+              deriving Show++-- | Qualifier type.+newtype Qualifier = Qualifier Int  deriving Show++-- | Qualified query.+data Qualified a = Qualified a Qualifier  deriving Show++-- | 'Functor' instance of 'Qualified'+instance Functor Qualified where+  fmap f (Qualified a i) = Qualified (f a) i++-- | Projection structure unit+data ProjectionUnit = Columns (Array Int ColumnSQL)+                    | Normalized (Qualified Int)+                    | Scalar SubQuery+                    deriving Show++-- | Untyped projection. Forgot record type.+type UntypedProjection = [ProjectionUnit]++-- | Product tree specialized by 'SubQuery'.+type QueryProduct = ProductTree (Qualified SubQuery)+-- | Product node specialized by 'SubQuery'.+type QueryProductNode = Node (Qualified SubQuery)++-- | Type for join product of query.+type JoinProduct = Maybe QueryProduct+++-- | Phantom typed projection. Projected into Haskell record type 't'.+newtype Projection c t = Projection { untypeProjection :: UntypedProjection }  deriving Show++typedProjection :: UntypedProjection -> Projection c t+typedProjection =  Projection+++-- | Type for restriction of query.+type QueryRestriction c = [Expr c Bool]
src/Database/Relational/Query/Monad/Aggregate.hs view
@@ -33,7 +33,8 @@ import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Component-  (AggregateColumnRef, Duplication, QueryRestriction, OrderingTerms, AggregateElem, composeOver, showsColumnSQL)+  (AggregateColumnRef, Duplication, OrderingTerms, AggregateElem, composeOver, showsColumnSQL)+import Database.Relational.Query.Internal.Sub (QueryRestriction) import Database.Relational.Query.Sub (SubQuery, aggregatedSubQuery, JoinProduct) import qualified Database.Relational.Query.Sub as SubQuery import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable)
src/Database/Relational/Query/Monad/Assign.hs view
@@ -19,7 +19,8 @@   extract,   ) where -import Database.Relational.Query.Component (Config, QueryRestriction, Assignments)+import Database.Relational.Query.Internal.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)
src/Database/Relational/Query/Monad/Class.hs view
@@ -80,6 +80,7 @@ distinct :: MonadQuery m => m () distinct =  setDuplication Distinct +{-# DEPRECATED onE "Drop in the next version." #-} -- | Add restriction to last join. onE :: MonadQuery m => Expr Flat (Maybe Bool) -> m () onE =  restrictJoin . predicateProjectionFromExpr@@ -88,6 +89,7 @@ on :: MonadQuery m => Projection Flat (Maybe Bool) -> m () on =  restrictJoin +{-# DEPRECATED wheresE "Drop in the next version." #-} -- | Add restriction to this query. Expr type version. wheresE :: MonadRestrict Flat m => Expr Flat (Maybe Bool) -> m () wheresE =  restrict . predicateProjectionFromExpr@@ -96,6 +98,7 @@ wheres :: MonadRestrict Flat m => Projection Flat (Maybe Bool) -> m () wheres =  restrict +{-# DEPRECATED havingE "Drop in the next version." #-} -- | Add restriction to this aggregated query. Expr type version. havingE :: MonadRestrict Aggregated m => Expr Aggregated (Maybe Bool) -> m () havingE =  restrict . predicateProjectionFromExpr
src/Database/Relational/Query/Monad/Restrict.hs view
@@ -20,7 +20,8 @@   extract   ) where -import Database.Relational.Query.Component (Config, QueryRestriction)+import Database.Relational.Query.Internal.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
src/Database/Relational/Query/Monad/Simple.hs view
@@ -34,7 +34,8 @@ import Database.Relational.Query.Monad.Type (QueryCore, extractCore, OrderedQuery) import Database.Relational.Query.Projectable (PlaceHolders) -import Database.Relational.Query.Component (Duplication, QueryRestriction, OrderingTerms)+import Database.Relational.Query.Component (Duplication, OrderingTerms)+import Database.Relational.Query.Internal.Sub (QueryRestriction) import Database.Relational.Query.Sub (SubQuery, flatSubQuery, JoinProduct) import qualified Database.Relational.Query.Sub as SubQuery
src/Database/Relational/Query/Monad/Trans/Restricting.hs view
@@ -26,8 +26,8 @@ import Control.Arrow (second) import Data.DList (DList, toList) +import Database.Relational.Query.Internal.Sub (QueryRestriction) import Database.Relational.Query.Expr (Expr, fromJust)-import Database.Relational.Query.Component (QueryRestriction) import Database.Relational.Query.Projectable (expr)  import Database.Relational.Query.Monad.Class
src/Database/Relational/Query/Monad/Type.hs view
@@ -14,7 +14,8 @@          OrderedQuery,        ) where -import Database.Relational.Query.Component (Duplication, QueryRestriction)+import Database.Relational.Query.Component (Duplication)+import Database.Relational.Query.Internal.Sub (QueryRestriction) import Database.Relational.Query.Sub (JoinProduct) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection)
src/Database/Relational/Query/Monad/Unique.hs view
@@ -33,7 +33,8 @@ import Database.Relational.Query.Monad.Type (QueryCore, extractCore) import Database.Relational.Query.Projectable (PlaceHolders) -import Database.Relational.Query.Component (Duplication, QueryRestriction)+import Database.Relational.Query.Component (Duplication)+import Database.Relational.Query.Internal.Sub (QueryRestriction) import Database.Relational.Query.Sub (SubQuery, flatSubQuery, Qualified, JoinProduct)  -- | Unique query monad type.
src/Database/Relational/Query/Projectable.hs view
@@ -96,6 +96,7 @@ import qualified Database.Relational.Query.Projection as Projection  +{-# DEPRECATED expr "Drop in the next version." #-} -- | Project from Projection type into expression type. expr :: Projection p a -> Expr p a expr =  UnsafeExpr.Expr . Projection.unsafeStringSql@@ -211,7 +212,7 @@              -> p a -> p a -> p (Maybe Bool) compareBinOp =  unsafeBinOp --- | Unsafely make number projection binary operator from string binary operator.+-- | Unsafely make numrical projection binary operator from string binary operator. monoBinOp :: (SqlProjectable p, ProjectableShowSql p)          => SqlBinOp          -> p a -> p a -> p a@@ -250,13 +251,13 @@  -- | Logical operator corresponding SQL /AND/ . and' :: (OperatorProjectable p, ProjectableShowSql p)-     => p ft -> p ft -> p (Maybe Bool)-and' =  compareBinOp SQL.and+     => p (Maybe Bool) -> p (Maybe Bool) -> p (Maybe Bool)+and' = monoBinOp SQL.and  -- | Logical operator corresponding SQL /OR/ . or' :: (OperatorProjectable p, ProjectableShowSql p)-    => p ft -> p ft -> p (Maybe Bool)-or'  =  compareBinOp SQL.or+    => p (Maybe Bool) -> p (Maybe Bool) -> p (Maybe Bool)+or'  = monoBinOp SQL.or  -- | Logical operator corresponding SQL /NOT/ . not' :: (OperatorProjectable p, ProjectableShowSql p)
src/Database/Relational/Query/ProjectableExtended.hs view
@@ -170,6 +170,7 @@       -> p c (Maybe b)   -- ^ Narrower projected object. 'Maybe' phantom type result (?!?) =  projectPiMaybe' +{-# DEPRECATED (.!) "Drop in the next version." #-} -- | Get narrower projected expression along with projectino path --   and strip 'Maybe' phantom type off. (.!) :: Projection c (Maybe a) -- ^ Source projection type 'p'. 'Maybe' phantom type@@ -177,6 +178,7 @@      -> Expr c b    -- ^ Narrower projected expression. 'Maybe' phantom type is stripped off (.!) p = fromJust . projectPiMaybe p +{-# DEPRECATED (.?) "Drop in the next version." #-} -- | Get narrower projected expression along with projectino path --   and strip 'Maybe' phantom type off. --   Projection path leaf is 'Maybe' case.
src/Database/Relational/Query/Projection.hs view
@@ -49,6 +49,8 @@ import qualified Database.Record.KeyConstraint as KeyConstraint  import Database.Relational.Query.Internal.SQL (StringSQL, rowStringSQL, listStringSQL)+import Database.Relational.Query.Internal.Sub+  (SubQuery, UntypedProjection, Projection, untypeProjection, typedProjection, Qualified) import Database.Relational.Query.Context (Aggregated, Flat) import Database.Relational.Query.Component (ColumnSQL, showsColumnSQL, columnSQL') import Database.Relational.Query.Table (Table)@@ -59,18 +61,11 @@ import Database.Relational.Query.Pi (Pi) import qualified Database.Relational.Query.Pi.Unsafe as UnsafePi import Database.Relational.Query.Sub-  (SubQuery, Qualified,-   UntypedProjection, widthOfUntypedProjection, columnsOfUntypedProjection, untypedProjectionFromColumns,+  (widthOfUntypedProjection, columnsOfUntypedProjection, untypedProjectionFromColumns,    untypedProjectionFromColumns, untypedProjectionFromJoinedSubQuery, untypedProjectionFromScalarSubQuery) import qualified Database.Relational.Query.Sub as SubQuery  --- | Phantom typed projection. Projected into Haskell record type 't'.-newtype Projection c t = Projection { untypeProjection :: UntypedProjection }--typedProjection :: UntypedProjection -> Projection c t-typedProjection =  Projection- -- | Width of 'Projection'. width :: Projection c r -> Int width =  widthOfUntypedProjection . untypeProjection@@ -103,6 +98,7 @@                 -> Projection c r unsafeFromTable =  unsafeFromColumns . Table.columns +{-# DEPRECATED predicateProjectionFromExpr "Drop in the next version." #-} -- | Lift 'Expr' to 'Projection' to use as restrict predicate. predicateProjectionFromExpr :: Expr c (Maybe Bool) -> Projection c (Maybe Bool) predicateProjectionFromExpr =
src/Database/Relational/Query/Sub.hs view
@@ -33,24 +33,32 @@    -- * Product of sub-queries   QueryProduct, QueryProductNode, JoinProduct,++  -- * Query restriction+  composeWhere, composeHaving   ) where  import Data.Maybe (fromMaybe)-import Data.Array (Array, listArray)+import Data.Array (listArray) import qualified Data.Array as Array import Data.Monoid (mempty, (<>), mconcat)  import qualified Database.Relational.Query.Context as Context-import Database.Relational.Query.Expr (valueExpr)+import Database.Relational.Query.Expr (valueExpr, exprAnd) import Database.Relational.Query.Expr.Unsafe (unsafeStringSql) import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, showStringSQL) import Database.Relational.Query.Internal.Product   (NodeAttr(Just', Maybe), ProductTree (Leaf, Join),-   Node, nodeAttr, nodeTree)+   nodeAttr, nodeTree)+import Database.Relational.Query.Internal.Sub+  (SubQuery (..), UntypedProjection, ProjectionUnit (..),+   JoinProduct, QueryProduct, QueryProductNode,+   SetOp (..), BinOp (..), Qualifier (..), Qualified (..),+   QueryRestriction) import Database.Relational.Query.Component   (ColumnSQL, columnSQL', showsColumnSQL,    Config (productUnitSupport), ProductUnitSupport (PUSupported, PUNotSupported),-   Duplication (..), showsDuplication, QueryRestriction, composeWhere, composeHaving,+   Duplication (..), showsDuplication,    AggregateElem, composeGroupBy, OrderingTerms, composeOrderBy) import Database.Relational.Query.Table (Table, (!)) import qualified Database.Relational.Query.Table as Table@@ -59,10 +67,6 @@ import qualified Language.SQL.Keyword as SQL  -data SetOp = Union | Except | Intersect  deriving Show--newtype BinOp = BinOp (SetOp, Duplication) deriving Show- showsSetOp' :: SetOp -> StringSQL showsSetOp' =  d  where   d Union     = UNION@@ -74,17 +78,6 @@   mayDup dup@All  = showsDuplication dup   mayDup Distinct = mempty --- | Sub-query type-data SubQuery = Table Table.Untyped-              | Flat Config-                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)-                OrderingTerms-              | Aggregated Config-                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)-                [AggregateElem] (QueryRestriction Context.Aggregated) OrderingTerms-              | Bin BinOp SubQuery SubQuery-              deriving Show- -- | 'SubQuery' from 'Table'. fromTable :: Table r  -- ^ Typed 'Table' metadata           -> SubQuery -- ^ Result 'SubQuery'@@ -197,16 +190,6 @@ toSQL :: SubQuery -> String toSQL =  showStringSQL . showSQL --- | Qualifier type.-newtype Qualifier = Qualifier Int  deriving Show---- | Qualified query.-data Qualified a = Qualified a Qualifier  deriving Show---- | '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 _ i) = i@@ -259,21 +242,12 @@ qualifiedForm =  qualifiedSQLas . fmap showUnitSQL  --- | Projection structure unit-data ProjectionUnit = Columns (Array Int ColumnSQL)-                    | Normalized (Qualified Int)-                    | Scalar SubQuery-                    deriving Show- projectionUnitFromColumns :: [ColumnSQL] -> ProjectionUnit projectionUnitFromColumns cs = Columns $ listArray (0, length cs - 1) cs  projectionUnitFromScalarSubQuery :: SubQuery -> ProjectionUnit projectionUnitFromScalarSubQuery =  Scalar --- | Untyped projection. Forgot record type.-type UntypedProjection = [ProjectionUnit]- unitUntypedProjection :: ProjectionUnit -> UntypedProjection unitUntypedProjection =  (:[]) @@ -336,11 +310,6 @@   where w = widthOfUntypedProjection p  --- | Product tree specialized by 'SubQuery'.-type QueryProduct = ProductTree (Qualified SubQuery)--- | Product node specialized by 'SubQuery'.-type QueryProductNode = Node (Qualified SubQuery)- -- | Show product tree of query into SQL. StringSQL result. showsQueryProduct :: QueryProduct -> StringSQL showsQueryProduct =  rec  where@@ -360,12 +329,24 @@      ON,      unsafeStringSql . fromMaybe (valueExpr True) {- or error on compile -}  $ rs] --- | Type for join product of query.-type JoinProduct = Maybe QueryProduct- -- | Shows join product of query. showsJoinProduct :: ProductUnitSupport -> JoinProduct -> StringSQL showsJoinProduct ups =  maybe (up ups) from  where   from qp = FROM <> showsQueryProduct qp   up PUSupported    = mempty   up PUNotSupported = error "relation: Unit product support mode is disabled!"+++-- | Compose SQL String from 'QueryRestriction'.+composeRestrict :: Keyword -> QueryRestriction c -> StringSQL+composeRestrict k = d  where+  d    []    =  mempty+  d e@(_:_)  =  k <> unsafeStringSql (foldr1 exprAnd e)++-- | Compose WHERE clause from 'QueryRestriction'.+composeWhere :: QueryRestriction Context.Flat -> StringSQL+composeWhere =  composeRestrict WHERE++-- | Compose HAVING clause from 'QueryRestriction'.+composeHaving :: QueryRestriction Context.Aggregated -> StringSQL+composeHaving =  composeRestrict HAVING