[working on login
thomashartman1@gmail.com**20080825102444] hunk ./src/Controller.hs 35
- , dir "view" [ withDataFn sidCookie viewLogin ]
+ -- I don't like how withDataFn behaves when querying the session result in a value of nothing
+ , dir "view" [ withDataFn ( readCookieValue "sid" ) getLoggedInAs
+ , msgToSp "not logged in" ]
hunk ./src/Controller.hs 39
-viewLogin (Just sid) = [anyRequest $ do
+
+-- getLoginMsg = "some login message"
+getLoginMsg = [ withDataFn2 (msgToWeb "not logged in") ( readCookieValue "sid" ) getLoggedInAs ]
+
+getLoggedInAs sid = [ anyRequest $ do
hunk ./src/Controller.hs 45
- ( ( ioMsgToWeb . withBaseContentW ) $ (maybe "not logged in" show (ses :: Maybe SessionData)) :: WebT IO Response)]
-viewLogin Nothing =
- [ msgToSp "Not logged in"]
+ ( ioMsgToWeb . withBaseContentW ) {- $ maybe "not logged in" -} ( show ses )
+ ]
+
hunk ./src/Controller.hs 51
+{-
hunk ./src/Controller.hs 56
+-}
hunk ./src/Controller.hs 58
+-- sidCookie :: ReaderT ([(String, Input)], [(String, Cookie)]) Maybe SessionKey
+-- sidCookie = ( readCookieValue "sid" )
hunk ./src/Misc.hs 12
+-- import Control.Monad.Reader
hunk ./src/Misc.hs 78
+withDataFn2 :: Monad m => (WebT m r) -> RqData a -> (a -> [ServerPartT m r]) -> ServerPartT m r
+withDataFn2 def fn handle
+ = ServerPartT $ \rq -> case runReaderT fn (rqInputs rq,rqCookies rq) of
+ Nothing -> def
+ Just a -> unServerPartT (multi $ handle a) rq
hunk ./src/View.hs 16
+ loggedInMsg <- return getLoginMsg
hunk ./src/View.hs 18
- renderTut ( [("contentarea",content)] ++ menuAttrs ++ attrs) "base"
+ renderTut ( [("contentarea",content)] ++ menuAttrs ++ loggedInMsg ++ attrs) "base"
+
+getLoginMsg = [("menuLoginStatus","some login message")]
hunk ./src/View.hs 36
-t = getMenuAttrs "home"
+-- t = getMenuAttrs "home"
hunk ./templates/base.st 12
- loggged in as: $ loginSelected $ (when this works, get rid of "logged in as link" below)
+
hunk ./templates/header.st 3
+
hunk ./templates/header.st 9
- $ menu2 $
-
-
-
-
- |
- |
- |
-
-
+ $ menubar() $
addfile ./templates/menubar.st
hunk ./templates/menubar.st 1
+
+
+
+ |
+ |
+ |
+ |logged in as Orig
+ | $ menuLoginStatus $
+
+
addfile ./templates/view-all-users.st
hunk ./templates/view-all-users.st 1
-
+Users: $ userList $