khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-12-15 06:43:04 +03:00
Code Issues Projects Releases Wiki Activity

Prepare to move SQL compose implementations into SubQuery.

Browse Source
This commit is contained in:
Kei Hibino 2013-09-07 15:03:43 +09:00
parent 08d0d60ea7
commit 0b9e03939b
2 changed files with 24 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
relational-join/src/Database/Relational/Query/Internal/String.hs
View File

@ -10,7 +10,8 @@
-- This module provides SQL string concatination functions
-- which result is ShowS differential lists.
module Database.Relational.Query.Internal.String (
showUnwordsSQL, showWordSQL, showWordSQL', showUnwords,
showUnwordsSQL, showWordSQL, showWordSQL',
showUnwords, showSpace,
paren, sqlRowString, sqlRowListString
) where
@ -27,6 +28,7 @@ showUnwordsSQL = showUnwords . map showWordSQL
showWordSQL :: SQL.Keyword -> ShowS
showWordSQL = showString . SQL.wordShow
-- | 'ShowS' of whitespace.
showSpace :: ShowS
showSpace = showChar ' '

25
relational-join/src/Database/Relational/Query/Sub.hs
View File

@ -69,7 +69,7 @@ import Database.Relational.Query.Table
import qualified Database.Relational.Query.Table as Table
import Database.Relational.Query.Internal.String
(showUnwordsSQL, showWordSQL, showWordSQL', showUnwords, paren)
(showUnwordsSQL, showWordSQL, showWordSQL', showUnwords, showSpace, paren)
import Language.SQL.Keyword (Keyword(..), unwordsSQL)
import qualified Language.SQL.Keyword as SQL
import qualified Language.SQL.Keyword.ConcatString as SQLs
@ -321,15 +321,19 @@ queryProductSQL = ($ "") . showsQueryProduct
type JoinProduct = Maybe QueryProduct
-- | Shows join product of query.
_showsJoinProduct :: UnitProductSupport -> Maybe QueryProduct -> ShowS
_showsJoinProduct :: UnitProductSupport -> JoinProduct -> ShowS
_showsJoinProduct ups = maybe (up ups) from where
from qp = showWordSQL' FROM . showsQueryProduct qp
up UPSupported = showString ""
from qp = showSpace . showWordSQL' FROM . showsQueryProduct qp
up UPSupported = id
up UPNotSupported = error "relation: Unit product support mode is disabled!"
-- | Type for restriction of query.
type QueryRestriction c = Maybe (Expr c Bool)
-- | Compose SQL String from 'Expr' object.
_composeRestrict :: Keyword -> QueryRestriction c -> ShowS
_composeRestrict k = maybe id (\e -> showSpace . showUnwordsSQL [k, SQL.word . showExpr $ e])
-- | Type for group-by term
type AggregateTerm = ColumnSQL
@ -340,6 +344,13 @@ type AggregateTerms = [AggregateTerm]
-- | Type for restriction of aggregated query.
type AggregatedQueryRestriction = Maybe (Expr Context.Aggregated Bool)
_composeGroupBys :: AggregateTerms -> ShowS
_composeGroupBys as = groupBys where
groupBys
| null gs = id
| otherwise = showSpace . showUnwordsSQL [GROUP, BY, gs `SQL.sepBy` ", "]
gs = map sqlWordFromColumn as
-- | Order direction. Ascendant or Descendant.
data Order = Asc | Desc
@ -357,3 +368,9 @@ type OrderingTerm = (Order, OrderColumn)
-- | Type for order-by terms
type OrderingTerms = [OrderingTerm]
_composeOrderByes :: OrderingTerms -> ShowS
_composeOrderByes ots = orders where
orderList = foldr (\ (o, e) r -> [sqlWordFromColumn e, order o] `SQL.sepBy` " " : r) [] ots
orders | null orderList = id
| otherwise = showSpace . showUnwordsSQL [ORDER, BY, orderList `SQL.sepBy` ", "]