module RESTng.Database.SQL.Sql where

import RESTng.Utils (low)
import Database.HDBC (SqlValue, toSql)

data SqlCommand =
                  SqlSelect { attrs :: [String],
                              tables :: [String],
                              criteria :: SqlExp,
                              groupBy :: [String],
                              order :: [(String,OrderDirection)],
                              limit :: Maybe Integer,
                              offset :: Maybe Integer
                            }

                 | SqlInsertValues
                            { table :: String,
                              set :: [(String,SqlExp)],
                              returning :: Maybe String
                            }

                 | SqlUpdateValues
                            { table :: String,
                              set :: [(String,SqlExp)],
                              criteria :: SqlExp
                            }

                 | SqlDelete
                            { table :: String,
                              criteria :: SqlExp
                            }



data OrderDirection = OrderAsc | OrderDesc

--data SqlExpr = AppBinOp BinOp SqlExp SqlExp | Const String| Value SQLValue
--data BinOp = BinOp Fixity String
--data Fixity = Prefix | Infix

data SqlExp =   False_ | True_  -- nullary ops here
              | Lower_  SqlExp   -- monary ops her
              | AppBinOp BinOp SqlExp SqlExp 
              | Const String | Value SqlValue | Query SqlCommand | AnyCondition [SqlExp]

data BinOp = IsEqualTo | In_ | Like_ | Or_ | And_

(.==.) :: SqlExp -> SqlExp -> SqlExp
(.==.) = AppBinOp IsEqualTo
like_ :: SqlExp -> SqlExp -> SqlExp
like_ = AppBinOp Like_
or_ = AppBinOp Or_

--(.=.) = AppBinOp (BinOp Infix "=")
--restrictAttrOp :: BinOp String -> SQLValue -> SqlCommand -> SqlCommand

in_ :: String -> SqlCommand -> SqlExp
name `in_` query = AppBinOp In_ (Const name) (Query query)

lowerLike :: String -> SqlValue -> SqlExp
col `lowerLike` s = Lower_ (Const col) `like_` Value s


---------------------------------------------------
-- combinators for creating or modifying commands
---------------------------------------------------

-- basic creation of commands
selectCmd :: [String] -> SqlCommand
selectCmd tbls = SqlSelect [] tbls True_ [] [] Nothing Nothing

insertCmd :: String -> [(String,SqlValue)] -> SqlCommand
insertCmd tbl vals = setValues vals (SqlInsertValues tbl [] Nothing)

updateCmd :: String -> [(String,SqlValue)] -> SqlCommand
updateCmd tbl vals = setValues vals (SqlUpdateValues tbl [] True_)

deleteCmd :: String -> SqlCommand
deleteCmd tbl = SqlDelete tbl True_


-- modifying commands

--from more tables
addFromTables :: [String] -> SqlCommand -> SqlCommand
addFromTables tbls cmd = cmd { tables = (tables cmd ++ tbls) }

-- projections, just defined for select
projectAttrs :: [String] -> SqlCommand -> SqlCommand
projectAttrs cols cmd = cmd {attrs = attrs cmd ++ cols}

projectJustAttrs :: [String] -> SqlCommand -> SqlCommand
projectJustAttrs cols cmd = cmd {attrs = cols}

countRows :: SqlCommand -> SqlCommand --just for select
countRows cmd = cmd {attrs = ["COUNT (*)"] }

-- restrictions, just defined for select, update and delete
restrictAttr :: String -> SqlValue -> SqlCommand -> SqlCommand
restrictAttr attr val = addCriterium (Const attr .==. Value val)

restrictAttrs :: [(String, SqlValue)] -> SqlCommand -> SqlCommand
restrictAttrs attrs cmd = foldr (uncurry restrictAttr) cmd attrs

restrictAttrsEqual :: String -> String -> SqlCommand -> SqlCommand
restrictAttrsEqual attr1 attr2 = addCriterium (Const attr1 .==. Const attr2)

restrictAttrInSubQuery :: (String, SqlCommand) -> SqlCommand -> SqlCommand
restrictAttrInSubQuery (attr, subq) = addCriterium (attr `in_` subq)

modWhere :: (SqlExp -> SqlExp) -> SqlCommand -> SqlCommand
modWhere f cmd = cmd {criteria = f (criteria cmd)}

setCriteria :: [SqlExp] -> SqlCommand -> SqlCommand
setCriteria constraints cmd = cmd {criteria = foldl (AppBinOp And_) True_ constraints }

addCriterium :: SqlExp -> SqlCommand -> SqlCommand
addCriterium crit = modWhere (\e-> AppBinOp And_ e crit)

-- order, limit and offset just defined for select
setOrderAsc, setSubOrderAsc, setOrderDesc, setSubOrderDesc :: String -> SqlCommand -> SqlCommand
setOrderAsc col cmd = cmd {order = (col, OrderAsc) : order cmd }
setOrderDesc col cmd = cmd {order = (col, OrderDesc) : order cmd }
setSubOrderAsc col cmd = cmd {order = order cmd ++ [(col, OrderAsc) ]}
setSubOrderDesc col cmd = cmd {order = order cmd ++ [(col, OrderDesc) ]}

setOrder, setSubOrder :: String -> OrderDirection -> SqlCommand -> SqlCommand
setOrder name OrderAsc = setOrderAsc name
setOrder name OrderDesc = setOrderDesc name
setSubOrder name OrderAsc = setSubOrderAsc name
setSubOrder name OrderDesc = setSubOrderDesc name

setOrderList :: [(String,OrderDirection)] -> SqlCommand -> SqlCommand
setOrderList [] cmd = cmd {order = []}
setOrderList ((name,dir): ordBy' ) cmd = foldl setSubOrder' (setOrder name dir cmd) ordBy'
                                         where setSubOrder' cmd (name,dir) = setSubOrder name dir cmd 

setLimit, setOffset :: Integer -> SqlCommand -> SqlCommand
setLimit i cmd = cmd {limit = Just i}
setOffset i cmd = cmd {offset = Just i}

setRange :: Integer -> Integer -> SqlCommand -> SqlCommand
setRange from to = setLimit (to-from) . setOffset from

-- setting values just defined for update and insert
setValue :: String -> SqlValue -> SqlCommand -> SqlCommand
setValue col val cmd = cmd{set=(col, Value val):set cmd }

setValues :: [(String,SqlValue)] -> SqlCommand -> SqlCommand
setValues vals cmd = foldr (uncurry setValue) cmd vals

-- setting returning field name just defined for insert
setReturning :: String -> SqlCommand -> SqlCommand
setReturning serial cmd = cmd {returning = Just serial}


-- textual Searchs
--casesensitiveSearchExpr :: [String] -> String -> SqlExp
caseInsensitiveSearchExpr :: [String] -> String -> SqlExp
caseInsensitiveSearchExpr colsToLookIn s 
              = AnyCondition (map (`lowerLike` toSql ("%" ++ low s ++ "%")) colsToLookIn)


{-
query1 = setOrderDesc "comment_id" $ restrictAttrs [("resource_id", toSql (1::Integer)), ("resource_type", toSql "person")] $ selectCmd "person"
query2 = countRows $ setLimit 10 $ setOffset 30 $ query1
query3 = setRange 15 20 query2
query4 = insertCmd "comment" [("id",toSql (3::Integer)), ("name", toSql "pipo")]
query5 = setReturning "comment_id" query4
query6 = updateCmd "comment" [("id",toSql (3::Integer)), ("name", toSql "pipo")]
query7 = restrictAttr "comment_id" (toSql(3::Integer)) query6
query8 = restrictAttrs [("id",toSql (3::Integer)), ("name", toSql "pipo")] $ deleteCmd "comment"

main = print $ ppSqlCommand query8

-}