{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}

module RESTng.Resources.Comment where

import Prelude hiding(span, div)
import Database.HDBC (toSql)
import Text.ParserCombinators.Parsec (parse)
import Data.Generics

import Text.CxML
import Network.HTTP.RedHandler (RequestContext, completeURL)

import RESTng.Database.Record
import RESTng.RESTngMonad (RESTng)
import RESTng.System.Resource
import RESTng.System.RelationalResource
import RESTng.System.PersistableResource
import RESTng.System.WebResource
import RESTng.System.Annotation
import RESTng.System.Permission (everybodyCan)
import RESTng.System.CRUD
import RESTng.System.Association
import RESTng.System.FormFields
import RESTng.System.Component (childComponent)

data Comment = Comment {
       comment_id :: Integer,
       comment_title :: String,
       comment_body :: String,
       resource_id :: Integer,
       resource_type :: String
   } deriving (Data, Typeable)

instance Resource Comment where
  resourceType _ = "Comment"
  key = comment_id
  setKey p k = p{comment_id = k}
  userFields _ = ["comment_title", "comment_body", "resource_id", "resource_type"]

--FIXME: ownable = True in the future since comments should have owner, I think.
-- Then, we could change CRUD permisssions for comments.


instance RelationalResource Comment where
  tableName _ = "Comments"

  userFieldsToSql r = [ toSql $ comment_title r, toSql $ comment_body r,
                        toSql $ resource_id r, toSql $ resource_type r ]


--   sqlUserFieldsParser :: SystemFields -> SqlValueParser a
  sqlUserFieldsParser (k, _) = 
                   do
                     (ctitle, cbody, rid, rtype) <- sqlRecordParser
                     return (Comment k ctitle cbody rid rtype)


instance PersistableResource Comment where
  persistableFunctions = persistableFromRelational


instance WebResource Comment where
  userFieldValues r = [ showField $ comment_title r, showField $ comment_body r,
                        showField $ resource_id r, showField $ resource_type r ]

  userFieldValuesParser (k, _) =
                   do
                     ctitle <- parseNotEmpty "comment_title"
                     cbody <- parseNotEmpty "comment_body"
                     rid <- parseField "resource_id"
                     rtype <- parseNotEmpty "resource_type"
                     return (Comment k ctitle cbody rid rtype)



instance InGridResource Comment

-- Comments CRUD
instance AnnotatedResource Comment

instance CRUDable Comment where
  canGetCreationForm = everybodyCan
  canCreate   = everybodyCan
  canRetrieve = everybodyCan
  canUpdate   = everybodyCan
  canDelete   = everybodyCan


-- Comment Annotations (for other resources)
commentProxy :: Proxy Comment
commentProxy = undefined

instance RelationalResource a => RelationalOneToMany a Comment where -- requires FlexibleInstances & MultiParamTypeClasses
  --fkValue :: Proxy a -> Comment -> Integer
  fkValue _ = resource_id
  fkName _ _ = "resource_id"

instance RelationalResource a => AssocOneToMany a Comment where -- requires FlexibleInstances & MultiParamTypeClasses
  polyDiscriminatorName _ _ = "resource_type"
  polyDiscriminator comm _ = resource_type comm
  oneToManyFunctions = oneToManyFromRelational


comments :: AssocOneToMany a Comment => Annotation a
comments = (childComponent commentProxy) {whenListingElement = showCommentsQty}

showCommentsQty :: AssocOneToMany a Comment => a -> RESTng (CxML RequestContext)
showCommentsQty res
               = do commsQty <- findReferringTo res commentProxy >>= return . length
                    return (withCtx $ urlLink commsQty)
                 where
                    urlLink commsQty rq = a!("href", completeURL rq) /- [t (show commsQty ++ " comments")]
--FIXME: make a select count query instead of calculating the length of the list of comments