{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts  #-}
{-# OPTIONS_GHC -fallow-undecidable-instances -fallow-incoherent-instances #-}

module RESTng.System.RelationalResource where

import Database.HDBC.PostgreSQL (Connection)
import Database.HDBC (SqlValue, toSql)
import Data.Maybe (fromMaybe)
import Control.Monad (liftM2)

import RESTng.Database.SQL
import RESTng.Database.Record
import RESTng.System.Resource
import RESTng.Utils(safeHead)

class Resource a => RelationalResource a where --requires FlexibleInstances
  userFieldsToSql :: a -> [SqlValue]
  sqlUserFieldsParser :: SystemFields -> SqlValueParser a

  tableName :: Proxy a -> String
  tableName = resourceType

  sqlInsert :: a -> SqlCommand
  sqlInsert = sqlInsertDefault
  sqlUpdate :: a -> SqlCommand
  sqlUpdate = sqlUpdateDefault
  sqlDelete :: Integer -> Proxy a -> SqlCommand
  sqlDelete = sqlDeleteDefault
  sqlSelect :: [(String,String)] -> [(String,OrderDirection)] -> Proxy a -> SqlCommand
  sqlSelect = sqlSelectDefault
  sqlSelectOne :: Integer -> Proxy a -> SqlCommand
  sqlSelectOne = sqlSelectOneDefault


class RelationalResource a => RelationalOneToMany a b where --requires MultiParamTypeClasses
  fkName :: Proxy a -> Proxy b -> String -- both a and b might be proxies
  fkName a _ = tableName a ++ "_id"
  fkValue :: Proxy a -> b -> Integer

  sqlSelectByFK :: RelationalResource b => a -> Proxy b -> SqlCommand -- this decl requires FlexibleContexts
  sqlSelectByFK = sqlSelectByFKDefault


keySql :: RelationalResource a => a -> SqlValue
keySql = toSql . key

nonKeyFieldsToSql :: RelationalResource a => a -> [SqlValue]
nonKeyFieldsToSql r = if ownable (proxyOf r)
                        then toSql (ownerId r): userFieldsToSql r
                        else userFieldsToSql r

sqlSystemFieldsParser :: Resource a => Proxy a -> SqlValueParser SystemFields
sqlSystemFieldsParser pr = liftM2 (,) sqlFieldParser ownerParser
                         where
                           ownerParser = if ownable pr
                                           then sqlFieldParser >>= return . Just
                                           else return Nothing

sqlResourceParser :: RelationalResource a => Proxy a -> SqlValueParser a
sqlResourceParser pr = sqlSystemFieldsParser pr >>= sqlUserFieldsParser


dataForCommands :: RelationalResource a => a -> (String, String, SqlValue, [String], [SqlValue])
dataForCommands a = (tableName pa, keyName pa, keySql a, nonKeyFields pa, nonKeyFieldsToSql a)
                    where
                         pa = proxyOf a

typeForCommands :: RelationalResource a => Proxy a -> (String, String, [String])
typeForCommands pa = (tableName pa, keyName pa, nonKeyFields pa)


sqlInsertDefault :: RelationalResource a => a -> SqlCommand
sqlInsertDefault = sqlInsert' . dataForCommands
sqlInsert' (tableName, keyName, _, fields, values)
              = setReturning keyName $ insertCmd tableName (zip fields values)

sqlUpdateDefault :: RelationalResource a => a -> SqlCommand
sqlUpdateDefault r = sqlUpdate' r (dataForCommands r)
sqlUpdate' r (tableName, keyName, keyValue, _, _)
              = restrictAttr keyName keyValue $
                   updateCmd tableName (zip (userFields $ proxyOf r) (userFieldsToSql r) )

sqlDeleteDefault :: RelationalResource a => Integer -> Proxy a -> SqlCommand
sqlDeleteDefault k = sqlDelete' k . typeForCommands
sqlDelete' k (tableName, keyName, _)
              = restrictAttr keyName (toSql k) $
                   deleteCmd tableName

sqlSelectDefault :: RelationalResource a => [(String,String)] -> [(String,OrderDirection)]
                      -> Proxy a -> SqlCommand
sqlSelectDefault filt ordBy = sqlSelect' filt ordBy . typeForCommands
sqlSelect' filt ordBy (tableName, keyName, fields)
              = setOrderList ordBy $
                 projectAttrs (map ((tableName++".")++)(keyName:fields)) $
                  restrictAttrs filt' $
                   selectCmd [tableName]
                 where filt' = [(attr,toSql valStr) | (attr,valStr) <- filt ]

sqlSelectOneDefault :: RelationalResource a => Integer -> Proxy a -> SqlCommand
sqlSelectOneDefault k = sqlSelectOne' k . typeForCommands
sqlSelectOne' k (tableName, keyName, fields)
              = projectAttrs (keyName:fields) $
                 restrictAttr keyName (toSql k) $
                   selectCmd [tableName]


-- | Generates the sql string to get objects of type "b" belonging to objects of type "a".
--   The fst parameter is used to infer the name of FK name in type "b" (type of snd param)
--   and also to get the id value to be used in the search of objects of type "b"
--   TODO : Check that the label name inferred exists. Check that key types match
sqlSelectByFKDefault :: (RelationalOneToMany a b, RelationalResource b) => a -> Proxy b -> SqlCommand
sqlSelectByFKDefault a pb = sqlSelectByFK' a (fkName (proxyOf a) pb) $ typeForCommands pb
sqlSelectByFK' a fkName' (tableName, keyName, fields)
              = projectAttrs (keyName:fields) $
                 restrictAttr fkName' (akValue) $
                   selectCmd [tableName]
                        where
                             akValue = toSql $ key a



dbInsert :: RelationalResource a => a -> Connection -> IO a
dbInsert a conn = do maybeResKey <- runTransactionReturningId (sqlInsert a) conn
                     return (setKey a (fromMaybe 0 maybeResKey))
-- TODO: actually return a new object with the actual id


-- | Receives a connection and a record. Tries to update the record (the key is inferred from the record).
--   In case there is an error, it is the IO fail, in case it succeeds, the number of updated records is returned
--   This number should be usually 1.
dbUpdate :: RelationalResource a => a -> Connection -> IO Integer
dbUpdate a = runTransaction (sqlUpdate a)

-- | Receives a connection and a key. Tries to delete a record with the key.
--   In case there is an error, it is the IO fail, in case it succeeds, the number of updated records is returned
--   This number should be usually 1.
dbDelete :: RelationalResource a => Integer -> Proxy a -> Connection -> IO Integer
dbDelete k pa = runTransaction (sqlDelete k pa)


-- | Receives a connection and a proxy and a list of values to filter. The proxy is used for inferring the type and table.
--   All the records in the table are returned in a list that match the criteria.
--   In case there is an error, it is the IO fail.
dbSelect :: RelationalResource a => [(String,String)] -> [(String,OrderDirection)] -> Proxy a -> Connection -> IO [a]
dbSelect filt ordBy pa = runQueryN sqlRecordParser (sqlSelect filt ordBy pa)


-- | Receives a connection and a key. Tries to get the record from the db
--   In case there is an error, it is the IO fail.
dbSelectOne :: RelationalResource a => Integer -> Proxy a -> Connection -> IO (Maybe a)
dbSelectOne k pa = runQuery01 sqlRecordParser (sqlSelectOne k pa)


-- | Receives a connection string and two records. 
--   The fst parameter is used to infer the name of the foreign key field and the
--   id value to use for the filter.
--   The snd parameter is used just as a proxy for inferring the type and table.
--   All the records of type "b" belonging to (referring to) the object of type "a"
--   are returned in a list. 
--   In case there is an error, it is the IO fail.
dbSelectByFK :: (RelationalOneToMany a b, RelationalResource b) => a -> Proxy b -> Connection -> IO [b]
dbSelectByFK a pb = runQueryN sqlRecordParser (sqlSelectByFK a pb)


instance RelationalResource a => SqlRecord a where
  sqlRecordParser = sqlResourceParser pr
                    where pr = proxyOf undefined