module RESTng.Database.SQL.Print (ppSqlCommand) where

import Data.List(intersperse)
import Database.HDBC (SqlValue)

import RESTng.Database.SQL.Sql

ppSqlCommand :: SqlCommand -> (String, [SqlValue])

ppSqlCommand (SqlSelect cols ts crit grp ord lim off) = (strSql, values)
                            where
                                 strSql = "SELECT " ++ strCols cols ++ strFrom ++ strWhere ++ strGrp grp ++ strOrd ord ++ strLimit lim ++ strOffset off
                                 strCols [] = "*"
                                 strCols cls = concat $ intersperse ", " cls
                                 strFrom = " FROM " ++ (concat $ intersperse ", " ts)
                                 (strWhere, values) = ppCriteria crit
                                 strGrp [] = ""
                                 strGrp cls = " GROUP BY " ++ (concat $ intersperse ", " cls)
                                 strOrd [] = ""
                                 strOrd ord = " ORDER BY " ++ (concat . intersperse ", ") (map ppOrd ord)
                                 strLimit Nothing = ""
                                 strLimit (Just i) = " LIMIT " ++ show i
                                 strOffset Nothing = ""
                                 strOffset (Just i) = " OFFSET " ++ show i


ppSqlCommand (SqlInsertValues t colsAndExprs ret) = (strSql, values)
                            where
                                 strSql = "INSERT INTO " ++ t ++ " (" ++ strCols ++ ")" ++
                                          " VALUES (" ++ strExprs ++ ")" ++ strRet ret
                                 (cols,exprs) = unzip colsAndExprs
                                 strCols = concat $ intersperse ", " $ cols
                                 (strExprs', values) = ppExprs exprs
                                 strExprs = concat $ intersperse ", " $ strExprs'
                                 strRet Nothing = ""
                                 strRet (Just s) = " RETURNING " ++ s


ppSqlCommand (SqlUpdateValues t colsAndExprs crit) = (strSql, values1 ++ values2)
                            where
                                 strSql = "UPDATE " ++ t ++ " SET " ++ strAsignments ++ strWhere
                                 strAsignments = concat $ intersperse ", " $ (zipWith (\s1 s2 -> s1 ++ "=" ++ s2) cols strExprs)
                                 (cols,exprs) = unzip colsAndExprs
                                 (strExprs, values1) = ppExprs exprs
                                 (strWhere, values2) = ppCriteria crit

ppSqlCommand (SqlDelete t crit) = (strSql, values)
                            where
                                 strSql = "DELETE FROM " ++ t ++ strWhere
                                 (strWhere, values) = ppCriteria crit

ppCriteria :: SqlExp -> (String, [SqlValue])
ppCriteria True_ = ("",[])
ppCriteria crit = (" WHERE " ++ str, vals)
                  where
                       (str,vals) = ppExpr crit


ppExprs :: [SqlExp] -> ([String], [SqlValue]) --values list for each expression have been concatenated
ppExprs exprs = (strs, concat valss)
                where
                     (strs,valss) = unzip $ map ppExpr exprs


ppExpr :: SqlExp -> (String, [SqlValue])

ppExpr (False_) = ("FALSE", [])
ppExpr (True_) = ("TRUE", [])
ppExpr (Lower_ e) = let (s,vs) = ppExpr e in ("LOWER (" ++ s ++ ") ", vs)

ppExpr (AppBinOp And_ True_ e2) = ppExpr e2
ppExpr (AppBinOp And_ e1 e2)
                        = let (s1,vs1) = ppExpr e1
                              (s2,vs2) = ppExpr e2
                          in
                              (s1 ++ " AND " ++ s2, vs1 ++ vs2)

ppExpr (AppBinOp Or_ e1 e2)
                        = let (s1,vs1) = ppExpr e1
                              (s2,vs2) = ppExpr e2
                          in
                              ("(" ++ s1 ++ " OR " ++ s2 ++ ")", vs1 ++ vs2)


ppExpr (AppBinOp IsEqualTo e1 e2)
                        = let (s1,vs1) = ppExpr e1
                              (s2,vs2) = ppExpr e2
                          in
                              (s1 ++ "=" ++ s2, vs1 ++ vs2)

ppExpr (AppBinOp In_ e1 e2)
                        = let (s1,vs1) = ppExpr e1
                              (s2,vs2) = ppExpr e2
                          in
                              (s1 ++ " IN (" ++ s2 ++ ")", vs1 ++ vs2)

ppExpr (AppBinOp Like_ e1 e2)
                        = let (s1,vs1) = ppExpr e1
                              (s2,vs2) = ppExpr e2
                          in
                              (s1 ++ " LIKE " ++ s2, vs1 ++ vs2)


ppExpr (AnyCondition []) = (" FALSE ", [])
ppExpr (AnyCondition exprs) = (" (" ++ concat (intersperse " OR " strs) ++ ") ", concat vss)
                              where
                                (strs,vss) = unzip $ map ppExpr exprs



ppExpr (Const s) = (s,[])
ppExpr (Value val) = ("?",[val])
ppExpr (Query cmd) = ppSqlCommand cmd

ppOrd :: (String,OrderDirection) -> String
ppOrd (col, OrderAsc) = col
ppOrd (col, OrderDesc) = col ++ " DESC"