{-# LANGUAGE NoMonomorphismRestriction, PatternSignatures  #-}
module View where

import Text.StringTemplate
import Misc
import Text.StringTemplate
import qualified Data.Map as M
import Data.List
import Data.Char
import Control.Monad.Reader
import Network.HTTP (urlEncode)
import Data.Maybe
import SerializeableUsers 

import ViewPagination

-- Notice, there are no HApps.* imports 
-- Idea is, view is meant to be used from controller.
-- Try to keep functions as type
--   Pure -> .. -> Pure -> IO String
--   or Pure -> Pure -> String

-- 1 second reload time/IO for templates.
-- tmplkvs: key/value pairs used for filling in a template
--tutlayout, tutlayoutSafe :: [(String, String)] -> String -> String -> IO String
--tutlayout tmplkvs basedomain tmpl = tutlayout' (unsafeVolatileDirectoryGroup "templates" 1) tmplkvs basedomain tmpl

-- how much stress does this put on the server?
-- how could I even find this out?
-- I could try setting a higher reload time, run top, and see if the happs process uses less memory
-- withTemplateDir :: String -> (STGroup String -> String) -> IO String
-- Could also see if it's practical to try working with the safe version
-- Probably it's fine for "production", where not making template changes all the time
-- and it's fine to stop/restart server when I do.
--tutlayoutSafe tmplkvs basedomain tmpl = tutlayout' (directoryGroup "templates")  tmplkvs basedomain tmpl 

getTemplates :: IO (STGroup String)
getTemplates = directoryGroupSafer "templates"

data RenderGlobals = RenderGlobals { templates :: STGroup String,
                            mbUser :: Maybe User
                            }

tutlayout :: RenderGlobals -> [([Char], [Char])] -> String -> String
tutlayout (RenderGlobals ts mbU) attrs tmpl0 = 
  let tmpl = cleanTemplateName tmpl0

      rendertut :: [(String,String)] -> String -> String
      rendertut attrs file = ( renderTemplateGroup ts ) attrs file

      -- should use readM, or whatever it's called, from Data.Safe
      readtut file = read . rendertut [] . concatMap escapequote $ file
        where escapequote char = if char=='"' then "\\\"" else [char]

      attrsL = maybe attrs( \user -> [("loggedInUser",username user)] ++ attrs ) mbU  

      content = rendertut attrsL tmpl

      header =  rendertut [("menubarMenu",menubarMenu),("userMenu",userMenu),("mainUserMenu",mainUserMenu)] "header"
        where 
          userMenu = maybe 
            ( rendertut attrsL "login" )
            ( \user -> paintHMenu . map (menuLink ts ("/tutorial/" ++ tmpl0) ) $
              [("/tutorial/logout","logout " ++ (username user))
               , ("/tutorial/changepassword","change password")] )
            ( mbU ) 
          mainUserMenu = if (isJust mbU) 
                           then paintHMenu .
                                  map (menuLink ts ("/tutorial/" ++ tmpl0) )
                                    . readtut $ "mainusermenu"
                           else "" 

          menubarMenu =
            paintHMenu . map (menuLink ts ("/tutorial/" ++ tmpl0) ) . readtut $ "menubarmenu"

      --, ("post-data","form post data")
      --, ("get-data","querystring get data")
      --, ("macid-data","macid data")
      --, ("migrating","changing the data model")
      tocArea = paintVMenuOL . map (menuLink ts ("/tutorial/" ++ tmpl0) ) . readtut $ "toc"
           
  
  in rendertut ( [("tocarea",tocArea)
                     , ("contentarea",content)
                     , ("headerarea",header)] ) "base"



-- menuLink :: Maybe String -> String -> (String, String) -> String
menuLink ::  STGroup String
  -> String
  -> (String, String)
  -> String
menuLink templates currUrl (url,anchortext) =
  let r = renderTemplateGroup templates attrs
      attrs = [("url",url),("anchortext",anchortext)]
  in  if ( currUrl == url)
        then r "menulinkselected"
        else if null url
                then r "menulinkgray"
                else r "menulinkunselected"

simpleLink templates (url,anchortext) = renderTemplateGroup templates [("url",url),("anchortext",anchortext)] "simplelink"

paintVMenu = concatMap (\mi -> "<p>" ++ mi ++ "</p>") 
paintVMenuUL xs = "<ul>" ++ (concatMap (\mi -> "<li>" ++ mi ++ "</li>") xs) ++ "</ul>"
paintVMenuOL xs = "<ol>" ++ (concatMap (\mi -> "<li>" ++ mi ++ "</li>") xs) ++ "</ol>"
paintHMenu = intercalate " | " 

--paintTable :: [String] -> Maybe [String] -> [[String]] -> Maybe Pagination -> String
paintTable templates mbHeaderCells datacells mbPagination =
  let trows = maybe rows ( (++rows) . paintHeaderTr) mbHeaderCells
        where rows = paintTrs tableCells

      tableCells :: [[String]]
      tableCells = maybe datacells (getPaginatedCells datacells) mbPagination 

      paginationBar :: String
      paginationBar = maybe "" (paintPaginationBar templates datacells) mbPagination
      
  in ( table trows ) ++ paginationBar



paintHeaderTr hc = tr . concat . (map (td {-. biggerfont -} ) ) $ hc
paintTrs cells = concat . map (tr . concat) . ( (map . map) td ) $ cells

biggerfont x = "<font size=+1>" ++ x ++ "</font>"
tr x = "<tr>" ++ x ++ "</tr>"
td x = "<td>" ++ x ++ "</td>"
table x = "<table>" ++ x ++ "</table>"

cleanTemplateName tmpl = filter isAlpha tmpl

paintblurb b = (concatMap formatnewlines) b
  where formatnewlines c = if c == '\n' then "<br>" else [c]

{-
paintConsultantProfile :: RenderGlobals -> ConsultantProfile -> String -> String
paintConsultantProfile rglobs (ConsultantProfile cRate cBlurb listAsC) uName =
                       let  showblurb = paintblurb cBlurb
                            -- jobsPosted = paintJobsTable n rglobs $ js                                          
                       in   renderTemplateGroup (templates rglobs) [("username",uName)
                                              , ("blurb",showblurb)
                            --                   , ("jobsPosted",jobsPosted)
                                              , ("billingRate",cRate)] "viewconsultantprofileInclude"
-}
paintProfile :: RenderGlobals -> String -> ConsultantProfile -> String
paintProfile rglobs user cp =
  let attrs = [("username",user) 
               , ("blurb",paintblurb . blurb $ cp)
               --, ("jobsPosted",paintJobsTable n rglobs $ js)
               , ("contact",contact cp)]
  in renderTemplateGroup (templates rglobs) attrs "consultantprofile"

paintUserJobsTable rglobs postedBy rsUserJobs currP resPP= 
  let jobCells = map ( \(Job j budget blurb)  ->
                       [ simpleLink (templates rglobs) ("/tutorial/viewjob?user="++postedBy++"&job=" ++ j,j)
                         , simpleLink (templates rglobs) ("/tutorial/editjob?user="++postedBy++"&job=" ++ j,"edit")
                         , simpleLink (templates rglobs) ("/tutorial/deletejob?user="++postedBy++"&job=" ++ j,"delete")

                       ] )  rsUserJobs
  in  paintTable (templates rglobs) Nothing -- (Just ["<b>project</b>","<b>budget</b>"])
                            jobCells
                            Nothing -- no pagination for now 

paintAllJobsTable rglobs rsListAllJobs currP resPP = 
  let p = Pagination { currentpage = currP,
                       resultsPerPage = resPP,
                       baselink = "tutorial/jobs",
                       paginationtitle = "Job Results: "}
      jobCells = map ( \((Job j budget blurb),postedBy)  ->
                       [ simpleLink (templates rglobs) ("/tutorial/viewjob?user="++postedBy++"&job=" ++ j,j)
                         , budget
                         , simpleLink (templates rglobs) ("/tutorial/viewprofile?user="++postedBy, postedBy )
                       ] )  rsListAllJobs
  in  paintTable (templates rglobs) (Just ["<b>project</b>","<b>budget</b>","<b>posted by</b>"])
                            jobCells
                            (Just p) 

paintjob rglobs pBy (Job jN jBud jBlu) =
  let userlink = simpleLink (templates rglobs) ("/tutorial/viewprofile?user=" ++ pBy,pBy)
      attrs = [("jobname",jN)               
              , ("budget",jBud)
              , ("jobblurb",jBlu)
              , ("postedBy",userlink)] 
  in renderTemplateGroup (templates rglobs) attrs "job"