{-# LANGUAGE NoMonomorphismRestriction, ScopedTypeVariables #-}

module Controller where

import Control.Monad
import Control.Monad.Trans
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe 
import HAppS.Server 
import HAppS.State
import Text.StringTemplate
import System.FilePath
import System.Directory
import Data.Char
import Debug.Trace.Helpers
import StateVersions.AppState1
import View

import ControllerBasic
import ControllerPostActions
import ControllerGetActions
import ControllerMisc
import ControllerStressTests

import HAppS.Helpers
import Misc 
import Data.ByteString.Internal 
import Text.StringTemplate.Helpers


staticfiles = [ staticserve "static"
                , staticserve "userdata"
                , browsedir "projectroot" "."
                , browsedirHS "templates" "templates"
                , browsedirHS "src" "src" 
              ] 
  where staticserve d = dir d [ fileServe [] d ]

-- main controller
controller :: STDirGroups String -> Bool -> Bool -> [ServerPartT IO Response]
controller tDirGroups dynamicTemplateReload allowStressTests =  
    -- staticfiles handler *has* to go first, or some content (eg images) will fail to load nondeterministically,
    -- eg http://localhost:5001/static/Html2/index.html (this loads ok when staticfiles handler goes first,
    -- but has the problem when staticfiles handler goes after tutorial handler)
    -- Also interesting: the order doesn't matter when dynamicTemplateReload is false
    -- This still feels to me like a bug: it was quite a headache to diagnose, and why should
    -- the order of the static content handler matter anyway?
    -- At the very least, fileServer should have a highly visible comment warning about this problem.
   staticfiles      
   ++ ( tutorial tDirGroups dynamicTemplateReload allowStressTests )  
    ++ simpleHandlers 
    ++ [ myFavoriteAnimal ]         
      ++ [ msgToSp "Quoth this server... 404." ]

-- with diretoryGroupsOld (lazy readFile), appkiller.sh causes crash
getTemplateGroups = directoryGroupsHAppS "templates" 

tutorial :: STDirGroups String -> Bool -> Bool -> [ServerPartT IO Response]
tutorial tDirGroups' dynamicTemplateReload allowStressTests = [ ServerPartT $ \rq -> do
  -- A map of template groups, with the key being the containing directory name 
  -- If true, Redo IO action for fetching templates (which was also done in main)
  -- so templates are loaded from templates dir for every request.
  -- which lets you change templates interactively without stop/starting the server
  -- but has a higher server disk read load. Useful for development, bad for performance under a heavy load.
  tDirGroups <- liftIO $ if dynamicTemplateReload
    then getTemplateGroups 
    else return tDirGroups' 
  
  mbSess <- liftIO $ getmbSession rq
  let mbUName = return . sesUser =<< mbSess
  mbUis <- case mbUName of
           Nothing -> return Nothing
           Just un -> query . GetUserInfos $ un
  unServerPartT ( multi . (tutorialCommon allowStressTests ) $ RenderGlobals rq tDirGroups mbSess ) rq
  ] 



  
tutorialCommon :: Bool -> RenderGlobals -> [ServerPartT IO Response]
tutorialCommon allowStressTests rglobs =
   [ exactdir "/" [ ServerPartT $ \rq -> ( return . tutlayoutU rglobs [] ) "home"  ]
     , dir "tutorial" [
           dir "consultants" [ methodSP GET $ viewConsultants rglobs]
         , dir "consultantswanted" [ methodSP GET $ viewConsultantsWanted rglobs ]
         , dir "jobs"   [ methodSP GET $ viewJobs rglobs]
         , dir "logout" [ (logoutPage rglobs)] 
         , dir "changepassword" [ methodSP POST $ changePasswordSP rglobs ]

         , dir "editconsultantprofile" [ methodSP GET $ viewEditConsultantProfile rglobs 
                                         , methodSP POST $ processformEditConsultantProfile rglobs ]

         , dir "editjob" [ methodSP GET $ viewEditJobWD rglobs ]
         , dir "deletejob" [ methodSP GET $ deleteJobWD rglobs ]
         , dir "editjob" [ methodSP POST $ processformEditJob rglobs ]

         , dir "postnewjob" [ methodSP POST $ processformNewJob rglobs ]
         , dir "myjobposts" [ methodSP GET $ pageMyJobPosts rglobs ]
         , dir "viewprofile" [ methodSP GET $ userProfile rglobs ]
         , dir "viewjob" [ methodSP GET $ viewJob rglobs ] 
         , dir "actions" $
                 [ dir "login" [ methodSP POST $ loginPage rglobs ]
                   , dir "newuser" [ methodSP POST $ newUserPage rglobs ]
                   -- , dir "upload" [ methodSP POST $ uploadFilePage rglobs ]
                 ]
         , dir "initializedummydata" [ spAddDummyData rglobs ]
         , dir "stresstest"
             [ -- more realistic, higher stress
               dir "atomicinserts" [ spStressTest  allowStressTests ("atomic inserts",atomic_inserts) rglobs] 
               -- faster, insert all users and all jobs in one transaction
               -- fast for small numbers of users, but slow for >1000
               , dir "onebiginsert" [ spStressTest allowStressTests ("one big insert",insertus) rglobs]
               , dir "atomicinsertsalljobs" [ spStressTest allowStressTests ("atomic inserts, all jobs at once",insertusAllJobs) rglobs] 
             ]
         , spJustShowTemplate rglobs
     
   ] ]            

spJustShowTemplate rglobs = lastPathPartSp0 (\_ tmpl -> return $ tutlayoutU rglobs [] tmpl ) 

spStressTest allowStressTest insertf rglobs = 
  if allowStressTest 
    then lastPathPartSp0 $ \_ numusers -> do
         n <- Misc.safeRead numusers
         stressTest' insertf n rglobs
    else return $ tutlayoutU rglobs [("errormsg", failmsgStressTest)] "errortemplate"

failmsgStressTest = "<br>-- Stress is blocked from happening on this happs server.\
     \<br>-- For your own stress testinr, run like ./happs-tutorial 5001 True (the second arg controls the stress test)"




-- tEmail = runIO $ echo "this is an email" -|- "mailx -s \"O HAI SUBJECT LINE\" thomashartman1@gmail.com"