Apply ColumnSQL wrap type.

This commit is contained in:
Kei Hibino 2013-08-27 18:42:22 +09:00
parent 164338b189
commit 0795ed428a
9 changed files with 42 additions and 37 deletions

View File

@ -25,6 +25,7 @@ import Control.Applicative (Applicative, (<$>))
import Control.Arrow (second, (>>>))
import Database.Relational.Query.Context (Flat, Aggregated)
import Database.Relational.Query.Sub (AggregateTerm)
import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
import Database.Relational.Query.Monad.Trans.AggregatingState
(AggregatingContext, primeAggregatingContext, addGroupBy, composeGroupBys)
@ -71,7 +72,7 @@ updateAggregatingContext :: Monad m => (AggregatingContext -> AggregatingContext
updateAggregatingContext = Aggregatings . modify
-- | Unsafely add not-typeful aggregating terms.
addGroupBys' :: Monad m => [String] -> Aggregatings m ()
addGroupBys' :: Monad m => [AggregateTerm] -> Aggregatings m ()
addGroupBys' gbs = updateAggregatingContext . foldr (>>>) id $ map addGroupBy gbs
-- | Add restrictions for aggregated query.

View File

@ -32,11 +32,11 @@ import Control.Applicative (pure)
import Database.Relational.Query.Context (Aggregated)
import Database.Relational.Query.Expr (Expr, fromJust, exprAnd)
import Database.Relational.Query.Expr.Unsafe (showExpr)
import Database.Relational.Query.Table (sqlWordFromColumn)
import Database.Relational.Query.Sub (AggregateTerm, AggregateTerms, AggregatedQueryRestriction)
import Language.SQL.Keyword (Keyword(..), unwordsSQL)
import qualified Language.SQL.Keyword as SQL
import qualified Language.SQL.Keyword.ConcatString as SQLs
-- | Context state of aggregated query.
@ -51,7 +51,7 @@ primeAggregatingContext :: AggregatingContext
primeAggregatingContext = AggregatingContext DList.empty Nothing
-- | Add group by term into 'AggregatingContext'.
addGroupBy :: String -> AggregatingContext -> AggregatingContext
addGroupBy :: AggregateTerm -> AggregatingContext -> AggregatingContext
addGroupBy t c = c { groupByTerms = groupByTerms c <> pure t }
-- | Add having restriction into 'AggregatingContext'.
@ -74,6 +74,6 @@ composeGroupBys :: AggregatingContext -> String
composeGroupBys ac = unwordsSQL $ groupBys ++ havings
where groupBys
| null gs = []
| otherwise = [GROUP, BY, SQL.word . concat $ gs `SQLs.sepBy` ", "]
gs = DList.toList (groupByTerms ac)
| otherwise = [GROUP, BY, gs `SQL.sepBy` ", "]
gs = map sqlWordFromColumn $ DList.toList (groupByTerms ac)
havings = maybe [] (\e -> [HAVING, SQL.word . showExpr $ e]) $ restriction ac

View File

@ -30,14 +30,16 @@ import qualified Data.DList as DList
import Data.Monoid ((<>))
import Control.Applicative (pure)
import Database.Relational.Query.Table (ColumnSQL, sqlWordFromColumn)
import Language.SQL.Keyword (Keyword(..), unwordsSQL)
import qualified Language.SQL.Keyword as SQL
-- | Column SQL String
type Column = String
type Column = ColumnSQL
-- | Value SQL String
type Term = String
type Term = ColumnSQL
-- | Assigning terms.
type Assignments = DList (Column, Term)
@ -57,5 +59,5 @@ updateAssignments col term ctx =
-- | Concatinate order-by terms into SQL string.
composeAssignments :: AssigningContext -> String
composeAssignments ac = unwordsSQL $ [SET, assignList `SQL.sepBy` ", "] where
assignList = DList.foldr (\ (col, term) r -> [SQL.word col, SQL.word term] `SQL.sepBy` " = " : r) []
assignList = DList.foldr (\ (col, term) r -> [sqlWordFromColumn col, sqlWordFromColumn term] `SQL.sepBy` " = " : r) []
$ assignments ac

View File

@ -29,7 +29,7 @@ import Control.Monad.Trans.State (StateT, runStateT, modify)
import Control.Applicative (Applicative, (<$>))
import Control.Arrow (second, (>>>))
import Database.Relational.Query.Sub (Order(Asc, Desc))
import Database.Relational.Query.Sub (Order(Asc, Desc), OrderColumn)
import Database.Relational.Query.Monad.Trans.StatePrepend (Prepend, prepend, liftToString)
import Database.Relational.Query.Monad.Trans.OrderingState
(OrderingContext, primeOrderingContext, updateOrderBy, composeOrderBys)
@ -81,7 +81,7 @@ type OrderedQuery p m r = Orderings p m (Projection p r)
-- | Ordering term projection type interface.
class OrderingTerms p where
orderTerms :: p t -> [String]
orderTerms :: p t -> [OrderColumn]
-- | 'Projection' is ordering term.
instance OrderingTerms (Projection c) where

View File

@ -30,7 +30,8 @@ import qualified Data.DList as DList
import Data.Monoid ((<>))
import Control.Applicative (pure)
import Database.Relational.Query.Sub (Order, order, OrderingTerm, OrderingTerms)
import Database.Relational.Query.Table (sqlWordFromColumn)
import Database.Relational.Query.Sub (Order, order, OrderColumn, OrderingTerm, OrderingTerms)
import Language.SQL.Keyword (Keyword(..), unwordsSQL)
import qualified Language.SQL.Keyword as SQL
@ -47,7 +48,7 @@ primeOrderingContext :: OrderingContext
primeOrderingContext = OrderingContext DList.empty
-- | Add order-by term.
updateOrderBy :: Order -> String -> OrderingContext -> OrderingContext
updateOrderBy :: Order -> OrderColumn -> OrderingContext -> OrderingContext
updateOrderBy order' term ctx =
ctx { orderBys = orderBys ctx <> pure (order', term) }
@ -66,7 +67,7 @@ orderingTerms = DList.toList . orderBys
-- | Concatinate order-by terms into SQL string.
composeOrderBys :: OrderingContext -> String
composeOrderBys oc = unwordsSQL orders where
orderList = DList.foldr (\ (o, e) r -> [SQL.word e, order o] `SQL.sepBy` " " : r) []
orderList = DList.foldr (\ (o, e) r -> [sqlWordFromColumn e, order o] `SQL.sepBy` " " : r) []
$ orderBys oc
orders | null orderList = []
| otherwise = [ORDER, BY, orderList `SQL.sepBy` ", "]

View File

@ -62,6 +62,7 @@ import qualified Language.SQL.Keyword.ConcatString as SQLs
import Database.Record (PersistableWidth, PersistableRecordWidth, derivedWidth)
import Database.Relational.Query.Table (columnSQL, stringFromColumnSQL)
import Database.Relational.Query.Expr (Expr, ShowConstantSQL (showConstantSQL))
import qualified Database.Relational.Query.Expr as Expr
import qualified Database.Relational.Query.Expr.Unsafe as UnsafeExpr
@ -85,7 +86,7 @@ sqlTermsString = d where
-- | SQL expression strings which represent projection.
sqlStringOfProjection :: Projection c r -> String
sqlStringOfProjection = sqlTermsString . columns
sqlStringOfProjection = sqlTermsString . map stringFromColumnSQL . columns
-- | 'Expr' from 'Projection'
exprOfProjection :: Projection c r -> Expr c r
@ -113,7 +114,7 @@ instance ProjectablePi (Projection c) where
-- | Unsafely generate 'Projection' from SQL expression strings.
unsafeSqlTermsProjection :: [String] -> Projection c t
unsafeSqlTermsProjection = unsafeFromColumns
unsafeSqlTermsProjection = unsafeFromColumns . map columnSQL
-- | Interface to project SQL terms unsafely.
class SqlProjectable p where

View File

@ -33,7 +33,7 @@ import qualified Language.SQL.Keyword as SQL
import Database.Record.ToSql (untypedUpdateValuesIndex)
import Database.Relational.Query.Pi.Unsafe (Pi, unsafeExpandIndexes)
import Database.Relational.Query.Sub (asColumnN)
import Database.Relational.Query.Table (Table, name, columns)
import Database.Relational.Query.Table (ColumnSQL, sqlWordFromColumn, Table, name, columns)
import Database.Relational.Query.Projection (Projection)
import qualified Database.Relational.Query.Projection as Projection
@ -43,7 +43,7 @@ selectSeedSQL :: Projection c r -> ShowS
selectSeedSQL pj =
(unwordsSQL [SELECT, columns' `SQL.sepBy` ", "] ++)
where columns' = zipWith
(\f n -> SQL.word f `asColumnN` n)
(\f n -> sqlWordFromColumn f `asColumnN` n)
(Projection.columns pj)
[(0 :: Int)..]
@ -54,24 +54,24 @@ updateSeedSQL table = (unwordsSQL [UPDATE, SQL.word $ name table] ++)
-- | Generate update SQL by specified key and table.
-- Columns name list of table are also required.
updateSQL' :: String -- ^ Table name
-> [String] -- ^ Column name list to update
-> [String] -- ^ Key column name list
-> [ColumnSQL] -- ^ Column name list to update
-> [ColumnSQL] -- ^ Key column name list
-> String -- ^ Result SQL
updateSQL' table cols key =
SQL.unwordsSQL
$ [UPDATE, SQL.word table, SET, updAssigns `SQL.sepBy` ", ",
WHERE, keyAssigns `SQL.sepBy` " AND " ]
where
assigns cs = [ SQL.word c .=. "?" | c <- cs ]
assigns cs = [ sqlWordFromColumn c .=. "?" | c <- cs ]
updAssigns = assigns cols
keyAssigns = assigns key
-- | Generate update SQL by specified key and table.
-- Columns name list of table are also required.
updateOtherThanKeySQL' :: String -- ^ Table name
-> [String] -- ^ Column name list
-> [Int] -- ^ Key column indexes
-> String -- ^ Result SQL
updateOtherThanKeySQL' :: String -- ^ Table name
-> [ColumnSQL] -- ^ Column name list
-> [Int] -- ^ Key column indexes
-> String -- ^ Result SQL
updateOtherThanKeySQL' table cols ixs =
updateSQL' table updColumns keyColumns
where
@ -90,15 +90,15 @@ updateOtherThanKeySQL tbl key =
updateOtherThanKeySQL' (name tbl) (columns tbl) (unsafeExpandIndexes key)
-- | Generate insert SQL.
insertSQL' :: String -- ^ Table name
-> [String] -- ^ Column name list
-> String -- ^ Result SQL
insertSQL' :: String -- ^ Table name
-> [ColumnSQL] -- ^ Column name list
-> String -- ^ Result SQL
insertSQL' table cols =
SQL.unwordsSQL
$ [INSERT, INTO, SQL.word table, cols' `SQL.parenSepBy` ", ",
VALUES, pfs `SQL.parenSepBy` ", "]
where cols' = map SQL.word cols
pfs = replicate (length cols) "?"
where cols' = map sqlWordFromColumn cols
pfs = replicate (length cols) "?"
-- | Generate insert SQL.
insertSQL :: Table r -- ^ Table metadata

View File

@ -43,7 +43,7 @@ module Database.Relational.Query.Sub (
AggregateTerm, AggregateTerms, AggregatedQueryRestriction,
-- * Types for ordering
Order (..), order, OrderingTerm, OrderingTerms
Order (..), order, OrderColumn, OrderingTerm, OrderingTerms
) where
import Data.Maybe (fromMaybe)
@ -314,8 +314,11 @@ order :: Order -> Keyword
order Asc = ASC
order Desc = DESC
-- | Type for order-by column
type OrderColumn = ColumnSQL
-- | Type for order-by term
type OrderingTerm = (Order, ColumnSQL)
type OrderingTerm = (Order, OrderColumn)
-- | Type for order-by terms
type OrderingTerms = [OrderingTerm]

View File

@ -26,18 +26,15 @@ import qualified Language.SQL.Keyword as SQL
-- | Column SQL string type
type ColumnSQL = String
-- newtype ColumnSQL = ColumnSQL String
newtype ColumnSQL = ColumnSQL String
-- | 'ColumnSQL' from string
columnSQL :: String -> ColumnSQL
columnSQL = id
-- columnSQL = ColumnSQL
columnSQL = ColumnSQL
-- | String from ColumnSQL
stringFromColumnSQL :: ColumnSQL -> String
stringFromColumnSQL = id
-- stringFromColumnSQL (ColumnSQL s) = s
stringFromColumnSQL (ColumnSQL s) = s
-- | SQL word from 'ColumnSQL'
sqlWordFromColumn :: ColumnSQL -> SQL.Keyword