happs-tutorial 0.6.2 → 0.6.3
raw patch · 5 files changed
+28/−36 lines, 5 filesdep ~HAppSHelpers
Dependency ranges changed: HAppSHelpers
Files
- happs-tutorial.cabal +3/−3
- src/ControllerMisc.hs +0/−5
- src/ControllerPostActions.hs +13/−14
- templates/stringtemplatebasics.st +6/−8
- templates/templatesdontrepeatyourself.st +6/−6
happs-tutorial.cabal view
@@ -1,6 +1,6 @@ Name: happs-tutorial-Version: 0.6.2-Synopsis: A HAppS Tutorial that is is own demo+Version: 0.6.3+Synopsis: A HAppS Tutorial that is is own web 2.0-type demo. Description: A nice way to learn how to build web sites with HAppS License: BSD3@@ -44,7 +44,7 @@ Build-Depends: base>=3.0.3.0, HStringTemplate, HStringTemplateHelpers, mtl, bytestring, HAppS-Server, HAppS-Data, HAppS-State, containers, pretty, pureMD5, directory, filepath, hscolour >= 1.10.1, HTTP, safe,- old-time, parsec, HAppSHelpers, DebugTraceHelpers+ old-time, parsec, HAppSHelpers >= 0.9, DebugTraceHelpers
src/ControllerMisc.hs view
@@ -25,11 +25,6 @@ getmbSession :: Request -> IO (Maybe SessionData) getmbSession rq = maybe ( return Nothing ) ( query . GetSession ) ( getMbSessKey rq ) ---- to do: make it so keeps your current page if you login/logout--- probably modify RenderGlobals to keep track of that bit of state---startsess' :: RenderGlobals -> UserName -> WebT IO Response- -- The user argument could be bytestring rather than say, UserName, to keep things generic -- This way we could have different types of users, say UserName users and AdminUserName users. -- But for now, keep UserName.
src/ControllerPostActions.hs view
@@ -20,22 +20,21 @@ import ControllerGetActions import FromDataInstances +loginPage :: RenderGlobals -> ServerPartT IO Response loginPage = loginPage' authUser (startsess' getLoginReferer)- where authUser = authUser' getUserPassword- getUserPassword name = return . maybe Nothing (Just . B.unpack . password)+ where + authUser = authUser' getUserPassword+ getUserPassword name = return . maybe Nothing (Just . B.unpack . password) =<< query (GetUserInfos name) -- after login, just redirect to the last page we were on.- - -- try to return the referral, if can't parse it from headers, return home page- getLoginReferer :: Request -> String- getLoginReferer rq = - let homepage = getAppUrl "" rq- etRef = getHeaderVal "referer" rq- in case etRef of - Left _ -> homepage- Right rf -> if isInfixOf "logout" rf- then homepage- else rf+ getLoginReferer :: Request -> String+ getLoginReferer rq = + let homepage = smartAppUrl "" rq + in case getHeaderVal "referer" rq of + Left _ -> homepage+ Right rf -> if isInfixOf "logout" rf+ then homepage+ else rf loginPage' :: (UserName -> B.ByteString -> WebT IO Bool) -> (RenderGlobals -> UserName -> WebT IO Response) @@ -161,7 +160,7 @@ setupNewUser (NewUserInfo user (pass1 :: B.ByteString) pass2) case etRes of Left err -> return $ tutlayoutU rglobs [("errormsgRegister", err)] "register"- Right () -> startsess' (getAppUrl "tutorial/registered") rglobs user+ Right () -> startsess' (smartAppUrl "tutorial/registered") rglobs user ] where setupNewUser :: NewUserInfo -> ErrorT [Char] (WebT IO) ()
templates/stringtemplatebasics.st view
@@ -2,19 +2,17 @@ <p>In the previous section we rendered a template in ghci using the following command -<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroupSafer "templates" ; writeFile "output.html" ( renderTemplateGroup templates [] "templates-dont-repeat-yourself" ) +<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroup "templates" ; writeFile "output.html" ( renderTemplateGroup templates [] "templates-dont-repeat-yourself" ) <p>Let's look more carefully at these functions. <ul>- <li>The directoryGroupSafer function reads in all *.st type files in a directory,+ <li>The directoryGroup function reads in all *.st type files in a directory, and returns an IO STGroup value, which is basically a group- of StringTemplates. It is a modification of the directoryGroup command that comes with Text.StringTemplate package,- which ignores email backup files-type files with punctuation, that cause annoyance- when using HStringTemplate functions. - <br>*Main Misc View Text.StringTemplate> :t (directoryGroupSafer :: String -> IO (STGroup String))- <br>The actual type of directoryGroupSafer is a little less concrete than the above, and uses type classes.- <br>Our :t command gives directoryGroupSafer a concrete type, and since there's no error, we know it typechecks.+ of StringTemplates. + <br>*Main Misc View Text.StringTemplate> :t (directoryGroup :: String -> IO (STGroup String))+ <br>The actual type of directoryGroup is a little less concrete than the above, and uses type classes.+ <br>Our :t command gives directoryGroup a concrete type, and since there's no error, we know it typechecks. <li>renderTemplateGroup takes an STGroup, some template key/value pairs, and a named template, and renders the template if it is found in the STGroup. If it is not found, an error is returned. <br>*Main Misc View Text.StringTemplate> :t renderTemplateGroup
templates/templatesdontrepeatyourself.st view
@@ -30,27 +30,27 @@ <p> *Main> :m +Misc View Text.StringTemplate -<br>*Main Misc View Text.StringTemplate> do templates <- directoryGroupSafer "templates" ; writeFile "output.html" \$ renderTemplateGroup templates [] "templates-dont-repeat-yourself" +<br>*Main Misc View Text.StringTemplate> do templates <- directoryGroup "templates" ; writeFile "output.html" \$ renderTemplateGroup templates [] "templates-dont-repeat-yourself" <p>and then opening the file output.html in firefox. (On ubuntu, in ghci, I just do ":! firefox output.html &" and the file opens in a new tab in firefox.) <p>To see how this page would look if you were logged in: -<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroupSafer "templates" ; writeFile "output.html" \$ renderTemplateGroup templates [("loggedInUser","DarthVader")] "templates-dont-repeat-yourself" +<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroup "templates" ; writeFile "output.html" \$ renderTemplateGroup templates [("loggedInUser","DarthVader")] "templates-dont-repeat-yourself" <p>and reopen output.html in your browser. <p>As you may have noticed, the html written by the above command is only the current content pane, not the header or table of content links. To render a full page from ghci, as it would appear for a logged in user, try -<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroupSafer "templates"; writeFile "output.html" \$ tutlayout (RenderGlobals templates (Just \$ User "Darth" "" undefined undefined)) [] "templates-dont-repeat-yourself"+<p>*Main Misc View Text.StringTemplate> do templates <- directoryGroup "templates"; writeFile "output.html" \$ tutlayout (RenderGlobals templates (Just \$ User "Darth" "" undefined undefined)) [] "templates-dont-repeat-yourself" -<p>Note that tutlayout is a pure function. The only IO is in fetching the templates with directoryGroupSafer.+<p>Note that tutlayout is a pure function. The only IO is in fetching the templates with directoryGroup. Currently the tutorial does a directory read every time the main webserver handler loops, but it could just as easily only do the directory read once at app startup time. This would mean a lot less disk reads, but of course you would have to stop/start the server whenever a template changed to see your changes. Which setup you want depends on whether you are willing to sacrifice development convenience for a snappier server.-I opted for convenience, but it would be easy to change -- just move the directoryGroupSafer command out of the-tutorial handler and into Main.hs before the server starts. Try it as an exercise if you like.+I opted for convenience, but it would be easy to change -- just move the directoryGroup command out of the+tutorial handler and into Main.hs~ before the server starts. Try it as an exercise if you like. <p>As a side note, you can get away with passing undefined values to the tutlayout function because it never attempts to evaluate the profile and jobs bits of the User data object. That's lazy evaluation at work.