packages feed

relational-query 0.8.3.0 → 0.8.3.1

raw patch · 14 files changed

+97/−91 lines, 14 files

Files

ChangeLog.md view
@@ -1,5 +1,10 @@ <!-- -*- Markdown -*- --> +## 0.8.3.1++- Refactor around sub-query and its builder.+- Compatibility with dlist-0.5.+ ## 0.8.3.0  - Add configuration to quote SQL string of table names.
relational-query.cabal view
@@ -1,5 +1,5 @@ name:                relational-query-version:             0.8.3.0+version:             0.8.3.1 synopsis:            Typeful, Modular, Relational, algebraic query engine description:         This package contiains typeful relation structure and                      relational-algebraic query building DSL which can
src/Database/Relational/Query/Internal/Product.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Internal.Product--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -9,58 +9,45 @@ -- -- This module defines product structure to compose SQL join. module Database.Relational.Query.Internal.Product (-  -- * Product tree type-  node, nodeAttr, nodeTree,+  -- * Interfaces to manipulate ProductTree type   growProduct, restrictProduct,   ) where  import Prelude hiding (and, product)-import Control.Applicative (pure, empty)-import Data.Monoid ((<>))+import Control.Applicative (pure)+import Data.Monoid ((<>), mempty)  import Database.Relational.Query.Context (Flat)-import Database.Relational.Query.Internal.Sub (NodeAttr (..), ProductTree (..), Node (..), Projection)+import Database.Relational.Query.Internal.Sub+  (NodeAttr (..), ProductTree (..), Node (..), Projection, Qualified, SubQuery,+   ProductTreeBuilder, ProductBuilder)  --- | Get node attribute.-nodeAttr :: Node q -> NodeAttr-nodeAttr (Node a _) = a  where---- | Get tree from node.-nodeTree :: Node q -> ProductTree q-nodeTree (Node _ t) = t---- | Make product node from node attribute and product tree.-node :: NodeAttr      -- ^ Node attribute-     -> ProductTree q -- ^ Product tree-     -> Node q        -- ^ Result node-node =  Node- -- | Push new tree into product right term.-growRight :: Maybe (Node q)            -- ^ Current tree-          -> (NodeAttr, ProductTree q) -- ^ New tree to push into right-          -> Node q                    -- ^ Result node+growRight :: Maybe ProductBuilder           -- ^ Current tree+          -> (NodeAttr, ProductTreeBuilder) -- ^ New tree to push into right+          -> ProductBuilder                 -- ^ Result node growRight = d  where-  d Nothing  (naR, q) = node naR q-  d (Just l) (naR, q) = node Just' $ Join l (node naR q) empty+  d Nothing  (naR, q) = Node naR q+  d (Just l) (naR, q) = Node Just' $ Join l (Node naR q) mempty  -- | Push new leaf node into product right term.-growProduct :: Maybe (Node q) -- ^ Current tree-            -> (NodeAttr, q)  -- ^ New leaf to push into right-            -> Node q         -- ^ Result node+growProduct :: Maybe ProductBuilder           -- ^ Current tree+            -> (NodeAttr, Qualified SubQuery) -- ^ New leaf to push into right+            -> ProductBuilder                 -- ^ Result node growProduct =  match  where   match t (na, q) =  growRight t (na, Leaf q)  -- | Add restriction into top product of product tree.-restrictProduct' :: ProductTree q                -- ^ Product to restrict+restrictProduct' :: ProductTreeBuilder           -- ^ Product to restrict                  -> Projection Flat (Maybe Bool) -- ^ Restriction to add-                 -> ProductTree q                -- ^ Result product+                 -> ProductTreeBuilder           -- ^ Result product restrictProduct' =  d  where   d (Join lp rp rs) rs' = Join lp rp (rs <> pure rs')   d leaf'@(Leaf _)         _   = leaf' -- or error on compile  -- | Add restriction into top product of product tree node.-restrictProduct :: Node q                       -- ^ Target node which has product to restrict+restrictProduct :: ProductBuilder               -- ^ Target node which has product to restrict                 -> Projection Flat (Maybe Bool) -- ^ Restriction to add-                -> Node q                       -- ^ Result node-restrictProduct (Node a t) e = node a (restrictProduct' t e)+                -> ProductBuilder               -- ^ Result node+restrictProduct (Node a t) e = Node a (restrictProduct' t e)
src/Database/Relational/Query/Internal/Sub.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE DeriveFunctor #-}+ -- | -- Module      : Database.Relational.Query.Internal.Sub--- Copyright   : 2015 Kei Hibino+-- Copyright   : 2015-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -14,7 +16,8 @@           -- * Product tree type        , NodeAttr (..), ProductTree (..), Node (..)-       , JoinProduct, QueryProduct, QueryProductNode+       , JoinProduct, QueryProductTree+       , ProductTreeBuilder, ProductBuilder         , Projection, untypeProjection, typedProjection @@ -26,7 +29,7 @@ import Data.Array (Array) import Data.DList (DList) -import qualified Database.Relational.Query.Context as Context+import Database.Relational.Query.Context (Flat, Aggregated) import Database.Relational.Query.Component   (ColumnSQL, Config, Duplication (..),    AggregateElem, OrderingTerms)@@ -42,11 +45,11 @@ -- | Sub-query type data SubQuery = Table Table.Untyped               | Flat Config-                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)+                UntypedProjection Duplication JoinProduct (QueryRestriction Flat)                 OrderingTerms               | Aggregated Config-                UntypedProjection Duplication JoinProduct (QueryRestriction Context.Flat)-                [AggregateElem] (QueryRestriction Context.Aggregated) OrderingTerms+                UntypedProjection Duplication JoinProduct (QueryRestriction Flat)+                [AggregateElem] (QueryRestriction Aggregated) OrderingTerms               | Bin BinOp SubQuery SubQuery               deriving Show @@ -73,21 +76,30 @@ -- | node attribute for product. data NodeAttr = Just' | Maybe deriving Show +type QS = Qualified SubQuery++type QueryRestrictionBuilder = DList (Projection Flat (Maybe Bool))+ -- | Product tree type. Product tree is constructed by left node and right node.-data ProductTree q = Leaf q-                   | Join !(Node q) !(Node q) !(DList (Projection Context.Flat (Maybe Bool)))-                   deriving Show+data ProductTree rs+  = Leaf QS+  | Join !(Node rs) !(Node rs) !rs+  deriving (Show, Functor)  -- | Product node. node attribute and product tree.-data Node q = Node !NodeAttr !(ProductTree q)  deriving Show+data Node rs = Node !NodeAttr !(ProductTree rs)  deriving (Show, Functor) --- | Product tree specialized by 'SubQuery'.-type QueryProduct = ProductTree (Qualified SubQuery)--- | Product node specialized by 'SubQuery'.-type QueryProductNode = Node (Qualified SubQuery)+-- | Product tree with join restriction.+type QueryProductTree = ProductTree (QueryRestriction Flat) +-- | Product tree with join restriction builder.+type ProductTreeBuilder = ProductTree QueryRestrictionBuilder++-- | Product noe with join restriction builder.+type ProductBuilder = Node QueryRestrictionBuilder+ -- | Type for join product of query.-type JoinProduct = Maybe QueryProduct+type JoinProduct = Maybe QueryProductTree   -- | Phantom typed projection. Projected into Haskell record type 't'.
src/Database/Relational/Query/Monad/Aggregate.hs view
@@ -6,7 +6,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Aggregate--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -34,8 +34,7 @@ import qualified Database.Relational.Query.Projection as Projection import Database.Relational.Query.Component   (AggregateColumnRef, Duplication, OrderingTerms, AggregateElem, composeOver, showsColumnSQL)-import Database.Relational.Query.Internal.Sub (SubQuery, QueryRestriction, JoinProduct)-import Database.Relational.Query.Sub (aggregatedSubQuery)+import Database.Relational.Query.Sub (SubQuery, QueryRestriction, JoinProduct, aggregatedSubQuery) import qualified Database.Relational.Query.Sub as SubQuery import Database.Relational.Query.Projectable (PlaceHolders, SqlProjectable)
src/Database/Relational/Query/Monad/Assign.hs view
@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Assign--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -19,7 +19,7 @@   extract,   ) where -import Database.Relational.Query.Internal.Sub (QueryRestriction)+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)
src/Database/Relational/Query/Monad/Restrict.hs view
@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Restrict--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -20,7 +20,7 @@   extract   ) where -import Database.Relational.Query.Internal.Sub (QueryRestriction)+import Database.Relational.Query.Sub (QueryRestriction) import Database.Relational.Query.Component (Config) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection)
src/Database/Relational/Query/Monad/Simple.hs view
@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Simple--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -35,8 +35,7 @@ import Database.Relational.Query.Projectable (PlaceHolders)  import Database.Relational.Query.Component (Duplication, OrderingTerms)-import Database.Relational.Query.Internal.Sub (SubQuery, QueryRestriction, JoinProduct)-import Database.Relational.Query.Sub (flatSubQuery)+import Database.Relational.Query.Sub (SubQuery, QueryRestriction, JoinProduct, flatSubQuery) import qualified Database.Relational.Query.Sub as SubQuery
src/Database/Relational/Query/Monad/Trans/Join.hs view
@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Join--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -36,11 +36,10 @@ 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), Projection)+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.Internal.Sub (SubQuery, Qualified, JoinProduct) import Database.Relational.Query.Projectable (PlaceHolders, unsafeAddPlaceHolders)  import Database.Relational.Query.Monad.BaseType (ConfigureQuery, qualifyQuery, Relation, untypeRelation)
src/Database/Relational/Query/Monad/Trans/JoinState.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.Trans.JoinState--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,15 +15,16 @@   ) where  import Prelude hiding (product)+import Data.DList (toList) -import qualified Database.Relational.Query.Internal.Product as Product-import Database.Relational.Query.Internal.Sub (QueryProductNode, JoinProduct)+import qualified Database.Relational.Query.Sub as Product+import Database.Relational.Query.Sub (ProductBuilder, JoinProduct)   -- | JoinContext type for QueryJoin. newtype JoinContext =   JoinContext-  { product  :: Maybe QueryProductNode+  { product  :: Maybe ProductBuilder   }  -- | Initial 'JoinContext'.@@ -31,13 +32,9 @@ primeJoinContext =  JoinContext Nothing  -- | Update product of 'JoinContext'.-updateProduct' :: (Maybe QueryProductNode -> Maybe QueryProductNode) -> JoinContext -> JoinContext-updateProduct' uf ctx = ctx { product = uf . product $ ctx }---- | Update product of 'JoinContext'.-updateProduct :: (Maybe QueryProductNode -> QueryProductNode) -> JoinContext -> JoinContext-updateProduct uf = updateProduct' (Just . uf)+updateProduct :: (Maybe ProductBuilder -> ProductBuilder) -> JoinContext -> JoinContext+updateProduct uf ctx = ctx { product = Just . uf . product $ ctx }  -- |  Finalize context to extract accumulated query product. joinProduct :: JoinContext -> JoinProduct-joinProduct =  fmap Product.nodeTree . product+joinProduct =  fmap (fmap toList . Product.nodeTree) . product
src/Database/Relational/Query/Monad/Trans/Restricting.hs view
@@ -4,7 +4,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Trans.Restricting--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2014-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -26,7 +26,7 @@ import Control.Arrow (second) import Data.DList (DList, toList) -import Database.Relational.Query.Internal.Sub (QueryRestriction, Projection)+import Database.Relational.Query.Sub (QueryRestriction, Projection)  import Database.Relational.Query.Monad.Class   (MonadQualify (..), MonadRestrict(..), MonadQuery (..), MonadAggregate(..))
src/Database/Relational/Query/Monad/Type.hs view
@@ -1,6 +1,6 @@ -- | -- Module      : Database.Relational.Query.Monad.Type--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -15,7 +15,7 @@        ) where  import Database.Relational.Query.Component (Duplication)-import Database.Relational.Query.Internal.Sub (JoinProduct, QueryRestriction)+import Database.Relational.Query.Sub (JoinProduct, QueryRestriction) import Database.Relational.Query.Context (Flat) import Database.Relational.Query.Projection (Projection) import Database.Relational.Query.Projectable (PlaceHolders)
src/Database/Relational/Query/Monad/Unique.hs view
@@ -5,7 +5,7 @@  -- | -- Module      : Database.Relational.Query.Monad.Unique--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2014-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -22,7 +22,6 @@ import Control.Applicative (Applicative)  import Database.Relational.Query.Context (Flat)-import Database.Relational.Query.Internal.Sub (NodeAttr) import Database.Relational.Query.Projection (Projection) import qualified Database.Relational.Query.Projection as Projection @@ -34,8 +33,9 @@ import Database.Relational.Query.Projectable (PlaceHolders)  import Database.Relational.Query.Component (Duplication)-import Database.Relational.Query.Internal.Sub (SubQuery, QueryRestriction, Qualified, JoinProduct)-import Database.Relational.Query.Sub (flatSubQuery)+import Database.Relational.Query.Sub+  (SubQuery, QueryRestriction, Qualified, JoinProduct, NodeAttr, flatSubQuery)+  -- | Unique query monad type. newtype QueryUnique a = QueryUnique (QueryCore a)
src/Database/Relational/Query/Sub.hs view
@@ -2,7 +2,7 @@  -- | -- Module      : Database.Relational.Query.Sub--- Copyright   : 2013 Kei Hibino+-- Copyright   : 2013-2016 Kei Hibino -- License     : BSD3 -- -- Maintainer  : ex8k.hibino@gmail.com@@ -25,7 +25,7 @@   column,    -- * Projection-  ProjectionUnit, UntypedProjection,+  Projection, ProjectionUnit, UntypedProjection,    untypedProjectionFromColumns, untypedProjectionFromJoinedSubQuery, untypedProjectionFromScalarSubQuery,   widthOfUntypedProjection, columnsOfUntypedProjection,@@ -33,26 +33,26 @@   projectionColumns, unsafeProjectionStringSql, unsafeProjectFromColumns,    -- * Product of sub-queries-  QueryProduct, QueryProductNode, JoinProduct,+  JoinProduct, NodeAttr,+  nodeTree,+  ProductBuilder,    -- * Query restriction+  QueryRestriction,   composeWhere, composeHaving   ) where  import Data.Array (listArray) import qualified Data.Array as Array import Data.Monoid (mempty, (<>), mconcat)-import Data.DList (toList)  import qualified Database.Relational.Query.Context as Context import Database.Relational.Query.Internal.SQL (StringSQL, stringSQL, rowStringSQL, showStringSQL)-import Database.Relational.Query.Internal.Product-  (nodeAttr, nodeTree) import Database.Relational.Query.Internal.Sub   (SubQuery (..), Projection, untypeProjection, typedProjection,    UntypedProjection, ProjectionUnit (..),-   JoinProduct, QueryProduct, QueryProductNode,-   NodeAttr (Just', Maybe), ProductTree (Leaf, Join),+   JoinProduct, QueryProductTree, ProductBuilder,+   NodeAttr (Just', Maybe), ProductTree (Leaf, Join), Node (Node),    SetOp (..), BinOp (..), Qualifier (..), Qualified (..),    QueryRestriction) import Database.Relational.Query.Component@@ -325,8 +325,16 @@ unsafeProjectFromColumns =  typedProjection . untypedProjectionFromColumns  +-- | 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+ -- | Show product tree of query into SQL. StringSQL result.-showsQueryProduct :: QueryProduct -> StringSQL+showsQueryProduct :: QueryProductTree -> StringSQL showsQueryProduct =  rec  where   joinType Just' Just' = INNER   joinType Just' Maybe = LEFT@@ -342,7 +350,7 @@      joinType (nodeAttr left') (nodeAttr right'), JOIN,      urec right',      ON, foldr1 SQL.and $ ps ++ concat [ showConstantTermsSQL' True | null ps ] ]-    where ps = [ unsafeProjectionStringSql p | p <- toList rs ]+    where ps = [ unsafeProjectionStringSql p | p <- rs ]  -- | Shows join product of query. showsJoinProduct :: ProductUnitSupport -> JoinProduct -> StringSQL