happs-tutorial-0.4.1: src/ControllerMisc.hs

module ControllerMisc where

import HAppS.Server

import Misc
import ViewStuff
import StateStuff

-- The final value is HtmlString so that the HAppS machinery does the right thing with toMessage.
--   If the final value was left as a String, the page would display as text, not html.
--tutlayoutReq :: Request -> [([Char], String)] -> String -> WebT IO Response
tutlayoutU rglobs attrs tmpl = ( toResponse . HtmlString . tutlayout rglobs attrs ) tmpl

-- getMbSessKey rq = readData (readCookieValue "sid") rq
getMbSessKey :: Request -> Maybe SessionKey
getMbSessKey rq = readData (readCookieValue "sid") rq

getmbLoggedInUser :: Request -> IO (Maybe String)
getmbLoggedInUser rq = do
  mbSd <- getMbSessData rq
  return $ do
    sd <- mbSd
    return . sesUser $ sd

getMbSessData :: Request -> IO (Maybe SessionData)                          
getMbSessData rq = do
  maybe ( return Nothing )
        ( query . GetSession )
        ( getMbSessKey rq )

-- updateUserSp :: RenderGlobals -> User -> User -> (RenderGlobals -> ServerPartT IO Response) -> WebT IO Response
updateUserSp rglobs newuser withrgSp rq = do
  case mbUser rglobs of
      Nothing -> return $ tutlayoutU rglobs [("errormsg", "updateUserSp: no user")] "errortemplate"
      Just olduser -> do update (UpdateUser olduser newuser)
                         let newrglobs = RenderGlobals (templates rglobs) (Just newuser)
                         unServerPartT ( withrgSp newrglobs ) rq