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

module RESTng.Resources.Rating where

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

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

import RESTng.Database.SQL
import RESTng.Database.Record
import RESTng.RESTngMonad (RESTng, getAuthUser)
import RESTng.Resources.User (User)
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, nobodyCan)
import RESTng.System.CRUD
import RESTng.System.Association
import RESTng.System.FormFields

data RatingVote = RatingVote {
       rating_vote_id :: Integer,
       owner_id :: Integer,
       resource_id :: Integer,
       resource_type :: String,
       value :: Integer
   } deriving (Data, Typeable)

instance Resource RatingVote where
  resourceType _ = "RatingVote"
  key = rating_vote_id
  setKey p k = p{rating_vote_id = k}

  ownable _ = True
  ownerId = owner_id
  setOwnerId oid r = r {owner_id = oid}
  ownerIdName _ = "user_id"
  userFields _ = ["resource_id", "resource_type", "value"]


instance RelationalResource RatingVote where

  userFieldsToSql r = [ toSql $ resource_id r, toSql $ resource_type r,
                        toSql $ value r ]

--   sqlUserFieldsParser :: SystemFields -> SqlValueParser a
  sqlUserFieldsParser (k, (Just oid)) = 
                   do
                     (rid, rtype, val) <- sqlRecordParser
                     return (RatingVote k oid rid rtype val)


instance PersistableResource RatingVote where
  persistableFunctions = persistableFromRelational

instance WebResource RatingVote where
  userFieldValues r = [ showField $ resource_id r, showField $ resource_type r,
                        showField $ value r ]

  userFieldValuesParser (k, (Just oid)) = 
                   do
                     rid <- parseField "resource_id"
                     rtype <- parseNotEmpty "resource_type"
                     val <- parseField "value"
                     return (RatingVote k oid rid rtype val)


instance InGridResource RatingVote

-- RatingVote CRUD
instance AnnotatedResource RatingVote

instance CRUDable RatingVote where
  canGetCreationForm = everybodyCan
  canCreate   = everybodyCan
  canRetrieve = nobodyCan
  canUpdate   = nobodyCan
  canDelete   = nobodyCan
--FIXME: change permission canGetCreationForm to nobodyCan (after some testing)

-- RatingVote Annotations
ratingVoteProxy :: Proxy RatingVote
ratingVoteProxy = undefined


ratings :: AssocOneToMany a RatingVote => Annotation a
ratings = defaultAnnotation {
                             annotationName = "ratings",
                             whenShowingElement = showRating,
                             whenEditingElement = showRating,
                             whenListingElement = showRating
                            }


showRating :: AssocOneToMany a RatingVote => a -> RESTng (CxML RequestContext)
showRating res = do ratingVotes <- findReferringTo res ratingVoteProxy
                    authUsr <- getAuthUser
                    let (rate, rvsQty) = getAvgAndLength ratingVotes
                    return ( (t $ showRate rate ++ showRatings rvsQty) +++
                              (withCtx $ maybeNewLink authUsr)
                           )
                 where
                    getAvgAndLength :: [RatingVote] -> (Maybe Float, Int)
                    getAvgAndLength = avgAndLength . (map value)
                    showRate Nothing = "Rated: not yet"
                    showRate (Just r) = "Rated: " ++ show r
                    showRatings rvsQty = " (" ++ show rvsQty ++" ratings" ++ ")"

                    maybeNewLink :: Maybe User -> RequestContext -> CxML RequestContext
                    maybeNewLink Nothing rq = a!("href", ("/login.html" ++ renderQuery [("kurl",completeURL rq)]))
                                                 /- [t "(login to rate)"]
                    maybeNewLink (Just u) rq =  a!("href", newRatingVoteURL rq) /- [t "Please rate"]

                    newRatingVoteURL = completeURL . newRatingVoteCtx
                    newRatingVoteCtx :: RequestContext -> RequestContext
                    newRatingVoteCtx = addMethodNewToCollAddr .
                                          addHierarchicalCollToResAddr (resourceType ratingVoteProxy) restQuery
                    restQuery = referringQuery (proxyOf res) ratingVoteProxy (key res)


-- |Although Fractional type have a representation for values coming from by 0 division
--  we choose to represent that case explicitely with a Nothing
avgAndLength :: (Fractional a, Integral b) => [b] -> (Maybe a, Int)
avgAndLength nums = (avg,l)
                 where
                   (s,l) = sumAndLength nums
                   avg = if l==0 
                           then Nothing -- can not calculate avg if nobody has rated
                           else Just (fromIntegral s / fromIntegral l)


sumAndLength :: Num a => [a] -> (a,Int)
sumAndLength [] = (0,0)
sumAndLength (n:ns) = let (s,l) = sumAndLength ns
                       in (s+n,l+1)

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

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


-- helper functions to process rated resources:
projectAndOrderByRatingQuery :: RelationalResource a => Proxy a -> SqlCommand -> SqlCommand
projectAndOrderByRatingQuery pr selectQuery = 
                           setOrderDesc "rating" $ projectAttrs ["sum(r.value)/count(*) as rating"] $
                            restrictAttr "r.resource_type" (toSql "Article") $ restrictAttrsEqual (tableName pr ++ ".id") "r.resource_id" $
                             addFromTables ["RatingVote r"] $ selectQuery {groupBy = attrs selectQuery}