module ControllerGetActions where

import Control.Monad.Reader
import Control.Monad
import Happstack.Server
import Happstack.State

import Data.List
import Happstack.Helpers
import qualified Data.ByteString.Char8 as B
import ControllerMisc
import StateVersions.AppState1
import View
import FromDataInstances

import Misc
import qualified MiscMap as M


viewConsultants :: RenderGlobals -> ServerPartT IO Response
viewConsultants rglobs = do
  PaginationUrlData currB resPB currP resPP <- getData'
  consultants <- fmap (map unusername . M.keys . M.filter (consultant . userprofile) . users) $ 
                 query AskDatastore
  let p = Pagination { currentbar = currB
                     , resultsPerBar = resPB
                     , currentpage = currP
                     , resultsPerPage = resPP
                     , baselink = "tutorial/consultants"
                     , paginationtitle = ""} 
      consultantCells = map ( return . userlink ) consultants
      consultantTable = paintTable Nothing consultantCells (Just p)
      

      -- if not logged in, you get an invite to register as a consultant
      -- basically an incentive to register
      tmplattrs = maybe (def ++ [("registerAsConsultant","list yourself as a Happstack developer")])
                         (const def)
                         (mbUser rglobs)
          where def = [("consultantList", consultantTable)]
  return . tutlayoutU rglobs tmplattrs $ "consultants"

viewConsultantsWanted :: RenderGlobals -> ServerPartT IO Response
viewConsultantsWanted rglobs = do
  (PaginationUrlData currB resPB currP resPP) <- getData'
  consultantswanted <- return . map unusername . M.keys
                                     =<< return . M.filter (not . M.null . unjobs . jobs ) . users 
                                       =<< query AskDatastore
  let p = Pagination { currentbar = currB
                       ,resultsPerBar = resPB
                       , currentpage = currP
                       , resultsPerPage = resPP
                       , baselink = "tutorial/consultantswanted"
                       , paginationtitle = ""} 

      consultantCells = map ( return . userlink  ) consultantswanted
      consultantTable = paintTable Nothing consultantCells (Just p)
      
      -- an incentive to register
      tmplattrs = maybe (def ++ [("postJob","post a Happstack job")])
                        (const def )
                        (mbUser rglobs)
        where def = [("ulist", consultantTable)]
  return . tutlayoutU rglobs tmplattrs $ "consultantswanted"

viewJobs :: RenderGlobals -> ServerPartT IO Response
viewJobs rglobs  = do
  PaginationUrlData currB resPB currP resPP <- getData'
  rsListAllJobs <- query ListAllJobs  
  let pag = Pagination { currentbar = currB
                       , resultsPerBar = resPB
                       , currentpage = currP
                       , resultsPerPage = resPP
                       , baselink = "tutorial/jobs"
                       , paginationtitle = "Job Results: "}
      jobCells = map f rsListAllJobs
        where f (JobName j', (Job budget _), UserName posted) = let j = B.unpack j' in 
                [ joblink posted j
                  , B.unpack budget
                  , userlink posted
                ]
      paintAllJobsTable _ j p = 
        paintTable (Just ["<b>project</b>","<b>budget</b>","<b>posted by</b>"])
                   j
                   (Just p)
      jobTable = paintAllJobsTable rglobs jobCells pag
      -- if not logged in, you get invited to post a job,
      -- basically an incentive to register

      -- this next line should be coming from a template, and it's duplicated elsewhere, slightly bad.
      tmplattrs = maybe (def++[("postJob","post a Happstack job")]) (const def) (return . sesUser =<< mbSession rglobs)
        where def = [("jobTable",  jobTable)]
  return . tutlayoutU rglobs tmplattrs $ "jobs"

-- better name would be just viewEditProfile, since everyone gets a profile, not just consultants.
viewEditConsultantProfile :: RenderGlobals -> ServerPartT IO Response
viewEditConsultantProfile rglobs =       
   case mbUser rglobs of
    Nothing -> return . tutlayoutU rglobs [("errormsg", "error: no user")] $ "errortemplate"
    Just currU -> do      
      mbUis <- query $ GetUserInfos currU 
      case mbUis of
        Nothing -> return . tutlayoutU rglobs [("errormsg", "error: no user infos")] $ "errortemplate"
        Just uis -> do
          let cp = userprofile uis              
              
          uimage <- liftIO $ avatarimage currU 
              -- use show below to properly escape quotes
          let showPr = paintProfile rglobs (B.unpack . unusername $ currU) cp uimage
              attrs = [ ("username", B.unpack . unusername $ currU)
                        , ("userimage", uimage)         
                        , ("blurb", B.unpack . blurb $ cp)
                        , ("contact", B.unpack . contact $ cp)
                        , ("listAsConsultantChecked", checkedStringIfTrue $ consultant cp )
                        , ("profile",showPr)
                          ]
          return $ tutlayoutU rglobs attrs "editconsultantprofile"

viewEditJob :: UserName -> JobName -> RenderGlobals -> ServerPartT IO Response
viewEditJob pBy jN rglobs =       
    case mbUser rglobs of
      Nothing -> return $ tutlayoutU rglobs [("errormsg", "error: no user")] "errortemplate"
      Just currU ->
        if currU /= pBy
           then return $ tutlayoutU rglobs
                  [("errormsg", "error: " ++ (B.unpack . unjobname $ jN) ++ " not posted by " ++ (B.unpack . unusername $ currU) )]
                    "errortemplate"
           else do
             mbJ <- lookupJob pBy jN 
             case mbJ of
               Nothing -> return $ tutlayoutU rglobs
                            [ ( "errormsg", "error, bad job: " ++ (show (pBy,jN) ) ) ] "errortemplate"
               Just j -> do let attrs = [ ("jobname", quote . B.unpack . unjobname $ jN)
                                        , ("budget", quote . B.unpack . jobbudget $ j)
                                        , ("jobblurb", quote . B.unpack . jobblurb $ j)
                                        , ("showJob",paintjob rglobs pBy (jN,j) )
                                      ]
                            return $ tutlayoutU rglobs attrs "editjob" 

lookupJob :: (MonadIO m) => UserName -> JobName -> m (Maybe Job)
lookupJob pBy jN = do
  mbUis <- ( query . GetUserInfos ) pBy 
  case mbUis of
    Nothing -> return Nothing
    Just uis -> return $ M.lookup jN (unjobs . jobs $ uis)

pageMyJobPosts :: RenderGlobals -> ServerPartT IO Response
pageMyJobPosts rglobs = do        
  mbUis <- getGlobsUserInfos rglobs
  case mbUis of
    Left err -> return . tutlayoutU rglobs [("errormsg", err)] $ "errortemplate"
    Right  (currU,uis) -> do
          let jobPostsTable = paintUserJobsTable (unusername currU) (M.toList . unjobs . jobs $ uis)
          return $ tutlayoutU rglobs [("jobPostsTable",jobPostsTable)] "myjobposts"

getGlobsUserInfos :: Monad m => RenderGlobals -> ServerPartT IO (m ( UserName,UserInfos) )
getGlobsUserInfos rglobs =
  case (fmap sesUser $ mbSession rglobs) of
    Nothing -> fail "getUserInfos, no user in globals"
    Just un -> do
      mbUis <- query $ GetUserInfos un
      case mbUis of
        Nothing -> return $ fail "getUserInfos, no user infos"
        Just uis -> return $ return (un,uis)

viewJob :: (MonadIO m) => RenderGlobals -> ServerPartT m Response
viewJob rglobs  = do
  JobLookup pBy jN <- getData'
  mbJ <- lookupJob pBy jN 
  case mbJ of
    Nothing -> return $ tutlayoutU rglobs [("errmsg", "no job found")] "errortemplate"
    Just j -> return $ tutlayoutU rglobs [("job",paintjob rglobs pBy (jN,j) )] "viewjob"

userProfile :: (MonadIO m) => RenderGlobals -> ServerPartT m Response
userProfile rglobs = do
  UserNameUrlString user <- getData'

  mbCP <- do mbUis <- query (GetUserInfos user)  
             return $ fmap userprofile mbUis

  case mbCP of
    Nothing -> return $ tutlayoutU rglobs [("errormsgProfile", "bad user: " ++ (B.unpack . unusername $ user) )] "viewconsultantprofile"
    Just cp  -> do
              userimg <- liftIO $ avatarimage user
              return $ tutlayoutU rglobs [("cp", paintProfile rglobs (B.unpack . unusername $ user) cp userimg)] 
                       "viewconsultantprofile"

viewEditJobWD :: RenderGlobals -> ServerPartT IO Response
viewEditJobWD rglobs = withData $ \(JobLookup pBy jN) -> viewEditJob pBy jN rglobs

deleteJobWD :: RenderGlobals -> ServerPartT IO Response
deleteJobWD rglobs = withData $ \(JobLookup pBy jN) -> deleteJob pBy jN rglobs

-- there's a lot of repeated code for viewEdit and Delete of jobs. 
-- maybe can consolidate
deleteJob :: UserName -> JobName -> RenderGlobals -> ServerPartT IO Response
deleteJob pBy jN rglobs = 
    case mbUser rglobs of
      Nothing -> return $ tutlayoutU rglobs [("errormsg", "error: no user")] "errortemplate"
      Just currU ->
        if currU /= pBy
           then return $ tutlayoutU rglobs
                  [("errormsg", "error: " ++ (B.unpack . unjobname $ jN) ++ " not posted by " ++ (B.unpack . unusername $ currU) )]
                    "errortemplate"
           else do update $ DelJob currU jN
                   pageMyJobPosts rglobs