HelpReqs.hs

{-# LANGUAGE TemplateHaskell, FlexibleInstances, DeriveDataTypeable,
             ImplicitParams, TypeSynonymInstances, TypeFamilies,
             MultiParamTypeClasses, TypeOperators #-}

{- LANGUAGE    TemplateHaskell , FlexibleInstances, UndecidableInstances, OverlappingInstances, 
                DeriveDataTypeable, FlexibleContexts, ImplicitParams,
                MultiParamTypeClasses, TypeSynonymInstances, TypeFamilies -}

-- MultiParamTypeClasses
module HAppS.Store.HelpReqs where

import Control.Monad.State hiding (State)
import Control.Monad.Reader

import HAppS.Data
import HAppS.Data.Atom
import HAppS.Data.IxSet
import HAppS.State
import HAppS.Server.Facebook as FB 
    (Uid,uid,FBSession,fbSeeOther,getIsAdmin
    ,getAdmins,notifications_send  )
import HAppS.Store.Util
import HAppS.Server.SimpleHTTP -- hiding (ok)
import HAppS.Store.FlashMsgs
import HAppS.Server.HTTP.Types (Response)
{--

  Use HelpReqs to track help requests on your app.  The concept is that the
  user just fills out a form describing their needs and you get back to them.

  See FlashMsgs for the cannonical info, but..

--}
#ifndef __HADDOCK__
$( deriveAll [''Show,''Default,''Read,''Eq,''Ord]
   [d|
       -- the data for the help system
       data HelpReqForm = HelpReqForm --get the form
       data HelpReq = HelpReq FB.Uid Published Title HelpText Status--post the help
       newtype HelpText = HelpText String
       data Status = Open | Closed Published
       newtype HelpFeed = HelpFeed [HelpReq] -- provide a help feed
       data HelpMsgReceived = HelpMsgReceived
       --data Status = Open | Assigned FB.Uid Published | Closed FB.Uid Published
     |])

instance Version HelpReq
instance Version Status
instance Version HelpFeed
instance Version HelpText
instance Version HelpMsgReceived
$(deriveSerialize ''HelpReq)
$(deriveSerialize ''Status)
$(deriveSerialize ''HelpFeed)
$(deriveSerialize ''HelpText)
$(deriveSerialize ''HelpMsgReceived)

$(inferIxSet "HelpReqs" ''HelpReq 'noCalcs [''FB.Uid,''Published,''Status] )
#endif
{-
$(deriveAll [''Show,''Default,''Read]
  [d| data HelpReqs = HelpReqs {unHelpReqs :: HelpReqs_ } |]
 )
-}

--Command functions
addHelpReq :: HelpReq -> Update HelpReqs ()
addHelpReq helpReq
    = do seconds <- liftM (`div` 1000) getTime
         modify $ insert (gSet (Published seconds) helpReq)
   
getHelpReqs :: Query HelpReqs [HelpReq]
getHelpReqs  = liftM byRevTime ask

#ifndef __HADDOCK__
$(mkMethods ''HelpReqs ['addHelpReq,'getHelpReqs])
instance Component HelpReqs where
    type Dependencies HelpReqs = FlashMsgs HelpMsgReceived :+: End
#endif



-- http stuff 
http::( ?fbSession::FBSession
      , MonadIO m
      ) => [ServerPartT m Response]
http = 
    [
     dir "help" [ method () $ ok $ toResponse HelpReqForm]

    ,dir "addHelp" 
             [withData $ \helpReq -> 
                  [method () $ do
                               webUpdate $ AddHelpReq helpReq
                               liftIO $ insFlashMsg uid HelpMsgReceived
                               admins <- liftIO $ getAdmins
                               unless (null admins) $ 
                                      do
                                      conf <- liftIO $ notifications_send admins 
                                                      (Title "helpreq")
                                                      ()
                                      return ()
                               liftM toResponse $ fbSeeOther "side-nav"
                   ]]

    ,dir "helps" [method () $ do
                  isAdmin <- liftIO $ getIsAdmin
                  if not isAdmin then forbidden (toResponse "not admin!") else do
                  flashMsg <- liftIO $ (extFlashMsg uid :: IO (Maybe HelpMsgReceived))
                  helpReqs <- webQuery $ GetHelpReqs
                  (ok . toResponse .
                     insEl (Attr "context" "helpfeed") . 
                     insEl flashMsg .
                     HelpFeed . 
                     take 1000) helpReqs 
                 ]
      ]






































--controls
--addHelpReq = update . AddHelpReq'
{--

--addHelpReq' adr = update . adr 

controls::Q [Dec]
controls = return  
           [
--            fun0_1 "addHelpReq" "addHelpReq'" "AddHelpReq"
           fun0_1 "getHelpReqs" "query" "GetHelpReqs"
           ]
--}                    
-- $(return 
--  [fun0_1 "addHelpReq" "addHelpReq'" "AddHelpReq"])           


--OBSOLETE? ---
-- Control functions that need some help
{--
addHelpMsg help@(HelpMsg uid (Published t) msg) = 
    do
    TOD eTime _ <- getClockTime
    if t > eTime || t < eTime - 3600000 then return () else do
    update $ AddHelpMsg help

getHelpMsgs = query GetHelpMsgs
--}