module Database.HaskellDB.Sql (
SqlTable,
SqlColumn,
SqlName,
SqlOrder(..),
SqlType(..),
SqlSelect(..),
SqlUpdate(..),
SqlDelete(..),
SqlInsert(..),
SqlCreate(..),
SqlDrop(..),
SqlExpr(..),
Mark(..),
newSelect, foldSqlExpr, foldSqlSelect
) where
type SqlTable = String
type SqlColumn = String
type SqlName = String
data SqlOrder = SqlAsc | SqlDesc
deriving Show
data SqlType = SqlType String
| SqlType1 String Int
| SqlType2 String Int Int
deriving Show
data Mark = All | Columns [(SqlColumn, SqlExpr)]
deriving Show
data SqlSelect = SqlSelect {
options :: [String],
attrs :: [(SqlColumn,SqlExpr)],
tables :: [(SqlTable,SqlSelect)],
criteria :: [SqlExpr],
groupby :: Maybe Mark,
orderby :: [(SqlExpr,SqlOrder)],
extra :: [String]
}
| SqlBin String SqlSelect SqlSelect
| SqlTable SqlTable
| SqlEmpty
deriving Show
foldSqlSelect :: ([String] -> [(SqlColumn,SqlExpr)]
-> [(SqlTable, t)]
-> [SqlExpr] -> Maybe Mark
-> [(SqlExpr,SqlOrder)]
-> [String] -> t
, String -> t -> t -> t
, SqlTable -> t, t)
-> SqlSelect
-> t
foldSqlSelect (select, bin, table, empty) = fold
where
fold (SqlSelect opt attr tab crit grou ord ext) = select opt attr (map (\(t, s) -> (t, fold s)) tab) crit grou ord ext
fold (SqlBin op left right) = bin op (fold left) (fold right)
fold (SqlTable tab) = table tab
fold SqlEmpty = empty
data SqlExpr = ColumnSqlExpr SqlColumn
| BinSqlExpr String SqlExpr SqlExpr
| PrefixSqlExpr String SqlExpr
| PostfixSqlExpr String SqlExpr
| FunSqlExpr String [SqlExpr]
| AggrFunSqlExpr String [SqlExpr]
| ConstSqlExpr String
| CaseSqlExpr [(SqlExpr,SqlExpr)] SqlExpr
| ListSqlExpr [SqlExpr]
| ExistsSqlExpr SqlSelect
| ParamSqlExpr (Maybe SqlName) SqlExpr
| PlaceHolderSqlExpr
| ParensSqlExpr SqlExpr
| CastSqlExpr String SqlExpr
deriving Show
foldSqlExpr :: (SqlColumn -> t
, String -> t -> t -> t
, String -> t -> t
, String -> t -> t
, String -> [t] -> t
, String -> [t] -> t
, String -> t
, [(t,t)] -> t -> t
, [t] -> t
, SqlSelect -> t
, (Maybe SqlName) -> t -> t
, t
, t -> t
, String -> t -> t )
-> SqlExpr
-> t
foldSqlExpr (column, bin, prefix, postfix, fun, aggr, constant, _case, list, exists,
param, placeHolder, parens, casts) = fold
where
fold (ColumnSqlExpr col) = column col
fold (BinSqlExpr op left right) = bin op (fold left) (fold right)
fold (PrefixSqlExpr op exp) = prefix op (fold exp)
fold (PostfixSqlExpr op exp) = postfix op (fold exp)
fold (FunSqlExpr name exprs) = fun name (map fold exprs)
fold (AggrFunSqlExpr name exprs) = aggr name (map fold exprs)
fold (ConstSqlExpr c) = constant c
fold (CaseSqlExpr cases def) = _case (map (\(e1, e2) -> (fold e1, fold e2)) cases) (fold def)
fold (ListSqlExpr exprs) = list (map fold exprs)
fold (ExistsSqlExpr select) = exists select
fold (ParamSqlExpr name exp) = param name (fold exp)
fold PlaceHolderSqlExpr = placeHolder
fold (ParensSqlExpr exp) = parens (fold exp)
fold (CastSqlExpr typ exp ) = casts typ (fold exp)
data SqlUpdate = SqlUpdate SqlTable [(SqlColumn,SqlExpr)] [SqlExpr]
data SqlDelete = SqlDelete SqlTable [SqlExpr]
data SqlInsert = SqlInsert SqlTable [SqlColumn] [SqlExpr]
| SqlInsertQuery SqlTable [SqlColumn] SqlSelect
data SqlCreate = SqlCreateDB String
| SqlCreateTable SqlTable [(SqlColumn,(SqlType,Bool))]
data SqlDrop = SqlDropDB String
| SqlDropTable SqlTable
newSelect :: SqlSelect
newSelect = SqlSelect {
options = [],
attrs = [],
tables = [],
criteria = [],
groupby = Nothing,
orderby = [],
extra = []
}