module Database.HaskellDB
( Rel, Attr, Expr, ExprAggr, Table, Query, OrderExpr
, HasField, Record, Select, ( # ), ( << ), (<<-), (!), (!.)
, restrict, table, project, unique
, union, intersect, divide, minus
, copy, copyAll, subQuery
, (.==.) , (.<>.), (.<.), (.<=.), (.>.), (.>=.)
, (.&&.) , (.||.)
, (.*.) , (./.), (.+.), (.-.), (.%.), (.++.)
, _not, like, _in, cat, _length
, isNull, notNull, fromNull, fromVal
, constant, constVal, constNull, constExpr
, param, namedParam, Args, func
, queryParams, Param, cast, coerce
, literal, toStr
, count, _sum, _max, _min, avg
, stddev, stddevP, variance, varianceP
, asc, desc, order
, top , _case , _default
, Database
, query, recCat
, insert, delete, update, insertQuery
, tables, describe, transaction
, showQuery, showQueryUnOpt, showSql, showSqlUnOpt
) where
import Database.HaskellDB.HDBRec
import Database.HaskellDB.PrimQuery (PrimQuery)
import Database.HaskellDB.Sql (SqlSelect(SqlSelect, SqlBin), SqlExpr(..), SqlName)
import qualified Database.HaskellDB.Sql as S (SqlSelect(..), Mark(..))
import Database.HaskellDB.Sql.Generate (sqlQuery)
import Database.HaskellDB.Sql.Default (defaultSqlGenerator)
import Database.HaskellDB.Sql.Print (ppSql)
import Database.HaskellDB.Optimize (optimize)
import Database.HaskellDB.Query
import Database.HaskellDB.Database
import Text.PrettyPrint.HughesPJ (Doc)
import Data.Foldable (foldr')
type Param = Either Int String
instance Show (Query (Rel r)) where
showsPrec _ query = shows (showSql query)
showQuery :: Query (Rel r) -> String
showQuery = show . optimize . runQuery
showQueryUnOpt :: Query (Rel r) -> String
showQueryUnOpt = show . runQuery
showSql :: Query (Rel r) -> String
showSql = show . ppSql . sqlQuery defaultSqlGenerator . optimize . runQuery
showSqlUnOpt :: Query (Rel r) -> String
showSqlUnOpt = show . ppSql . sqlQuery defaultSqlGenerator . runQuery
queryParams :: Query (Rel r) -> [Param]
queryParams q = snd . indexParams . selectParams . toSelect $ q
where
indexParams = foldr' renumber (1, [])
renumber (Just n) (idx, ps) = (idx, Right n : ps)
renumber Nothing (idx, ps) = (idx + 1, Left idx : ps)
toSelect = sqlQuery defaultSqlGenerator . optimize . runQuery
selectParams :: SqlSelect -> [Maybe SqlName]
selectParams select@(SqlSelect { S.attrs = a, S.tables = t, S.criteria = c, S.groupby = g, S.orderby = o})
= (attrParams a ++) . (tableParams t ++) . (criteriaParams c ++) .
(groupByParams g ++) . orderByParams $ o
where
attrParams = getParams (exprParams . snd)
tableParams = getParams (selectParams . snd)
criteriaParams = getParams exprParams
groupByParams Nothing = []
groupByParams (Just S.All) = []
groupByParams (Just (S.Columns cols)) = getParams (exprParams . snd) cols
orderByParams = getParams (exprParams . fst)
getParams :: (a -> [Maybe SqlName]) -> [a] -> [Maybe SqlName]
getParams f = concatMap f
exprParams :: SqlExpr -> [Maybe SqlName]
exprParams (ColumnSqlExpr _) = []
exprParams (ConstSqlExpr _) = []
exprParams (ParamSqlExpr p _) = [p]
exprParams (BinSqlExpr _ l r) = exprParams l ++ exprParams r
exprParams (PrefixSqlExpr _ e) = exprParams e
exprParams (PostfixSqlExpr _ e) = exprParams e
exprParams (FunSqlExpr _ es) = (concatMap exprParams es)
exprParams (AggrFunSqlExpr _ es) = (concatMap exprParams es)
exprParams (CaseSqlExpr es e) =
let caseExprs = concatMap (\(l, r) -> exprParams l ++ exprParams r) es
in caseExprs ++ exprParams e
exprParams (ListSqlExpr es) = concatMap exprParams es
exprParams (ExistsSqlExpr select) = selectParams select
exprParams PlaceHolderSqlExpr = []
exprParams (ParensSqlExpr e) = exprParams e
exprParams (CastSqlExpr _ e) = exprParams e
selectParams (SqlBin _ l r) = selectParams l ++ selectParams r
selectParams _ = []